[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: environment: Add '--emulate-fhs'.
|
From: |
guix-commits |
|
Subject: |
02/03: environment: Add '--emulate-fhs'. |
|
Date: |
Thu, 13 Oct 2022 03:36:05 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit c7ba5f38b80433b040d3946b8fc0b1e8621ba30a
Author: John Kehayias <john.kehayias@protonmail.com>
AuthorDate: Wed Jul 20 23:46:45 2022 -0400
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>
---
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 <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
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")'