From 27d40cbd60471b79dc1692f7db4aef495b93493d Mon Sep 17 00:00:00 2001
From: John Kehayias <john.kehayias@protonmail.com>
Date: Wed, 20 Jul 2022 23:46:45 -0400
Subject: [PATCH 2/2] 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 | 156 ++++++++++++++++++++++++++++++-----
2 files changed, 167 insertions(+), 22 deletions(-)
@@ -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}
@@ -6574,6 +6591,22 @@ Invoking guix environment
@end table
+@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.
+
@command{guix environment}
also supports all of the common build options that @command{guix
build} supports (@pxref{Common Build Options}) as well as package
@@ -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 @@ (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 (optional) 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,53 @@ (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 above, the optional symlinks, and linking the
+ ;; contents of profile/bin and profile/etc, 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 +841,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 +972,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 +1021,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 +1112,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.0