environment: Add ‘--writable-root’ and default to read-only root.

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
Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

doc/guix.texi

@@ -6481,6 +6481,10 @@ directory within the container.  If this is undesirable,
 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
@@ -14125,7 +14129,8 @@ environment, with ungrafted packages (@pxref{Security Updates}, for more
 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

guix/scripts/environment.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
-;;; Copyright © 2015-2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2025 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
 ;;; Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
 ;;;
@@ -120,6 +120,8 @@ shell'."
   (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 @@ use '--preserve' instead~%"))
          (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 @@ providing a symlink for CC if GCC is in the container PROFILE, and writing
                   (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',
@@ -527,8 +535,7 @@ cache."
            (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
@@ -735,6 +742,7 @@ regexps in WHITE-LIST."
 (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.
@@ -881,15 +889,9 @@ WHILE-LIST."
        (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'.
@@ -899,42 +901,9 @@ WHILE-LIST."
             (setenv "LOGNAME" logname)
             (setenv "USER" logname)
 
-            ;; Create a dummy home directory.
-            (mkdir-p home-dir)
             (setenv "HOME" home-dir)
 
-            ;; Create symlinks.
-            (let ((symlink->directives
-                   (match-lambda
-                     ((source '-> target)
-                      `((directory ,(dirname source))
-                        (,source -> ,(string-append profile "/" target)))))))
-              (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.
-            (when link-profile? (link-environment profile home-dir))
-
-            ;; Create a dummy /etc/passwd to satisfy applications that demand
-            ;; to read it, such as 'git clone' over SSH, a valid use-case when
-            ;; sharing the host's network namespace.
-            (mkdir-p "/etc")
-            (write-passwd (list passwd))
-            (write-group groups)
-
             (unless network?
-              ;; When isolated from the network, provide a minimal /etc/hosts
-              ;; to resolve "localhost".
-              (call-with-output-file "/etc/hosts"
-                (lambda (port)
-                  (display "127.0.0.1 localhost\n" port)))
-
               ;; Allow local AF_INET communications.
               (set-network-interface-up "lo"))
 
@@ -959,9 +928,52 @@ WHILE-LIST."
                                      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)
+
+            ;; Create symlinks.
+            (let ((symlink->directives
+                   (match-lambda
+                     ((source '-> target)
+                      `((directory ,(dirname source))
+                        (,source -> ,(string-append profile "/" target)))))))
+              (for-each (cut evaluate-populate-directive <> ".")
+                        (append-map symlink->directives symlinks)))
+
+            ;; If requested, link $GUIX_ENVIRONMENT to $HOME/.guix-profile;
+            ;; this allows programs expecting that path to continue working as
+            ;; expected within a container.
+            (when link-profile? (link-environment profile home-dir))
+
+            ;; Create a dummy /etc/passwd to satisfy applications that demand
+            ;; to read it, such as 'git clone' over SSH, a valid use-case when
+            ;; sharing the host's network namespace.
+            (mkdir-p "/etc")
+            (write-passwd (list passwd))
+            (write-group groups)
+
+            (unless network?
+              ;; When isolated from the network, provide a minimal /etc/hosts
+              ;; to resolve "localhost".
+              (call-with-output-file "/etc/hosts"
+                (lambda (port)
+                  (display "127.0.0.1 localhost\n" port))))
+
+            ;; 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)))))))
@@ -1089,6 +1101,7 @@ command-line option processing with 'parse-command-line'."
          (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))
@@ -1136,6 +1149,8 @@ command-line option processing with 'parse-command-line'."
         (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?
@@ -1221,6 +1236,7 @@ when using '--container'; doing nothing~%"))
                                                   #:link-profile? link-prof?
                                                   #:network? network?
                                                   #:map-cwd? (not no-cwd?)
+                                                  #:writable-root? writable-root?
                                                   #:emulate-fhs? emulate-fhs?
                                                   #:nesting? nesting?
                                                   #:symlinks symlinks

tests/guix-environment-container.sh

@@ -1,7 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2015 David Thompson <davet@gnu.org>
 # Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
-# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2023, 2025 Ludovic Courtès <ludo@gnu.org>
 #
 # 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="