diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 4bdc3e7792..1b4c99d3e9 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -928,6 +928,20 @@ (define-public glibc (license lgpl2.0+) (home-page "https://www.gnu.org/software/libc/"))) +;; Define glibc-for-fhs (with a name that allows grafts for glibc), a variation +;; of glibc which uses the default ld.so.cache, useful in FHS containers. +;; Note: should this be hidden? +(define-public gcfhs + (package + (inherit glibc) + (name "gcfhs") + (source (origin (inherit (package-source glibc)) + ;; Remove Guix's patch to read ld.so.cache from /gnu/store + ;; directories, re-enabling the default /etc/ld.so.cache + ;; behavior. + (patches (delete (car (search-patches "glibc-dl-cache.patch")) + (origin-patches (package-source glibc)))))))) + ;; Below are old libc versions, which we use mostly to build locale data in ;; the old format (which the new libc cannot cope with.) (define-public glibc-2.32 diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 3216235937..425649b843 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014, 2015, 2018 David Thompson ;;; Copyright © 2015-2022 Ludovic Courtès ;;; Copyright © 2018 Mike Gerwitz +;;; Copyright © 2021 John Kehayias ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +46,7 @@ (define-module (guix scripts environment) #:autoload (guix build syscalls) (set-network-interface-up openpty login-tty) #:use-module (gnu system file-systems) #:autoload (gnu packages) (specification->package+output) + #:autoload (gnu packages base) (gcfhs) #:autoload (gnu packages bash) (bash) #:autoload (gnu packages bootstrap) (bootstrap-executable %bootstrap-guile) #:use-module (ice-9 match) @@ -101,6 +103,8 @@ (define (show-environment-options-help) (display (G_ " -C, --container run command within an isolated container")) (display (G_ " + -F, --fhs-container run command within an isolated FHS container")) + (display (G_ " -N, --network allow containers to access the network")) (display (G_ " -P, --link-profile link environment profile to ~/.guix-profile within @@ -229,6 +233,10 @@ (define %options (option '(#\C "container") #f #f (lambda (opt name arg result) (alist-cons 'container? #t result))) + (option '(#\F "fhs-container") #f #f + (lambda (opt name arg result) + (alist-cons 'fhs-container? #t + (alist-cons 'container? #t result)))) (option '(#\N "network") #f #f (lambda (opt name arg result) (alist-cons 'network? #t result))) @@ -606,9 +614,10 @@ (define* (launch-environment/fork command profile manifest ((_ . status) (validate-exit-status profile command status)))))) -(define* (launch-environment/container #:key command bash user user-mappings - profile manifest link-profile? network? - map-cwd? (white-list '())) +(define* (launch-environment/container #:key command bash fhs-container? user + user-mappings profile manifest + link-profile? network? map-cwd? + (white-list '())) "Run COMMAND within a container that features the software in PROFILE. Environment variables are set according to the search paths of MANIFEST. The global shell is BASH, a file name for a GNU Bash binary in the @@ -709,6 +718,49 @@ (define* (launch-environment/container #:key command bash user user-mappings (mkdir-p home-dir) (setenv "HOME" home-dir) + ;; Set up an FHS container. + (when fhs-container? + ;; Set up the expected bin and library directories as symlinks to + ;; the profile lib directory. Note that this is assuming a 64bit + ;; architecture. + (let ((lib-dir (string-append profile "/lib"))) + (symlink lib-dir "/lib64") + (symlink lib-dir "/lib") + (mkdir-p "/usr") + (symlink lib-dir "/usr/lib")) + ;; Note: can't symlink full /bin in the container due to the sh + ;; symlink. + (symlink (string-append profile "/bin") "/usr/bin") + (symlink (string-append profile "/sbin") "/sbin") + (symlink (string-append profile "/sbin") "/usr/sbin") + + ;; Provide a frequently expected 'cc' symlink to gcc, though this + ;; could also be done by the user in the container, e.g. in + ;; $HOME/.local/bin and adding that to $PATH. Note: we do this + ;; in /bin since that already has the sh symlink and can't write + ;; to the other bin directories that are already symlinks themselves. + (symlink (string-append profile "/bin/gcc") "/bin/cc") + ;; TODO: python may also be expected to symlink to python3. + + ;; Guix's ldconfig doesn't seem to search in FHS default + ;; locations, so provide a minimal ld.so.conf. + ;; TODO: this may need more, e.g. libnss3 is in /lib/nss + (call-with-output-file "/tmp/ld.so.conf" + (lambda (port) + (display "/lib64" port) + (newline port))) + + ;; Define an entry script to start the container: generate + ;; ld.so.cache, supplement $PATH, and include command. + (call-with-output-file "/tmp/fhs.sh" + (lambda (port) + (display "ldconfig -X -f /tmp/ld.so.conf" port) + (newline port) + (display "export PATH=/bin:/usr/bin:/sbin:/usr/sbin:$PATH" port) + (newline port) + (display (car command) port) + (newline port)))) + ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile; ;; this allows programs expecting that path to continue working as ;; expected within a container. @@ -746,7 +798,12 @@ (define* (launch-environment/container #:key command bash user user-mappings (primitive-exit/status ;; A container's environment is already purified, so no need to ;; request it be purified again. - (launch-environment command + (launch-environment (if fhs-container? + ;; Use the FHS start script. + ;; FIXME: probably the default command should + ;; be different as it spawns a different shell? + '("/bin/sh" "/tmp/fhs.sh") + command) (if link-profile? (string-append home-dir "/.guix-profile") profile) @@ -874,15 +931,16 @@ (define (guix-environment* opts) "Run the 'guix environment' command on OPTS, an alist resulting for command-line option processing with 'parse-command-line'." (with-error-handling - (let* ((pure? (assoc-ref opts 'pure)) - (container? (assoc-ref opts 'container?)) - (link-prof? (assoc-ref opts 'link-profile?)) - (network? (assoc-ref opts 'network?)) - (no-cwd? (assoc-ref opts 'no-cwd?)) - (user (assoc-ref opts 'user)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (system (assoc-ref opts 'system)) - (profile (assoc-ref opts 'profile)) + (let* ((pure? (assoc-ref opts 'pure)) + (container? (assoc-ref opts 'container?)) + (fhs-container? (assoc-ref opts 'fhs-container?)) + (link-prof? (assoc-ref opts 'link-profile?)) + (network? (assoc-ref opts 'network?)) + (no-cwd? (assoc-ref opts 'no-cwd?)) + (user (assoc-ref opts 'user)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (system (assoc-ref opts 'system)) + (profile (assoc-ref opts 'profile)) (command (or (assoc-ref opts 'exec) ;; Spawn a shell if the user didn't specify ;; anything in particular. @@ -927,7 +985,16 @@ (define (guix-environment* opts) (with-store/maybe store (with-status-verbosity (assoc-ref opts 'verbosity) (define manifest-from-opts - (options/resolve-packages store opts)) + (options/resolve-packages store + ;; For an FHS-container, add a glibc that uses + ;; /etc/ld.so.cache. + (if fhs-container? + (alist-cons 'package '(ad-hoc-package "gcfhs") + opts) + ;; Alternatively, could graft all packages with + ;; this glibc, though that seems unnecessary. + ;; (alist-cons 'with-graft "glibc=gcfhs" opts) + opts))) (define manifest (if profile @@ -994,6 +1061,7 @@ (define (guix-environment* opts) "/bin/sh")))) (launch-environment/container #:command command #:bash bash-binary + #:fhs-container? fhs-container? #:user user #:user-mappings mappings #:profile profile