[bug#56677] [PATCH v2 1/2] environment: Add --emulate-fhs option.

[John Kehayias via Guix-patches via <guix-patches@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 5181 bytes --]

Hi Ludo’!

Apologies for the long delay! I've done some more rewriting than expected, so let me outline some changes in the v2 patch (attached, while path 1/2 for glibc-for-fhs remains unchanged).

On Thu, Sep 08, 2022 at 10:58 PM, Ludovic Courtès wrote:

> Howdy,
>
> John Kehayias <john.kehayias@protonmail.com> skribis:
>
[snip]
>>> 1. Can we make the implementation more orthogonal and less entangled
>>> in the already-long ‘launch-environment/container’?
>>>
>>> Maybe that can be accomplished by moving all the code conditional
>>> on ‘emulate-fhs?’ out of the way in a separate procedure, and
>>> possibly by adding a generic hook in ‘launch-environment/container’
>>> that would call said procedure.
>>>
>>
>> Sure, this sounds like a good idea. I can certainly separate out the FHS setup to a
>> separate function and call it. But I'm not sure what you mean by a "generic hook" here.
>> Do you mean that launch-environment/container would have as an argument say a list of
>> functions it would call?
>
> Yes, or an argument with a single procedure to call at a specific
> point.  That would default to a no-op.
>

I've done some rearranging to address this and along the way fixed the command passing to the container to work the same as without --emulate-fhs (previously I hacked together a startup script that didn't properly capture the command given by the user).

Unfortunately, since some of the needed directories are bind mounted and others can be linked after creating filesystems, not all of the FHS directory setup can be done in the same place. To be explicit, bind mounts for all filesystems are set up in the early mlet of launch-environment/container, before being able to call a procedure to do other setup needed here.

The end result:

launch-environment/container now takes a key 'setup-hook' which defaults to #f. For now this only handles a single list with the function name and arguments (could extend this to be more general, but didn't have any use cases for it off hand). For the FHS container this is set, by the entry point guix-environment*, to the new function setup-fhs which sets up symlinks and ld.so.conf. Handling arguments was necessary as setup-fhs needs the profile used in the container.

So then launch-environment also gets a new 'emulate-fhs?' option so it can run some additional setup before running the command given by the user. What was the (hacky) /tmp/fhs.sh is now a setenv and invoke, before the final execlp for the given command.

A little more complicated perhaps, but I think functionally separates the different steps (bind mounts, symlinks and file creation, and running in the container) at least.

>>> 2. Please add tests. You can probably augment
>>> ‘tests/guix-environment-container.sh’ for that. Let us know if
>>> you’re not sure how to do that.
>>>
>>
>> Thanks, definitely forgot about that. In looking at that, I've just ran it with
>> "./pre-inst-env sh tests/guix-environment-container.sh" and see that the exit code is 0.
>> Is that the correct way to run these?
>
> The correct way is:
>
>   make check TESTS=tests/guix-environment-container.sh
>
> Compared to what you wrote, it uses ./test-env (which spawns a daemon
> that uses the local store, not /gnu/sore) and sets a bunch of
> environment variables.
>
> See
> <https://guix.gnu.org/manual/devel/en/html_node/Running-the-Test-Suite.html>.
>

Thanks, missed that somehow.

>> Secondly, I'm trying to think of what tests to add. I could of course run the same tests
>> already, but with the --emulate-fhs option, to check that there are no regressions.
>> Other than that, maybe checking that e.g. there's /etc/ld.so.cache, /lib, and so on?
>
> Right, at least you’d want to check for these files/directories.
>
> Note that since the test relies on ‘glibc-for-fhs’, it cannot be done
> the “normal way” (that is, using the local store rather than /gnu/store)
> because it would end up building the world.
>
> The solution here is to use /gnu/store, if available, and to otherwise
> skip the test (return 77).  See ‘tests/guix-pack-relocatable.sh’ up to
> line 40 on how to do that.
>
> HTH!
>

Very helpful, thanks!

I added in two tests to the end of tests/guix-environment-container.sh. One checks for the FHS file structure in the container and the other tries to read the ld cache (using 'ldconfig -p').

If we wanted to run all the non-fhs tests with --emulate-fhs, then maybe we'd want to make it so the FHS specific tests live in a new file and guix-environment-container.sh can be called in a way to enable that option? (A quick guess would be to just set an alias so that guix environment is always called with --emulate-fhs, but not sure if that works in the test environment.)

Wasn't sure if all that is necessary so I just went with the FHS-specific tests for now. I checked that they pass for me.

The commit changelog has gotten a bit more complicated with these changes, hopefully I got everything in there.

Thanks for your help on this and I'll make sure any future revisions are more timely!
John

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-environment-Add-emulate-fhs-v2.patch --]
[-- Type: text/x-patch; name=0002-environment-Add-emulate-fhs-v2.patch, Size: 20483 bytes --]

From de7ae9b203a65e1ec1b1429ca4076f3f91b1ae33 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] 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'.
---
 doc/guix.texi                       |  33 ++++++
 guix/scripts/environment.scm        | 167 ++++++++++++++++++++++++----
 tests/guix-environment-container.sh |  34 ++++++
 3 files changed, 211 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 535c8cdfc3..99dea2e3c1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -107,6 +107,7 @@
 Copyright @copyright{} 2022 Justin Veilleux@*
 Copyright @copyright{} 2022 Reily Siegel@*
 Copyright @copyright{} 2022 Simon Streit@*
+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
@@ -6187,6 +6188,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}
@@ -6604,6 +6621,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 2493134470..f5b417457d 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 @@ (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)))
@@ -375,6 +382,65 @@ (define (inputs->requisites 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 @@ (define exit/status (compose exit status->exit-code))
 (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 @@ (define* (launch-environment command profile manifest
     ((program . args)
      (catch 'system-error
        (lambda ()
+         (when emulate-fhs?
+           ;; When running in a container with EMULATE-FHS?, supplement $PATH
+           ;; (optional, but to better match FHS expectations), and generate
+           ;; /etc/ld.so.cache.
+           (setenv "PATH" "/bin:/usr/bin:/sbin:/usr/sbin:$PATH")
+           (invoke "ldconfig" "-X"))
          (apply execlp program program args))
        (lambda _
          ;; Report the error from here because the parent process cannot
@@ -604,15 +678,20 @@ (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? (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
+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, as a
+list with the function name and arguments, 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
@@ -621,6 +700,21 @@ (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 (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 +769,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
@@ -702,6 +801,12 @@ (define* (launch-environment/container #:key command bash user user-mappings
             (mkdir-p home-dir)
             (setenv "HOME" home-dir)
 
+            ;; Call an additional setup procedure, if provided.  Currently
+            ;; this is only used with the EMULATE-FHS? option, but could be
+            ;; expanded to a general list of functions to be called.
+            (if setup-hook
+                (apply (car setup-hook) (cdr setup-hook)))
+
             ;; 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 +848,8 @@ (define* (launch-environment/container #:key command bash user user-mappings
                                  (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 +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?
@@ -915,12 +1022,22 @@ (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
@@ -994,7 +1111,11 @@ (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?
+                                                    #:setup-hook (if emulate-fhs?
+                                                                     (list setup-fhs profile)
+                                                                     #f))))
 
                    (else
                     (return
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 2e238c501d..31e409420f 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 '(exit (execlp "ldconfig" "-p"))'
-- 
2.37.3