From 6b5e3931bb83d589ff47263cc3bfd5eb236a3954 Mon Sep 17 00:00:00 2001 From: John Kehayias Date: Wed, 20 Jul 2022 23:46:45 -0400 Subject: [PATCH] environment: Add '--emulate-fhs'. * guix/scripts/environment.scm (show-environment-options-help) (%options): Add '--emulate-fhs'. * guix/scripts/environment.scm (launch-environment/container): Add 'emulate-fhs?' key and implement it. Define and use FHS-MAPPINGS, FHS-SYMLINKS, and LINK-CONTENTS to set up the container to follow the Filesystem Hierarchy Standard (FHS) for /bin, /etc, and /usr. Generate /etc/ld.so.cache in the container from /etc/ld.so.conf by running the script /tmp/fhs.sh to launch the container. (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'. --- doc/guix.texi | 33 ++++++++ guix/scripts/environment.scm | 157 ++++++++++++++++++++++++++++++----- 2 files changed, 168 insertions(+), 22 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3c5864ec1a..03a65f26f4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -106,6 +106,7 @@ Copyright @copyright{} 2022 Karl Hallsby@* Copyright @copyright{} 2022 Justin Veilleux@* Copyright @copyright{} 2022 Reily Siegel@* +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 @@ -6155,6 +6156,22 @@ Invoking guix shell guix shell --container --expose=$HOME=/exchange 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. + @item --rebuild-cache @cindex caching, of profiles @cindex caching, in @command{guix shell} @@ -6572,6 +6589,22 @@ Invoking guix environment 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 3216235937..c80f5f28af 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 @@ (define (show-environment-options-help) --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 @@ (define %options (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))) @@ -608,16 +615,18 @@ (define* (launch-environment/fork command profile manifest (define* (launch-environment/container #:key command bash user user-mappings profile manifest link-profile? network? - map-cwd? (white-list '())) + map-cwd? emulate-fhs? (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. 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." @@ -625,6 +634,40 @@ (define* (launch-environment/container #:key command bash user user-mappings (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 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")))) + + ;; 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 '("." ".." ))))))) + (define (exit/status* status) (exit/status (validate-exit-status profile command status))) @@ -682,6 +725,11 @@ (define* (launch-environment/container #:key command bash user user-mappings (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* @@ -709,6 +757,54 @@ (define* (launch-environment/container #:key command bash user user-mappings (mkdir-p home-dir) (setenv "HOME" home-dir) + ;; Set up an FHS container. + (when emulate-fhs? + ;; The FHS container sets up the expected filesystem through + ;; MAPPINGS with FHS-MAPPINGS above, 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 the container), 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. + (symlink (string-append profile "/bin/gcc") "/bin/cc") + + ;; Guix's ldconfig doesn't seem to 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 an entry script to start the container: generate + ;; ld.so.cache, supplement $PATH (optional, but to better match + ;; FHS expectations), and include COMMAND. + (call-with-output-file "/tmp/fhs.sh" + (lambda (port) + (display "ldconfig -X" 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 +842,10 @@ (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 emulate-fhs? + ;; Use the FHS start script. + '("/bin/sh" "/tmp/fhs.sh") + command) (if link-profile? (string-append home-dir "/.guix-profile") profile) @@ -874,16 +973,17 @@ (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)) - (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? @@ -922,12 +1022,24 @@ (define (guix-environment* opts) (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 @@ -1001,7 +1113,8 @@ (define (guix-environment* opts) #:white-list white-list #:link-profile? link-prof? #:network? network? - #:map-cwd? (not no-cwd?)))) + #:map-cwd? (not no-cwd?) + #:emulate-fhs? emulate-fhs?))) (else (return -- 2.37.1