From c7ba5f38b80433b040d3946b8fc0b1e8621ba30a Mon Sep 17 00:00:00 2001 From: John Kehayias Date: Wed, 20 Jul 2022 23:46:45 -0400 Subject: environment: Add '--emulate-fhs'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/environment.scm (show-environment-options-help, %options): Add '--emulate-fhs'. (setup-fhs): New procedure. Setup for the Filesystem Hierarchy Standard (FHS) container. Defines and uses FHS-SYMLINKS and LINK-CONTENTS to create FHS expected directories and creates /etc/ld.so.conf. (launch-environment): Add 'emulate-fhs?' key and implement it to set $PATH and generate /etc/ld.so.cache before calling COMMAND. (launch-environment/container): Add 'emulate-fhs?' and 'setup-hook' keys and implement them. Define and use FHS-MAPPINGS, to set up additional bind mounts in the container to follow FHS expectations. (guix-environment*): Add glibc-for-fhs to the container packages when 'emulate-fhs?' key is in OPTS. * doc/guix.texi (Invoking guix shell): Document '--emulate-fhs'. (Invoking guix environment): Document '--emulate-fhs'. * tests/guix-environment-container.sh: Add tests for '--emulate-fhs'. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 38 ++++++++ guix/scripts/environment.scm | 170 +++++++++++++++++++++++++++++++----- tests/guix-environment-container.sh | 34 ++++++++ 3 files changed, 218 insertions(+), 24 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 78ada9c301..dbf4ca9be9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -108,6 +108,7 @@ Copyright @copyright{} 2022 Justin Veilleux@* Copyright @copyright{} 2022 Reily Siegel@* Copyright @copyright{} 2022 Simon Streit@* Copyright @copyright{} 2022 (@* +Copyright @copyright{} 2022 John Kehayias@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -6195,6 +6196,27 @@ directory: guix shell --container --expose=$HOME=/exchange guile -- guile @end example +@cindex file system hierarchy standard (FHS) +@cindex FHS (file system hierarchy standard) +@item --emulate-fhs +@itemx -F +When used with @option{--container}, emulate a +@uref{https://refspecs.linuxfoundation.org/fhs.shtml, Filesystem +Hierarchy Standard (FHS)} configuration within the container, providing +@file{/bin}, @file{/lib}, and other directories and files specified by +the FHS. + +As Guix deviates from the FHS specification, this +option sets up the container to more closely mimic that of other +GNU/Linux distributions. This is useful for reproducing other +development environments, testing, and using programs which expect the +FHS specification to be followed. With this option, the container will +include a version of glibc that will read +@file{/etc/ld.so.cache} within the container for the shared library +cache (contrary to glibc in regular Guix usage) and set up the +expected FHS directories: @file{/bin}, @file{/etc}, @file{/lib}, and +@file{/usr} from the container's profile. + @item --rebuild-cache @cindex caching, of profiles @cindex caching, in @command{guix shell} @@ -6614,6 +6636,22 @@ directory: guix environment --container --expose=$HOME=/exchange --ad-hoc guile -- guile @end example +@item --emulate-fhs +@item -F +For containers, emulate a Filesystem Hierarchy Standard (FHS) +configuration within the container, see +@uref{https://refspecs.linuxfoundation.org/fhs.shtml, the official +specification}. As Guix deviates from the FHS specification, this +option sets up the container to more closely mimic that of other +GNU/Linux distributions. This is useful for reproducing other +development environments, testing, and using programs which expect the +FHS specification to be followed. With this option, the container will +include a version of @code{glibc} which will read +@code{/etc/ld.so.cache} within the container for the shared library +cache (contrary to @code{glibc} in regular Guix usage) and set up the +expected FHS directories: @code{/bin}, @code{/etc}, @code{/lib}, and +@code{/usr} from the container's profile. + @end table @command{guix environment} diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 2493134470..cf99760859 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 © 2022 John Kehayias ;;; ;;; This file is part of GNU Guix. ;;; @@ -120,6 +121,9 @@ shell'." --expose=SPEC for containers, expose read-only host file system according to SPEC")) (display (G_ " + -F, --emulate-fhs for containers, emulate the Filesystem Hierarchy + Standard (FHS)")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use bootstrap binaries to build the environment"))) @@ -256,6 +260,9 @@ use '--preserve' instead~%")) (alist-cons 'file-system-mapping (specification->file-system-mapping arg #f) result))) + (option '(#\F "emulate-fhs") #f #f + (lambda (opt name arg result) + (alist-cons 'emulate-fhs? #t result))) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) @@ -375,6 +382,65 @@ requisite store items i.e. the union closure of all the inputs." input->requisites inputs))) (return (delete-duplicates (concatenate reqs))))) +(define (setup-fhs profile) + "Setup the FHS container by creating and linking expected directories from +PROFILE (other bind mounts are done in LAUNCH-ENVIRONMENT/CONTAINER), +providing a symlink for CC if GCC is in the container PROFILE, and writing +/etc/ld.so.conf." + ;; Additional symlinks for an FHS container. + (define fhs-symlinks + `(("/lib" . "/usr/lib") + ,(if (target-64bit?) + '("/lib" . "/lib64") + '("/lib" . "/lib32")) + ("/bin" . "/usr/bin") + ("/sbin" . "/usr/sbin"))) + + ;; A procedure to symlink the contents (at the top level) of a directory, + ;; excluding the directory itself and parent, along with any others provided + ;; in EXCLUDE. + (define* (link-contents dir #:key (exclude '())) + (for-each (lambda (file) + (symlink (string-append profile dir "/" file) + (string-append dir "/" file))) + (scandir (string-append profile dir) + (negate (cut member <> + (append exclude '("." ".." ))))))) + + ;; The FHS container sets up the expected filesystem through MAPPINGS with + ;; FHS-MAPPINGS (in LAUNCH-ENVIRONMENT/CONTAINER), the symlinks through + ;; FHS-SYMLINKS, and linking the contents of PROFILE/bin and PROFILE/etc + ;; using LINK-CONTENTS, as these both have or will have contents for a + ;; non-FHS container so must be handled separately. + (mkdir-p "/usr") + (for-each (lambda (link) + (if (file-exists? (car link)) + (symlink (car link) (cdr link)))) + fhs-symlinks) + (link-contents "/bin" #:exclude '("sh")) + (mkdir-p "/etc") + (link-contents "/etc") + + ;; Provide a frequently expected 'cc' symlink to gcc (in case it is in + ;; PROFILE), 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 the other (optional) FHS + ;; bin directories will link to /bin. + (let ((gcc-path (string-append profile "/bin/gcc"))) + (if (file-exists? gcc-path) + (symlink gcc-path "/bin/cc"))) + + ;; Guix's ldconfig doesn't search in FHS default locations, so provide a + ;; minimal ld.so.conf. + (call-with-output-file "/etc/ld.so.conf" + (lambda (port) + (for-each (lambda (directory) + (display directory port) + (newline port)) + ;; /lib/nss is needed as Guix's nss puts libraries + ;; there rather than in the lib directory. + '("/lib" "/lib/nss"))))) + (define (status->exit-code status) "Compute the exit code made from STATUS, a value as returned by 'waitpid', and suitable for 'exit'." @@ -386,11 +452,13 @@ and suitable for 'exit'." (define primitive-exit/status (compose primitive-exit status->exit-code)) (define* (launch-environment command profile manifest - #:key pure? (white-list '())) + #:key pure? (white-list '()) + emulate-fhs?) "Run COMMAND in a new environment containing INPUTS, using the native search paths defined by the list PATHS. When PURE?, pre-existing environment variables are cleared before setting the new ones, except those matching the -regexps in WHITE-LIST." +regexps in WHITE-LIST. When EMULATE-FHS?, first set up an FHS environment +with $PATH and generate the LD cache." ;; Properly handle SIGINT, so pressing C-c in an interactive terminal ;; application works. (sigaction SIGINT SIG_DFL) @@ -406,6 +474,12 @@ regexps in WHITE-LIST." ((program . args) (catch 'system-error (lambda () + (when emulate-fhs? + ;; When running in a container with EMULATE-FHS?, override $PATH + ;; (optional, but to better match FHS expectations), and generate + ;; /etc/ld.so.cache. + (setenv "PATH" "/bin:/usr/bin:/sbin:/usr/sbin") + (invoke "ldconfig" "-X")) (apply execlp program program args)) (lambda _ ;; Report the error from here because the parent process cannot @@ -604,16 +678,24 @@ regexps in WHITE-LIST." (define* (launch-environment/container #:key command bash user user-mappings profile manifest link-profile? network? - map-cwd? (white-list '())) + map-cwd? emulate-fhs? (setup-hook #f) + (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 -store. When NETWORK?, access to the host system network is permitted. -USER-MAPPINGS, a list of file system mappings, contains the user-specified -host file systems to mount inside the container. If USER is not #f, each -target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER -will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from -~/.guix-profile to the environment 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 store. When +NETWORK?, access to the host system network is permitted. USER-MAPPINGS, a +list of file system mappings, contains the user-specified host file systems to +mount inside the container. If USER is not #f, each target of USER-MAPPINGS +will be re-written relative to '/home/USER', and USER will be used for the +passwd entry. + +When EMULATE-FHS?, set up the container to follow the Filesystem Hierarchy +Standard and provide a glibc that reads the cache from /etc/ld.so.cache. +SETUP-HOOK is an additional setup procedure to be called, currently only used +with the EMULATE-FHS? option. + +LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the +environment profile. Preserve environment variables whose name matches the one of the regexps in WHILE-LIST." @@ -621,6 +703,21 @@ WHILE-LIST." (and (file-exists? (file-system-mapping-source mapping)) (file-system-mapping->bind-mount mapping))) + ;; File system mappings for an FHS container, where the entire directory can + ;; be mapped. Others (bin and etc) will already have contents and need to + ;; use LINK-CONTENTS (defined in SETUP-FHS) to symlink the directory + ;; contents. + (define fhs-mappings + (map (lambda (mapping) + (file-system-mapping + (source (string-append profile (car mapping))) + (target (cdr mapping)))) + '(("/lib" . "/lib") + ("/include" . "/usr/include") + ("/sbin" . "/sbin") + ("/libexec" . "/usr/libexec") + ("/share" . "/usr/share")))) + (mlet %store-monad ((reqs (inputs->requisites (list (direct-store-path bash) profile)))) (return @@ -675,6 +772,11 @@ WHILE-LIST." (filter-map optional-mapping->fs %network-file-mappings) '()) + ;; Mappings for an FHS container. + (if emulate-fhs? + (filter-map optional-mapping->fs + fhs-mappings) + '()) (map file-system-mapping->bind-mount mappings)))) (exit/status @@ -702,6 +804,10 @@ WHILE-LIST." (mkdir-p home-dir) (setenv "HOME" home-dir) + ;; Call an additional setup procedure, if provided. + (when setup-hook + (setup-hook profile)) + ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile; ;; this allows programs expecting that path to continue working as ;; expected within a container. @@ -743,7 +849,8 @@ WHILE-LIST." (if link-profile? (string-append home-dir "/.guix-profile") profile) - manifest #:pure? #f))) + manifest #:pure? #f + #:emulate-fhs? emulate-fhs?))) #:guest-uid uid #:guest-gid gid #:namespaces (if network? @@ -867,16 +974,17 @@ message if any test fails." "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)) - (command (or (assoc-ref opts 'exec) + (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?)) + (emulate-fhs? (assoc-ref opts 'emulate-fhs?)) + (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. (if container? @@ -915,12 +1023,22 @@ command-line option processing with 'parse-command-line'." (leave (G_ "'--user' cannot be used without '--container'~%"))) (when (and (not container?) no-cwd?) (leave (G_ "--no-cwd cannot be used without --container~%"))) + (when (and (not container?) emulate-fhs?) + (leave (G_ "'--emulate-fhs' cannot be used without '--container~'%"))) (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 the (hidden) package glibc-for-fhs + ;; which uses the global cache at /etc/ld.so.cache. + (if emulate-fhs? + (alist-cons 'expression + '(ad-hoc-package "(@@ (gnu packages base) glibc-for-fhs)") + opts) + opts))) (define manifest (if profile @@ -994,7 +1112,11 @@ when using '--container'; doing nothing~%")) #:white-list white-list #:link-profile? link-prof? #:network? network? - #:map-cwd? (not no-cwd?)))) + #:map-cwd? (not no-cwd?) + #:emulate-fhs? emulate-fhs? + #:setup-hook + (and emulate-fhs? + setup-fhs)))) (else (return diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 2e238c501d..898c57f41b 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -197,3 +197,37 @@ then false; else test $? -gt 127 fi + +# Test the Filesystem Hierarchy Standard (FHS) container option, --emulate-fhs (-F) + +# As this option requires a glibc package (glibc-for-fhs), try to run these +# tests with the user's global store to make it easier to build or download a +# substitute. +storedir="`guile -c '(use-modules (guix config))(display %storedir)'`" +localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`" +NIX_STORE_DIR="$storedir" +GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket" +export NIX_STORE_DIR GUIX_DAEMON_SOCKET + +if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))' +then + exit 77 +fi + +# Test that the container has FHS specific files/directories. Note that /bin +# exists in a non-FHS container as it will contain sh, a symlink to the bash +# package, so we don't test for it. +guix environment -C --emulate-fhs --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c '(exit (and (file-exists? "/etc/ld.so.cache") + (file-exists? "/lib") + (file-exists? "/sbin") + (file-exists? "/usr/bin") + (file-exists? "/usr/include") + (file-exists? "/usr/lib") + (file-exists? "/usr/libexec") + (file-exists? "/usr/sbin") + (file-exists? "/usr/share")))' + +# Test that the ld cache was generated and can be successfully read. +guix environment -C --emulate-fhs --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c '(execlp "ldconfig" "ldconfig" "-p")' -- cgit v1.2.3