me
/
guix
Archived
1
0
Fork 0

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>
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 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}

View File

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
;;;
;;; 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

View File

@ -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")'