diff --git a/modules/fruix/system/freebsd/build.scm b/modules/fruix/system/freebsd/build.scm index 14c15cb..ad4a0da 100644 --- a/modules/fruix/system/freebsd/build.scm +++ b/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 diff --git a/tests/build-jails.scm b/tests/build-jails.scm index c83da3e..4df1932 100644 --- a/tests/build-jails.scm +++ b/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)) diff --git a/tests/package-profile.scm b/tests/package-profile.scm index af0d079..32e69eb 100644 --- a/tests/package-profile.scm +++ b/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))))