[bug#42849] [PATCH 2/3] linux-container: Add a jail? argument.

[Mathieu Othacehe <othacehe@gnu.org>]

We may want to run a container inside the MNT namespace, without jailing the
container. Add a "jail?" argument to "run-container" and "call-with-container"
methods.

* gnu/build/linux-container.scm (run-container): Add a "jail?" argument and
honor it,
(call-with-container): ditto, and pass the argument to "run-container".
---
 gnu/build/linux-container.scm | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 87695c98fd..bb9fb0d799 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -218,12 +218,13 @@ corresponds to the symbols in NAMESPACES."
               namespaces)))
 
 (define* (run-container root mounts namespaces host-uids thunk
-                        #:key (guest-uid 0) (guest-gid 0))
+                        #:key (guest-uid 0) (guest-gid 0) (jail? #t))
   "Run THUNK in a new container process and return its PID.  ROOT specifies
 the root directory for the container.  MOUNTS is a list of <file-system>
 objects that specify file systems to mount inside the container.  NAMESPACES
 is a list of symbols that correspond to the possible Linux namespaces: mnt,
-ipc, uts, user, and net.
+ipc, uts, user, and net. If JAIL? is false, MOUNTS list is ignored and the
+container is not jailed.
 
 HOST-UIDS specifies the number of host user identifiers to map into the user
 namespace.  GUEST-UID and GUEST-GID specify the first UID (respectively GID)
@@ -243,7 +244,7 @@ that host UIDs (respectively GIDs) map to in the namespace."
              (match (read child)
                ('ready
                 (purify-environment)
-                (when (memq 'mnt namespaces)
+                (when (and jail? (memq 'mnt namespaces))
                   (catch #t
                     (lambda ()
                       (mount-file-systems root mounts
@@ -300,13 +301,15 @@ delete it when leaving the dynamic extent of this call."
 
 (define* (call-with-container mounts thunk #:key (namespaces %namespaces)
                               (host-uids 1) (guest-uid 0) (guest-gid 0)
-                              (process-spawned-hook (const #t)))
+                              (process-spawned-hook (const #t))
+                              (jail? #f))
   "Run THUNK in a new container process and return its exit status; call
 PROCESS-SPAWNED-HOOK with the PID of the new process that has been spawned.
 MOUNTS is a list of <file-system> objects that specify file systems to mount
-inside the container.  NAMESPACES is a list of symbols corresponding to
-the identifiers for Linux namespaces: mnt, ipc, uts, pid, user, and net.  By
-default, all namespaces are used.
+inside the container.  NAMESPACES is a list of symbols corresponding to the
+identifiers for Linux namespaces: mnt, ipc, uts, pid, user, and net.  By
+default, all namespaces are used. If JAIL? is false, the MOUNTS list is
+ignored and the container is not jailed.
 
 HOST-UIDS is the number of host user identifiers to map into the container's
 user namespace, if there is one.  By default, only a single uid/gid, that of
@@ -324,7 +327,8 @@ load path must be adjusted as needed."
    (lambda (root)
      (let ((pid (run-container root mounts namespaces host-uids thunk
                                #:guest-uid guest-uid
-                               #:guest-gid guest-gid)))
+                               #:guest-gid guest-gid
+                               #:jail? jail?)))
        ;; Catch SIGINT and kill the container process.
        (sigaction SIGINT
          (lambda (signum)
-- 
2.28.0