Minimize mounts for jailed union assembly

modules/fruix/system/freebsd/build.scm

@@ -230,6 +230,24 @@
 (define (current-user-home)
   (user-home-directory (current-user-name)))
 
+(define (user-numeric-id user)
+  (and user
+       (safe-command-output "id" "-u" user)))
+
+(define (user-primary-group-id user)
+  (and user
+       (safe-command-output "id" "-g" user)))
+
+(define (user-primary-group-name user)
+  (and user
+       (safe-command-output "id" "-gn" user)))
+
+(define (current-user-id)
+  (user-numeric-id (current-user-name)))
+
+(define (current-user-group-id)
+  (user-primary-group-id (current-user-name)))
+
 (define jail-default-path
   "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin")
 
@@ -683,6 +701,44 @@
     (script . ,script)
     (command . ,(build-jail-command-string executor jail-root jail-name config "/run.sh"))))
 
+(define (build-jail-needs-local-user-database? _config mount-specs)
+  (let ((mounted-targets (map jail-mount-spec-target mount-specs)))
+    (not (path-covered-by-any-root? "/etc" mounted-targets))))
+
+(define (write-minimal-jail-user-database jail-root config)
+  (let* ((user (build-jail-config-value config 'user #f))
+         (home (or (build-jail-config-value config 'home #f)
+                   "/tmp"))
+         (uid (or (and user (user-numeric-id user))
+                  "1000"))
+         (gid (or (and user (user-primary-group-id user))
+                  "1000"))
+         (group-name (or (and user (user-primary-group-name user))
+                         user
+                         "build"))
+         (etc-root (jail-root-target jail-root "/etc"))
+         (master-passwd (string-append etc-root "/master.passwd")))
+    (mkdir-p etc-root)
+    (write-file master-passwd
+                (string-append
+                 "root:*:0:0::0:0:Charlie Root:/root:/bin/sh\n"
+                 (if user
+                     (string-append user ":*:" uid ":" gid "::0:0::" home ":/bin/sh\n")
+                     "")))
+    (chmod master-passwd #o600)
+    (run-command "pwd_mkdb" "-d" etc-root master-passwd)
+    (write-file (string-append etc-root "/group")
+                (string-append
+                 "wheel:*:0:root"
+                 (if (and user (string=? group-name "wheel"))
+                     (string-append "," user)
+                     "")
+                 "\n"
+                 (if user
+                     (string-append group-name ":*:" gid ":" user "\n")
+                     ""))))
+  )
+
 (define* (run-script-in-temporary-jail executor script
                                        #:key
                                        name
@@ -718,6 +774,8 @@
         (for-each (lambda (directory)
                     (mkdir-p (jail-root-target jail-root directory)))
                   (build-jail-effective-directories effective-config))
+        (when (build-jail-needs-local-user-database? effective-config mount-specs)
+          (write-minimal-jail-user-database jail-root effective-config))
         (for-each (lambda (spec)
                     (ensure-jail-mount-target jail-root spec))
                   mount-specs)
@@ -782,6 +840,16 @@
   (map host-path->jail-mount-pair
        (filter file-exists? copy-build-mounted-host-paths)))
 
+(define union-tree-mounted-host-paths
+  '("/bin"
+    "/lib"
+    "/libexec"
+    "/usr/bin"))
+
+(define (union-tree-read-only-mounts)
+  (map host-path->jail-mount-pair
+       (filter file-exists? union-tree-mounted-host-paths)))
+
 (define (union-tree-mode? mode)
   (memq mode '(copy symlink)))
 
@@ -954,6 +1022,16 @@
     (source-roots . ,source-roots)
     (run-metadata . ,run-metadata)))
 
+(define (chown-path-to-current-user executor path)
+  (let ((uid (current-user-id))
+        (gid (current-user-group-id)))
+    (when (and uid gid (eq? (native-build-executor-kind executor) 'jail))
+      (run-jail-admin-command executor
+                              (string-append "chown -hR "
+                                             (shell-quote (string-append uid ":" gid))
+                                             " "
+                                             (shell-quote path))))))
+
 (define* (materialize-union-tree source-roots output-path #:key metadata-file (mode 'copy) (name "fruix-tree-union"))
   (unless (union-tree-mode? mode)
     (error "materialize-union-tree mode must be copy or symlink" mode))
@@ -967,13 +1045,16 @@
         (union-tree-jail-script normalized-source-roots output-path mode)
         #:config (build-jail-config
                   #:name name
-                  #:read-only-mounts (append (copy-build-read-only-mounts)
+                  #:read-only-mounts (append (union-tree-read-only-mounts)
                                              (map host-path->jail-mount-pair normalized-source-roots))
                   #:writable-mounts (list (cons output-path output-path))
-                  #:mounts (list (jail-devfs-mount "/dev"))
+                  #:env '(("HOME" . "/tmp"))
+                  #:user #f
+                  #:home "/tmp"
                   #:workdir output-path
-                  #:directories '("/tmp" "/dev")
+                  #:directories '("/tmp")
                   #:metadata-file metadata-file))
+       (chown-path-to-current-user executor output-path)
        (when metadata-file
          (let ((run-metadata (call-with-input-file metadata-file read)))
            (write-file metadata-file

tests/build-jails.scm

@@ -221,8 +221,27 @@
     (let ((target (false-if-exception (readlink (string-append output-dir "/share/data")))))
       (and target
            (string=? target (string-append source-b "/share/data")))))
-  (test-assert "union tree metadata records symlink mode"
-    (string-contains (command-output "cat" metadata-file) "(mode . symlink)"))
+  (let* ((metadata (read-scheme-file metadata-file))
+         (mode-entry (assoc 'mode metadata))
+         (run-metadata-entry (assoc 'run-metadata metadata))
+         (run-metadata (and run-metadata-entry (cdr run-metadata-entry)))
+         (mounts-entry (and run-metadata (assoc 'mounts run-metadata)))
+         (env-entry (and run-metadata (assoc 'env run-metadata)))
+         (home-entry (and run-metadata (assoc 'home run-metadata))))
+    (test-equal "union tree metadata records symlink mode"
+      'symlink
+      (and mode-entry (cdr mode-entry)))
+    (when run-metadata
+      (let ((mounts-text (object->string (and mounts-entry (cdr mounts-entry))))
+            (env-text (object->string (and env-entry (cdr env-entry)))))
+        (test-assert "union tree jail omits host /etc mount"
+          (not (string-contains mounts-text "\"/etc\"")))
+        (test-assert "union tree jail omits devfs mount"
+          (not (string-contains mounts-text "(devfs")))
+        (test-assert "union tree jail uses temporary HOME"
+          (and home-entry (string=? (cdr home-entry) "/tmp")))
+        (test-assert "union tree jail env overrides HOME to /tmp"
+          (string-contains env-text "(\"HOME\" . \"/tmp\")")))))
   (delete-path-if-exists source-a)
   (delete-path-if-exists source-b)
   (delete-path-if-exists output-dir))

tests/package-profile.scm

@@ -42,6 +42,9 @@
   (or (file-exists? path)
       (false-if-exception (readlink path))))
 
+(define (read-scheme-file path)
+  (call-with-input-file path read))
+
 (test-begin "package-profile")
 
 (let* ((store-dir (mktemp-directory "/tmp/fruix-package-profile-store.XXXXXX"))
@@ -96,9 +99,21 @@
     (and first-profile-jail-metadata-file
          (file-exists? first-profile-jail-metadata-file)))
   (when first-profile-jail-metadata-file
-    (let ((metadata-text (command-output "cat" first-profile-jail-metadata-file)))
+    (let* ((metadata (read-scheme-file first-profile-jail-metadata-file))
+           (mode-entry (assoc 'mode metadata))
+           (run-metadata-entry (assoc 'run-metadata metadata))
+           (run-metadata (and run-metadata-entry (cdr run-metadata-entry)))
+           (mounts-entry (and run-metadata (assoc 'mounts run-metadata)))
+           (network-entry (and run-metadata (assoc 'network? run-metadata))))
+      (test-equal "profile jail metadata records copy mode"
+        'copy
+        (and mode-entry (cdr mode-entry)))
       (test-assert "profile jail metadata records network disabled"
-        (string-contains metadata-text "(network? . #f)"))))
+        (and network-entry (eq? (cdr network-entry) #f)))
+      (test-assert "profile jail metadata omits host /etc mount"
+        (not (string-contains (object->string (and mounts-entry (cdr mounts-entry))) "\"/etc\"")))
+      (test-assert "profile jail metadata omits devfs mount"
+        (not (string-contains (object->string (and mounts-entry (cdr mounts-entry))) "(devfs")))))
   (test-assert "installed lists nodejs after first install"
     (member "freebsd-nodejs"
             (map summary-line-name (output-lines installed-output-1))))