10/16: gnu: linux-container: Make it more suitable for derivation-building.

[guix-commits]

reepca pushed a commit to branch guile-daemon
in repository guix.

commit 7f47e3c657312d8c4fe0f3e48414968a494af82b
Author: Caleb Ristvedt <address@hidden>
Date:   Tue Jan 29 01:33:12 2019 -0600

    gnu: linux-container: Make it more suitable for derivation-building.
    
    * gnu/build/linux-container.scm (mount-file-systems): "/dev/pts" and
      "/dev/ptmx" are no longer bind-mounted from the host so that new instances
      can be created in the container (technically this just gets rid of the
      comments). Also, the tmpfs mounted over the chroot directory now inherits
      the chroot directory's permissions (p11-kit has a test that assumes that 
the
      root directory is not writable for the current user, and tmpfs is by 
default
      1777 when created). Also, use MS_REC to make all mounts in the container
      private, like the daemon currently does.
      (call-with-container): remove use-output. Unnecessary for two separate
      reasons: a directory to hold the output in can always be bind-mounted and
      still be written to, and I plan on using run-container anyway so that
      multiple PIDs can be waited on at once.
    
    * guix/build/syscalls.scm (MS_REC): new variable.
---
 gnu/build/linux-container.scm | 48 +++++++++++++++++--------------------------
 guix/build/syscalls.scm       |  2 ++
 2 files changed, 21 insertions(+), 29 deletions(-)

diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index d5b3c33..b38912b 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -102,7 +102,12 @@ for the process."
   ;; bind-mounted from the host.
   ;; Make this private in the container namespace so everything mounted under
   ;; it is local to this namespace.
-  (mount "none" root "none" MS_PRIVATE)
+  (mount "none" "/" "none" (logior MS_REC MS_PRIVATE))
+  (let ((current-perms (stat:perms (stat root))))
+    (mount "none" root "tmpfs" 0 (string-append "mode="
+                                                (number->string current-perms
+                                                                8))))
+
 
   ;; A proc mount requires a new pid namespace.
   (when mount-/proc?
@@ -133,11 +138,8 @@ for the process."
               "/dev/random"
               "/dev/urandom"
               "/dev/tty"
-   ;           "/dev/ptmx"
               "/dev/fuse"))
 
-  ;(mkdir (scope "/dev/pts"))
-  ;(bind-mount "/dev/pts" (scope "/dev/pts"))
 
   ;; Setup the container's /dev/console by bind mounting the pseudo-terminal
   ;; associated with standard input when there is one.
@@ -229,10 +231,7 @@ ipc, uts, user, and net.
 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)
 that host UIDs (respectively GIDs) map to in the namespace."
-  ;; this needs to be visible outside the namespace if anyone wants to use the
-  ;; file-system output of running THUNK.
-  (when (memq 'mnt namespaces)
-    (mount "none" root "tmpfs"))
+
   ;; The parent process must initialize the user namespace for the child
   ;; before it can boot.  To negotiate this, a pipe is used such that the
   ;; child process blocks until the parent writes to it.
@@ -291,7 +290,6 @@ that host UIDs (respectively GIDs) map to in the namespace."
 (define* (call-with-container mounts thunk #:key (namespaces %namespaces)
                               (host-uids 1) (guest-uid 0) (guest-gid 0)
                               use-output)
-
   "Run THUNK in a new container process and return its exit status.
 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
@@ -312,26 +310,18 @@ module files must be present in one of the mappings in 
MOUNTS and the Guile
 load path must be adjusted as needed."
   (call-with-temporary-directory
    (lambda (root)
-     (dynamic-wind
-       (const #t)
-       (lambda ()
-         (let ((pid (run-container root mounts namespaces host-uids thunk
-                                  #:guest-uid guest-uid
-                                  #:guest-gid guest-gid)))
-           ;; Catch SIGINT and kill the container process.
-           (sigaction SIGINT
-             (lambda (signum)
-               (false-if-exception
-                (kill pid SIGKILL))))
-
-           (match (waitpid pid)
-             ((_ . status)
-              (when use-output
-                (use-output root))
-              status))))
-       (lambda ()
-         (false-if-exception
-          (umount root)))))))
+     (let ((pid (run-container root mounts namespaces host-uids thunk
+                               #:guest-uid guest-uid
+                              #:guest-gid guest-gid)))
+       ;; Catch SIGINT and kill the container process.
+       (sigaction SIGINT
+         (lambda (signum)
+           (false-if-exception
+            (kill pid SIGKILL))))
+
+       (match (waitpid pid)
+         ((_ . status)
+          status))))))
 
 (define (container-excursion pid thunk)
   "Run THUNK as a child process within the namespaces of process PID and
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 396a343..85b3f50 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -43,6 +43,7 @@
             MS_MOVE
             MS_STRICTATIME
             MS_PRIVATE
+            MS_REC
             MNT_FORCE
             MNT_DETACH
             MNT_EXPIRE
@@ -456,6 +457,7 @@ the returned procedure is called."
 (define MS_REMOUNT           32)
 (define MS_BIND            4096)
 (define MS_MOVE            8192)
+(define MS_REC            16384)
 (define MS_PRIVATE       262144)
 (define MS_STRICTATIME 16777216)