environment: Add '--emulate-fhs'.

* 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 <ludo@gnu.org>
This commit is contained in:
John Kehayias 2022-07-20 23:46:45 -04:00 committed by Ludovic Courtès
parent 3d1d29e440
commit c7ba5f38b8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 218 additions and 24 deletions

View file

@ -108,6 +108,7 @@ Copyright @copyright{} 2022 Justin Veilleux@*
Copyright @copyright{} 2022 Reily Siegel@* Copyright @copyright{} 2022 Reily Siegel@*
Copyright @copyright{} 2022 Simon Streit@* Copyright @copyright{} 2022 Simon Streit@*
Copyright @copyright{} 2022 (@* Copyright @copyright{} 2022 (@*
Copyright @copyright{} 2022 John Kehayias@*
Permission is granted to copy, distribute and/or modify this document Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or 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 guix shell --container --expose=$HOME=/exchange guile -- guile
@end example @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 @item --rebuild-cache
@cindex caching, of profiles @cindex caching, of profiles
@cindex caching, in @command{guix shell} @cindex caching, in @command{guix shell}
@ -6614,6 +6636,22 @@ directory:
guix environment --container --expose=$HOME=/exchange --ad-hoc guile -- guile guix environment --container --expose=$HOME=/exchange --ad-hoc guile -- guile
@end example @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 @end table
@command{guix environment} @command{guix environment}

View file

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org> ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org> ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; 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 --expose=SPEC for containers, expose read-only host file system
according to SPEC")) according to SPEC"))
(display (G_ " (display (G_ "
-F, --emulate-fhs for containers, emulate the Filesystem Hierarchy
Standard (FHS)"))
(display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL")) -v, --verbosity=LEVEL use the given verbosity LEVEL"))
(display (G_ " (display (G_ "
--bootstrap use bootstrap binaries to build the environment"))) --bootstrap use bootstrap binaries to build the environment")))
@ -256,6 +260,9 @@ (define %options
(alist-cons 'file-system-mapping (alist-cons 'file-system-mapping
(specification->file-system-mapping arg #f) (specification->file-system-mapping arg #f)
result))) result)))
(option '(#\F "emulate-fhs") #f #f
(lambda (opt name arg result)
(alist-cons 'emulate-fhs? #t result)))
(option '(#\r "root") #t #f (option '(#\r "root") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'gc-root arg result))) (alist-cons 'gc-root arg result)))
@ -375,6 +382,65 @@ (define (input->requisites input)
input->requisites inputs))) input->requisites inputs)))
(return (delete-duplicates (concatenate reqs))))) (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) (define (status->exit-code status)
"Compute the exit code made from STATUS, a value as returned by 'waitpid', "Compute the exit code made from STATUS, a value as returned by 'waitpid',
and suitable for 'exit'." and suitable for 'exit'."
@ -386,11 +452,13 @@ (define exit/status (compose exit status->exit-code))
(define primitive-exit/status (compose primitive-exit status->exit-code)) (define primitive-exit/status (compose primitive-exit status->exit-code))
(define* (launch-environment command profile manifest (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 "Run COMMAND in a new environment containing INPUTS, using the native search
paths defined by the list PATHS. When PURE?, pre-existing environment paths defined by the list PATHS. When PURE?, pre-existing environment
variables are cleared before setting the new ones, except those matching the 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 ;; Properly handle SIGINT, so pressing C-c in an interactive terminal
;; application works. ;; application works.
(sigaction SIGINT SIG_DFL) (sigaction SIGINT SIG_DFL)
@ -406,6 +474,12 @@ (define* (launch-environment command profile manifest
((program . args) ((program . args)
(catch 'system-error (catch 'system-error
(lambda () (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)) (apply execlp program program args))
(lambda _ (lambda _
;; Report the error from here because the parent process cannot ;; Report the error from here because the parent process cannot
@ -604,16 +678,24 @@ (define* (launch-environment/fork command profile manifest
(define* (launch-environment/container #:key command bash user user-mappings (define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network? 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. "Run COMMAND within a container that features the software in PROFILE.
Environment variables are set according to the search paths of MANIFEST. Environment variables are set according to the search paths of MANIFEST. The
The global shell is BASH, a file name for a GNU Bash binary in the global shell is BASH, a file name for a GNU Bash binary in the store. When
store. When NETWORK?, access to the host system network is permitted. NETWORK?, access to the host system network is permitted. USER-MAPPINGS, a
USER-MAPPINGS, a list of file system mappings, contains the user-specified list of file system mappings, contains the user-specified host file systems to
host file systems to mount inside the container. If USER is not #f, each mount inside the container. If USER is not #f, each target of USER-MAPPINGS
target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER will be re-written relative to '/home/USER', and USER will be used for the
will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from passwd entry.
~/.guix-profile to the environment profile.
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 Preserve environment variables whose name matches the one of the regexps in
WHILE-LIST." WHILE-LIST."
@ -621,6 +703,21 @@ (define (optional-mapping->fs mapping)
(and (file-exists? (file-system-mapping-source mapping)) (and (file-exists? (file-system-mapping-source mapping))
(file-system-mapping->bind-mount 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 (mlet %store-monad ((reqs (inputs->requisites
(list (direct-store-path bash) profile)))) (list (direct-store-path bash) profile))))
(return (return
@ -675,6 +772,11 @@ (define (optional-mapping->fs mapping)
(filter-map optional-mapping->fs (filter-map optional-mapping->fs
%network-file-mappings) %network-file-mappings)
'()) '())
;; Mappings for an FHS container.
(if emulate-fhs?
(filter-map optional-mapping->fs
fhs-mappings)
'())
(map file-system-mapping->bind-mount (map file-system-mapping->bind-mount
mappings)))) mappings))))
(exit/status (exit/status
@ -702,6 +804,10 @@ (define (optional-mapping->fs mapping)
(mkdir-p home-dir) (mkdir-p home-dir)
(setenv "HOME" 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; ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile;
;; this allows programs expecting that path to continue working as ;; this allows programs expecting that path to continue working as
;; expected within a container. ;; expected within a container.
@ -743,7 +849,8 @@ (define (optional-mapping->fs mapping)
(if link-profile? (if link-profile?
(string-append home-dir "/.guix-profile") (string-append home-dir "/.guix-profile")
profile) profile)
manifest #:pure? #f))) manifest #:pure? #f
#:emulate-fhs? emulate-fhs?)))
#:guest-uid uid #:guest-uid uid
#:guest-gid gid #:guest-gid gid
#:namespaces (if network? #:namespaces (if network?
@ -867,16 +974,17 @@ (define (guix-environment* opts)
"Run the 'guix environment' command on OPTS, an alist resulting for "Run the 'guix environment' command on OPTS, an alist resulting for
command-line option processing with 'parse-command-line'." command-line option processing with 'parse-command-line'."
(with-error-handling (with-error-handling
(let* ((pure? (assoc-ref opts 'pure)) (let* ((pure? (assoc-ref opts 'pure))
(container? (assoc-ref opts 'container?)) (container? (assoc-ref opts 'container?))
(link-prof? (assoc-ref opts 'link-profile?)) (link-prof? (assoc-ref opts 'link-profile?))
(network? (assoc-ref opts 'network?)) (network? (assoc-ref opts 'network?))
(no-cwd? (assoc-ref opts 'no-cwd?)) (no-cwd? (assoc-ref opts 'no-cwd?))
(user (assoc-ref opts 'user)) (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
(bootstrap? (assoc-ref opts 'bootstrap?)) (user (assoc-ref opts 'user))
(system (assoc-ref opts 'system)) (bootstrap? (assoc-ref opts 'bootstrap?))
(profile (assoc-ref opts 'profile)) (system (assoc-ref opts 'system))
(command (or (assoc-ref opts 'exec) (profile (assoc-ref opts 'profile))
(command (or (assoc-ref opts 'exec)
;; Spawn a shell if the user didn't specify ;; Spawn a shell if the user didn't specify
;; anything in particular. ;; anything in particular.
(if container? (if container?
@ -915,12 +1023,22 @@ (define-syntax-rule (with-store/maybe store exp ...)
(leave (G_ "'--user' cannot be used without '--container'~%"))) (leave (G_ "'--user' cannot be used without '--container'~%")))
(when (and (not container?) no-cwd?) (when (and (not container?) no-cwd?)
(leave (G_ "--no-cwd cannot be used without --container~%"))) (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-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity) (with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest-from-opts (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 (define manifest
(if profile (if profile
@ -994,7 +1112,11 @@ (define manifest
#:white-list white-list #:white-list white-list
#:link-profile? link-prof? #:link-profile? link-prof?
#:network? network? #:network? network?
#:map-cwd? (not no-cwd?)))) #:map-cwd? (not no-cwd?)
#:emulate-fhs? emulate-fhs?
#:setup-hook
(and emulate-fhs?
setup-fhs))))
(else (else
(return (return

View file

@ -197,3 +197,37 @@ then false;
else else
test $? -gt 127 test $? -gt 127
fi 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")'