Subject: [bug#77638] [PATCH 5/8] environment: Add ‘--writable-root’ and default to read-only root.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 8 Apr 2025 14:24:45 +0200

This is an incompatible change where the root file system in
‘guix shell -C’ is now read-only by default.

* guix/scripts/environment.scm (show-environment-options-help)
(%options): Add ‘--writable-root’.
* guix/scripts/environment.scm (setup-fhs): Invoke /sbin/ldconfig; moved
from…
(launch-environment): … here.
(launch-environment/container): Add #:writable-root? and pass it to
‘call-with-container’.  Move root file system setup to #:populate-file-system.
(guix-environment*): Honor ‘--writable-root’.
* tests/guix-environment-container.sh: Test it.
* doc/guix.texi (Invoking guix shell): Document ‘--writable-root’.
(Debugging Build Failures): Mention it before “rm /bin/sh”.

Change-Id: I2e8517d6f01eb8093160bffc0f9f56071ad6fee6
---
 doc/guix.texi                       |  7 ++-
 guix/scripts/environment.scm        | 98 +++++++++++++++++------------
 tests/guix-environment-container.sh | 11 +++-
 3 files changed, 73 insertions(+), 43 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3d91dfd7b1..44ead7148b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6401,6 +6401,10 @@ Invoking guix shell
 be automatically shared and will change to the user's home directory
 within the container instead.  See also @option{--user}.
 
+@item --writable-root
+When using @option{--container}, this option makes the root file system
+writable (it is read-only by default).
+
 @item --expose=@var{source}[=@var{target}]
 @itemx --share=@var{source}[=@var{target}]
 For containers, @option{--expose} (resp. @option{--share}) exposes the
@@ -14043,7 +14047,8 @@ Debugging Build Failures
 info on grafts).
 
 To get closer to a container like that used by the build daemon, we can
-remove @file{/bin/sh}:
+remove @file{/bin/sh} (you'll first need to pass the
+@option{--writable-root} option to @command{guix shell}):
 
 @example
 [env]# rm /bin/sh
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 4be9807163..8f3bea8c30 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2018 David Thompson <[email-masked]>
-;;; Copyright © 2015-2024 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2015-2025 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2018 Mike Gerwitz <[email-masked]>
 ;;; Copyright © 2022, 2023 John Kehayias <[email-masked]>
 ;;;
@@ -120,6 +120,8 @@ (define (show-environment-options-help)
   (display (G_ "
       --no-cwd           do not share current working directory with an
                          isolated container"))
+  (display (G_ "
+      --writable-root    make the container's root file system writable"))
 
   (display (G_ "
       --share=SPEC       for containers, share writable host file system
@@ -261,6 +263,9 @@ (define %options
          (option '("no-cwd") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'no-cwd? #t result)))
+         (option '("writable-root") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'writable-root? #t result)))
          (option '("share") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'file-system-mapping
@@ -483,7 +488,10 @@ (define (setup-fhs profile)
                   (newline port))
                 ;; /lib/nss is needed as Guix's nss puts libraries
                 ;; there rather than in the lib directory.
-                '("/lib" "/lib/nss")))))
+                '("/lib" "/lib/nss"))))
+
+  ;; Create /etc/ld.so.cache.
+  (invoke "/sbin/ldconfig" "-X"))
 
 (define (status->exit-code status)
   "Compute the exit code made from STATUS, a value as returned by 'waitpid',
@@ -525,8 +533,7 @@ (define* (launch-environment command profile manifest
            (setenv "PATH" (string-append "/bin:/usr/bin:/sbin:/usr/sbin"
                                          (if (getenv "PATH")
                                              (string-append ":" (getenv "PATH"))
-                                             "")))
-           (invoke "ldconfig" "-X"))
+                                             ""))))
          (apply execlp program program args))
        (lambda _
          ;; Report the error from here because the parent process cannot
@@ -733,6 +740,7 @@ (define* (launch-environment/fork command profile manifest
 (define* (launch-environment/container #:key command bash user user-mappings
                                        profile manifest link-profile? network?
                                        map-cwd? emulate-fhs? nesting?
+                                       writable-root?
                                        (setup-hook #f)
                                        (symlinks '()) (white-list '()))
   "Run COMMAND within a container that features the software in PROFILE.
@@ -879,15 +887,9 @@ (define* (launch-environment/container #:key command bash user user-mappings
        (exit/status
         (call-with-container file-systems
           (lambda ()
-            ;; Setup global shell.
-            (mkdir-p "/bin")
-            (symlink bash "/bin/sh")
-
             ;; Set a reasonable default PS1.
             (setenv "PS1" "\\u@\\h \\w [env]\\$ ")
 
-            ;; Setup directory for temporary files.
-            (mkdir-p "/tmp")
             (for-each (lambda (var)
                         (setenv var "/tmp"))
                       ;; The same variables as in Nix's 'build.cc'.
@@ -897,9 +899,44 @@ (define* (launch-environment/container #:key command bash user user-mappings
             (setenv "LOGNAME" logname)
             (setenv "USER" logname)
 
+            (setenv "HOME" home-dir)
+
+            (unless network?
+              ;; Allow local AF_INET communications.
+              (set-network-interface-up "lo"))
+
+            ;; For convenience, start in the user's current working
+            ;; directory or, if unmapped, the home directory.
+            (chdir (if map-cwd?
+                       (override-user-dir user home cwd)
+                       home-dir))
+
+            ;; Set environment variables that match WHITE-LIST.
+            (for-each (match-lambda
+                        ((variable . value)
+                         (setenv variable value)))
+                      environ)
+
+            (primitive-exit/status
+             ;; A container's environment is already purified, so no need to
+             ;; request it be purified again.
+             (launch-environment command
+                                 (if link-profile?
+                                     (string-append home-dir "/.guix-profile")
+                                     profile)
+                                 manifest #:pure? #f
+                                 #:emulate-fhs? emulate-fhs?)))
+          #:populate-file-system
+          (lambda ()
+            ;; Setup global shell.
+            (mkdir-p "/bin")
+            (symlink bash "/bin/sh")
+
+            ;; Setup directory for temporary files.
+            (mkdir-p "/tmp")
+
             ;; Create a dummy home directory.
             (mkdir-p home-dir)
-            (setenv "HOME" home-dir)
 
             ;; Create symlinks.
             (let ((symlink->directives
@@ -910,10 +947,6 @@ (define* (launch-environment/container #:key command bash user user-mappings
               (for-each (cut evaluate-populate-directive <> ".")
                         (append-map symlink->directives symlinks)))
 
-            ;; 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.
@@ -931,35 +964,14 @@ (define* (launch-environment/container #:key command bash user user-mappings
               ;; to resolve "localhost".
               (call-with-output-file "/etc/hosts"
                 (lambda (port)
-                  (display "127.0.0.1 localhost\n" port)))
+                  (display "127.0.0.1 localhost\n" port))))
 
-              ;; Allow local AF_INET communications.
-              (set-network-interface-up "lo"))
-
-            ;; For convenience, start in the user's current working
-            ;; directory or, if unmapped, the home directory.
-            (chdir (if map-cwd?
-                       (override-user-dir user home cwd)
-                       home-dir))
-
-            ;; Set environment variables that match WHITE-LIST.
-            (for-each (match-lambda
-                        ((variable . value)
-                         (setenv variable value)))
-                      environ)
-
-            (primitive-exit/status
-             ;; A container's environment is already purified, so no need to
-             ;; request it be purified again.
-             (launch-environment command
-                                 (if link-profile?
-                                     (string-append home-dir "/.guix-profile")
-                                     profile)
-                                 manifest #:pure? #f
-                                 #:emulate-fhs? emulate-fhs?)))
+            ;; Call an additional setup procedure, if provided.
+            (when setup-hook
+              (setup-hook profile)))
           #:guest-uid uid
           #:guest-gid gid
-          #:writable-root? #t                     ;for backward compatibility
+          #:writable-root? writable-root?
           #:namespaces (if network?
                            (delq 'net %namespaces) ; share host network
                            %namespaces)))))))
@@ -1087,6 +1099,7 @@ (define (guix-environment* opts)
          (symlinks     (assoc-ref opts 'symlinks))
          (network?     (assoc-ref opts 'network?))
          (no-cwd?      (assoc-ref opts 'no-cwd?))
+         (writable-root? (assoc-ref opts 'writable-root?))
          (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
          (nesting?     (assoc-ref opts 'nesting?))
          (user         (assoc-ref opts 'user))
@@ -1134,6 +1147,8 @@ (define (guix-environment* opts)
         (leave (G_ "'--user' cannot be used without '--container'~%")))
       (when no-cwd?
         (leave (G_ "--no-cwd cannot be used without '--container'~%")))
+      (when writable-root?
+        (leave (G_ "'--writable-root' cannot be used without '--container'~%")))
       (when emulate-fhs?
         (leave (G_ "'--emulate-fhs' cannot be used without '--container'~%")))
       (when nesting?
@@ -1219,6 +1234,7 @@ (define (guix-environment* opts)
                                                   #:link-profile? link-prof?
                                                   #:network? network?
                                                   #:map-cwd? (not no-cwd?)
+                                                  #:writable-root? writable-root?
                                                   #:emulate-fhs? emulate-fhs?
                                                   #:nesting? nesting?
                                                   #:symlinks symlinks
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 09704f751c..d6cb382de9 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -1,7 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2015 David Thompson <[email-masked]>
 # Copyright © 2022, 2023 John Kehayias <[email-masked]>
-# Copyright © 2023 Ludovic Courtès <[email-masked]>
+# Copyright © 2023, 2025 Ludovic Courtès <[email-masked]>
 #
 # This file is part of GNU Guix.
 #
@@ -186,6 +186,15 @@ HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
             -- /bin/sh -c 'test $(pwd) == "/home/foo" -a ! -d '"$tmpdir"
 )
 
+# Check that the root file system is read-only by default...
+guix environment --bootstrap --container --ad-hoc guile-bootstrap \
+     -- guile -c '(mkdir "/whatever")' && false
+
+# ... and can be made writable.
+guix environment --bootstrap --container --ad-hoc guile-bootstrap	\
+     --writable-root							\
+     -- guile -c '(mkdir "/whatever")'
+
 # Check the exit code.
 
 abnormal_exit_code="
-- 
2.49.0