diff --git a/modules/fruix/system/freebsd/media.scm b/modules/fruix/system/freebsd/media.scm index 8f73774..0287ca6 100644 --- a/modules/fruix/system/freebsd/media.scm +++ b/modules/fruix/system/freebsd/media.scm @@ -347,6 +347,33 @@ (define (shell-quote text) (string-append "'" (string-replace-all text "'" "'\"'\"'") "'")) +(define rootfs-helper-metadata-version "1") + +(define (executor-metadata-summary executor) + `((kind . ,(native-build-executor-kind executor)) + (name . ,(native-build-executor-name executor)) + (version . ,(native-build-executor-version executor)))) + +(define* (rootfs-helper-step-metadata executor step details #:key run-metadata) + `((rootfs-helper-metadata-version . ,rootfs-helper-metadata-version) + (step . ,step) + (executor . ,(executor-metadata-summary executor)) + (details . ,details) + (run-metadata . ,run-metadata))) + +(define (write-rootfs-helper-step-metadata executor metadata-file step details) + (when metadata-file + (mkdir-p (dirname metadata-file)) + (write-file metadata-file + (object->string + (rootfs-helper-step-metadata + executor step details + #:run-metadata + (and (eq? (native-build-executor-kind executor) 'jail) + (file-exists? metadata-file) + (call-with-input-file metadata-file read))))) + (chmod metadata-file #o644))) + (define (rootfs-helper-read-only-mounts extra-paths) (map (lambda (path) (cons path path)) @@ -396,9 +423,25 @@ (list source-root) (list (cons target-root target-root)) #:metadata-file metadata-file - #:user user)) + #:user user) + (write-rootfs-helper-step-metadata + executor + metadata-file + 'copy-tree-contents + `((name . ,name) + (source-root . ,source-root) + (target-root . ,target-root) + (user . ,user)))) (else - (copy-tree-contents source-root target-root))))) + (copy-tree-contents source-root target-root) + (write-rootfs-helper-step-metadata + executor + metadata-file + 'copy-tree-contents + `((name . ,name) + (source-root . ,source-root) + (target-root . ,target-root) + (user . ,user))))))) (define* (copy-rootfs-for-image/isolated source-rootfs image-rootfs #:key metadata-file user) @@ -434,9 +477,29 @@ items (list (cons rootfs rootfs)) #:metadata-file metadata-file - #:user user)) + #:user user) + (write-rootfs-helper-step-metadata + executor + metadata-file + 'copy-store-items-into-rootfs + `((rootfs . ,rootfs) + (store-dir . ,store-dir) + (store-root . ,store-root) + (item-count . ,(length items)) + (items . ,items) + (user . ,user)))) (else - (copy-store-items-into-rootfs rootfs store-dir items))))) + (copy-store-items-into-rootfs rootfs store-dir items) + (write-rootfs-helper-step-metadata + executor + metadata-file + 'copy-store-items-into-rootfs + `((rootfs . ,rootfs) + (store-dir . ,store-dir) + (store-root . ,store-root) + (item-count . ,(length items)) + (items . ,items) + (user . ,user))))))) (define system-generation-layout-version "2") @@ -537,7 +600,7 @@ "mkdir -p " (shell-quote (dirname destination)) "\n" "cp -p " (shell-quote source) " " (shell-quote destination) "\n")) -(define (populate-rootfs-layout/host rootfs closure-path) +(define* (populate-rootfs-layout/host rootfs closure-path #:key metadata-file) (for-each (lambda (dir) (mkdir-p (string-append rootfs dir))) rootfs-population-directories) @@ -619,136 +682,158 @@ (symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-activate" (string-append rootfs "/usr/local/etc/rc.d/fruix-activate")) (symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-shepherd" - (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd"))) + (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd")) + (write-rootfs-helper-step-metadata + (default-jail-build-executor) + metadata-file + 'populate-rootfs-layout + `((rootfs . ,rootfs) + (closure-path . ,closure-path) + (directory-count . ,(length rootfs-population-directories)) + (copied-etc-files . ,rootfs-copied-etc-files)))) -(define (populate-rootfs-layout/isolated rootfs closure-path) - (run-rootfs-helper-in-jail - "fruix-rootfs-layout" - (string-append - "#!/bin/sh\n" - "set -eu\n" - (string-concatenate - (append - (map (lambda (dir) - (string-append "mkdir -p " (shell-quote (string-append rootfs dir)) "\n")) - rootfs-population-directories) - (list (string-append "chmod 1777 " (shell-quote (string-append rootfs "/tmp")) "\n") - (render-shell-symlink-force closure-path (string-append rootfs "/run/current-system")) - (render-shell-symlink-force "/run/current-system/activate" (string-append rootfs "/activate"))) - (map (lambda (dir) - (render-shell-symlink-force (string-append "/run/current-system/profile/" dir) - (string-append rootfs "/" dir))) - rootfs-profile-top-level-links) - (map (lambda (dir) - (render-shell-symlink-force (string-append "/run/current-system/profile/usr/" dir) - (string-append rootfs "/usr/" dir))) - rootfs-profile-usr-links) - (if (file-exists? (string-append closure-path "/profile/usr/share/locale")) - (list (render-shell-symlink-force "/run/current-system/profile/usr/share/locale" - (string-append rootfs "/usr/share/locale"))) - '()) - (map (lambda (path) - (render-shell-symlink-force (string-append "/run/current-system/profile/etc/" path) - (string-append rootfs "/etc/" path))) - rootfs-profile-etc-links) - (map (lambda (path) - (render-shell-symlink-force (string-append "/run/current-system/etc/" path) - (string-append rootfs "/etc/" path))) - rootfs-system-etc-links) - (map (lambda (path) - (render-shell-copy-regular-file (string-append closure-path "/etc/" path) - (string-append rootfs "/etc/" path))) - rootfs-copied-etc-files) - (if (file-exists? (string-append closure-path "/profile/usr/share/misc/termcap")) - (list (render-shell-symlink-force "/run/current-system/profile/usr/share/misc/termcap" - (string-append rootfs "/usr/share/misc/termcap")) - (render-shell-symlink-force "/run/current-system/profile/etc/termcap" - (string-append rootfs "/etc/termcap"))) - '()) - (if (file-exists? (string-append closure-path "/profile/usr/share/misc/termcap.db")) - (list (render-shell-symlink-force "/run/current-system/profile/usr/share/misc/termcap.db" - (string-append rootfs "/usr/share/misc/termcap.db"))) - '()) - (if (file-exists? (string-append closure-path "/profile/etc/termcap.small")) - (list (render-shell-symlink-force "/run/current-system/profile/etc/termcap.small" - (string-append rootfs "/etc/termcap.small"))) - '()) - (if (file-exists? (string-append closure-path "/etc/ssh/sshd_config")) - (list (render-shell-symlink-force "/run/current-system/etc/ssh/sshd_config" - (string-append rootfs "/etc/ssh/sshd_config"))) - '()) - (map (lambda (path) - (render-shell-symlink-force (string-append "/run/current-system/boot/" path) - (string-append rootfs "/boot/" path))) - rootfs-boot-links) - (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix" - (string-append rootfs "/usr/local/bin/fruix"))) - (if (file-exists? (string-append closure-path "/development-profile")) - (list (render-shell-symlink-force "/run/current-system/development-profile" - (string-append rootfs "/run/current-development"))) - '()) - (if (file-exists? (string-append closure-path "/build-profile")) - (append - (list (render-shell-symlink-force "/run/current-system/build-profile" - (string-append rootfs "/run/current-build"))) - (if (file-exists? (string-append closure-path "/build-profile/usr/include")) - (list (render-shell-symlink-force "/run/current-system/build-profile/usr/include" - (string-append rootfs "/usr/include"))) - '()) - (if (file-exists? (string-append closure-path "/build-profile/usr/share/mk")) - (list (render-shell-symlink-force "/run/current-system/build-profile/usr/share/mk" - (string-append rootfs "/usr/share/mk"))) - '())) - '()) - (if (and (not (file-exists? (string-append closure-path "/build-profile"))) - (file-exists? (string-append closure-path "/development-profile"))) - (append - (if (file-exists? (string-append closure-path "/development-profile/usr/include")) - (list (render-shell-symlink-force "/run/current-system/development-profile/usr/include" - (string-append rootfs "/usr/include"))) - '()) - (if (file-exists? (string-append closure-path "/development-profile/usr/share/mk")) - (list (render-shell-symlink-force "/run/current-system/development-profile/usr/share/mk" - (string-append rootfs "/usr/share/mk"))) - '())) - '()) - (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-development-environment")) - (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-development-environment" - (string-append rootfs "/usr/local/bin/fruix-development-environment"))) - '()) - (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-build-environment")) - (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-build-environment" - (string-append rootfs "/usr/local/bin/fruix-build-environment"))) - '()) - (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-self-hosted-native-build")) - (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-self-hosted-native-build" - (string-append rootfs "/usr/local/bin/fruix-self-hosted-native-build"))) - '()) - (list (render-shell-symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-activate" - (string-append rootfs "/usr/local/etc/rc.d/fruix-activate")) - (render-shell-symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-shepherd" - (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd")))))) - (list closure-path) - (list (cons rootfs rootfs)))) +(define* (populate-rootfs-layout/isolated rootfs closure-path #:key metadata-file) + (let ((executor (default-jail-build-executor))) + (run-rootfs-helper-in-jail + "fruix-rootfs-layout" + (string-append + "#!/bin/sh\n" + "set -eu\n" + (string-concatenate + (append + (map (lambda (dir) + (string-append "mkdir -p " (shell-quote (string-append rootfs dir)) "\n")) + rootfs-population-directories) + (list (string-append "chmod 1777 " (shell-quote (string-append rootfs "/tmp")) "\n") + (render-shell-symlink-force closure-path (string-append rootfs "/run/current-system")) + (render-shell-symlink-force "/run/current-system/activate" (string-append rootfs "/activate"))) + (map (lambda (dir) + (render-shell-symlink-force (string-append "/run/current-system/profile/" dir) + (string-append rootfs "/" dir))) + rootfs-profile-top-level-links) + (map (lambda (dir) + (render-shell-symlink-force (string-append "/run/current-system/profile/usr/" dir) + (string-append rootfs "/usr/" dir))) + rootfs-profile-usr-links) + (if (file-exists? (string-append closure-path "/profile/usr/share/locale")) + (list (render-shell-symlink-force "/run/current-system/profile/usr/share/locale" + (string-append rootfs "/usr/share/locale"))) + '()) + (map (lambda (path) + (render-shell-symlink-force (string-append "/run/current-system/profile/etc/" path) + (string-append rootfs "/etc/" path))) + rootfs-profile-etc-links) + (map (lambda (path) + (render-shell-symlink-force (string-append "/run/current-system/etc/" path) + (string-append rootfs "/etc/" path))) + rootfs-system-etc-links) + (map (lambda (path) + (render-shell-copy-regular-file (string-append closure-path "/etc/" path) + (string-append rootfs "/etc/" path))) + rootfs-copied-etc-files) + (if (file-exists? (string-append closure-path "/profile/usr/share/misc/termcap")) + (list (render-shell-symlink-force "/run/current-system/profile/usr/share/misc/termcap" + (string-append rootfs "/usr/share/misc/termcap")) + (render-shell-symlink-force "/run/current-system/profile/etc/termcap" + (string-append rootfs "/etc/termcap"))) + '()) + (if (file-exists? (string-append closure-path "/profile/usr/share/misc/termcap.db")) + (list (render-shell-symlink-force "/run/current-system/profile/usr/share/misc/termcap.db" + (string-append rootfs "/usr/share/misc/termcap.db"))) + '()) + (if (file-exists? (string-append closure-path "/profile/etc/termcap.small")) + (list (render-shell-symlink-force "/run/current-system/profile/etc/termcap.small" + (string-append rootfs "/etc/termcap.small"))) + '()) + (if (file-exists? (string-append closure-path "/etc/ssh/sshd_config")) + (list (render-shell-symlink-force "/run/current-system/etc/ssh/sshd_config" + (string-append rootfs "/etc/ssh/sshd_config"))) + '()) + (map (lambda (path) + (render-shell-symlink-force (string-append "/run/current-system/boot/" path) + (string-append rootfs "/boot/" path))) + rootfs-boot-links) + (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix" + (string-append rootfs "/usr/local/bin/fruix"))) + (if (file-exists? (string-append closure-path "/development-profile")) + (list (render-shell-symlink-force "/run/current-system/development-profile" + (string-append rootfs "/run/current-development"))) + '()) + (if (file-exists? (string-append closure-path "/build-profile")) + (append + (list (render-shell-symlink-force "/run/current-system/build-profile" + (string-append rootfs "/run/current-build"))) + (if (file-exists? (string-append closure-path "/build-profile/usr/include")) + (list (render-shell-symlink-force "/run/current-system/build-profile/usr/include" + (string-append rootfs "/usr/include"))) + '()) + (if (file-exists? (string-append closure-path "/build-profile/usr/share/mk")) + (list (render-shell-symlink-force "/run/current-system/build-profile/usr/share/mk" + (string-append rootfs "/usr/share/mk"))) + '())) + '()) + (if (and (not (file-exists? (string-append closure-path "/build-profile"))) + (file-exists? (string-append closure-path "/development-profile"))) + (append + (if (file-exists? (string-append closure-path "/development-profile/usr/include")) + (list (render-shell-symlink-force "/run/current-system/development-profile/usr/include" + (string-append rootfs "/usr/include"))) + '()) + (if (file-exists? (string-append closure-path "/development-profile/usr/share/mk")) + (list (render-shell-symlink-force "/run/current-system/development-profile/usr/share/mk" + (string-append rootfs "/usr/share/mk"))) + '())) + '()) + (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-development-environment")) + (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-development-environment" + (string-append rootfs "/usr/local/bin/fruix-development-environment"))) + '()) + (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-build-environment")) + (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-build-environment" + (string-append rootfs "/usr/local/bin/fruix-build-environment"))) + '()) + (if (file-exists? (string-append closure-path "/usr/local/bin/fruix-self-hosted-native-build")) + (list (render-shell-symlink-force "/run/current-system/usr/local/bin/fruix-self-hosted-native-build" + (string-append rootfs "/usr/local/bin/fruix-self-hosted-native-build"))) + '()) + (list (render-shell-symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-activate" + (string-append rootfs "/usr/local/etc/rc.d/fruix-activate")) + (render-shell-symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-shepherd" + (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd")))))) + (list closure-path) + (list (cons rootfs rootfs)) + #:metadata-file metadata-file) + (write-rootfs-helper-step-metadata + executor + metadata-file + 'populate-rootfs-layout + `((rootfs . ,rootfs) + (closure-path . ,closure-path) + (directory-count . ,(length rootfs-population-directories)) + (copied-etc-files . ,rootfs-copied-etc-files))))) (define* (populate-rootfs-from-closure os rootfs closure-path #:key install-spec - install-metadata-path) + install-metadata-path + metadata-file) (when (file-exists? rootfs) (delete-file-recursively rootfs)) (mkdir-p rootfs) (case (native-build-executor-kind (default-jail-build-executor)) ((jail) - (populate-rootfs-layout/isolated rootfs closure-path)) + (populate-rootfs-layout/isolated rootfs closure-path + #:metadata-file metadata-file)) (else - (populate-rootfs-layout/host rootfs closure-path))) + (populate-rootfs-layout/host rootfs closure-path + #:metadata-file metadata-file))) (populate-system-generation-layout os rootfs closure-path #:install-spec install-spec #:install-metadata-path install-metadata-path) `((rootfs . ,rootfs) (closure-path . ,closure-path) (ready-marker . ,(operating-system-ready-marker os)) + (rootfs-populate-metadata-file . ,metadata-file) (rc-script . ,(string-append closure-path "/usr/local/etc/rc.d/fruix-shepherd")))) (define* (materialize-rootfs os rootfs @@ -759,7 +844,8 @@ (shepherd-prefix "/tmp/shepherd-freebsd-validate-install") (declaration-source #f) (declaration-origin #f) - (declaration-system-symbol #f)) + (declaration-system-symbol #f) + (metadata-file #f)) (let* ((closure (materialize-operating-system os #:store-dir store-dir #:guile-prefix guile-prefix @@ -769,7 +855,8 @@ #:declaration-origin declaration-origin #:declaration-system-symbol declaration-system-symbol)) (closure-path (assoc-ref closure 'closure-path))) - (populate-rootfs-from-closure os rootfs closure-path))) + (populate-rootfs-from-closure os rootfs closure-path + #:metadata-file metadata-file))) (define (assoc-remove keys entries) (filter (lambda (entry) @@ -972,10 +1059,10 @@ (installer-root-partition-label . ,installer-root-partition-label) (target-install . ,target-install-spec)))) -(define image-builder-version "3") -(define install-builder-version "3") -(define installer-image-builder-version "4") -(define installer-iso-builder-version "5") +(define image-builder-version "4") +(define install-builder-version "4") +(define installer-image-builder-version "5") +(define installer-iso-builder-version "6") (define* (operating-system-install-storage-layout os #:key @@ -1021,6 +1108,11 @@ (object->string realized-storage-layout)) (chmod (string-append install-root "/realized-storage-layout.scm") #o644)))) +(define (install-metadata-file-into-mounted-root source-path mounted-target-path) + (when (file-exists? source-path) + (run-privileged-command "mkdir" "-p" (dirname mounted-target-path)) + (run-privileged-command "cp" "-p" source-path mounted-target-path))) + (define (render-installer-apply-script store-dir plan-directory) (let ((target-rootfs (string-append plan-directory "/target-rootfs")) (store-items-file (string-append plan-directory "/store-items")) @@ -1387,6 +1479,13 @@ (rootfs (string-append build-root "/rootfs")) (mnt-root (string-append build-root "/mnt-root")) (install-metadata-relative-path "/var/lib/fruix/install.scm") + (staging-metadata-relative-root "/var/lib/fruix/system/install/metadata") + (rootfs-populate-metadata-path (string-append staging-metadata-relative-root "/rootfs-populate.scm")) + (rootfs-copy-metadata-path (string-append staging-metadata-relative-root "/rootfs-copy.scm")) + (store-copy-metadata-path (string-append staging-metadata-relative-root "/store-copy.scm")) + (rootfs-populate-metadata-file (string-append rootfs rootfs-populate-metadata-path)) + (rootfs-copy-metadata-temp-file (string-append build-root "/rootfs-copy.scm")) + (store-copy-metadata-temp-file (string-append build-root "/store-copy.scm")) (target-device #f) (target-md #f) (effective-storage-layout #f) @@ -1399,7 +1498,8 @@ (lambda () (populate-rootfs-from-closure os rootfs closure-path #:install-spec install-spec - #:install-metadata-path install-metadata-relative-path) + #:install-metadata-path install-metadata-relative-path + #:metadata-file rootfs-populate-metadata-file) (mkdir-p mnt-root) (case target-kind ((raw-file) @@ -1449,9 +1549,15 @@ (string-append rootfs "/boot/efi/EFI/BOOT/BOOTX64.EFI")) (copy-tree-contents/isolated rootfs mnt-root #:name "fruix-install-rootfs-copy" + #:metadata-file rootfs-copy-metadata-temp-file #:user "root") + (install-metadata-file-into-mounted-root rootfs-copy-metadata-temp-file + (string-append mnt-root rootfs-copy-metadata-path)) (copy-store-items-into-rootfs/isolated mnt-root store-dir store-items + #:metadata-file store-copy-metadata-temp-file #:user "root") + (install-metadata-file-into-mounted-root store-copy-metadata-temp-file + (string-append mnt-root store-copy-metadata-path)) (run-command "sync") `((target . ,target) (target-kind . ,target-kind) @@ -1462,6 +1568,9 @@ (declared-storage-layout . ,(storage-layout-spec declared-storage-layout)) (realized-storage-layout . ,(realized-freebsd-storage-layout storage-plan)) (install-metadata-path . ,install-metadata-relative-path) + (rootfs-populate-metadata-path . ,rootfs-populate-metadata-path) + (rootfs-copy-metadata-path . ,rootfs-copy-metadata-path) + (store-copy-metadata-path . ,store-copy-metadata-path) (closure-path . ,closure-path) (host-base-stores . ,(assoc-ref closure 'host-base-stores)) (native-base-stores . ,(assoc-ref closure 'native-base-stores)) @@ -1537,7 +1646,10 @@ #:kind 'bhyve-image)) (disk-image (string-append image-store-path "/disk.img")) (esp-image (string-append image-store-path "/esp.img")) - (root-image (string-append image-store-path "/root.ufs"))) + (root-image (string-append image-store-path "/root.ufs")) + (rootfs-populate-metadata-file (string-append image-store-path "/metadata/rootfs-populate.scm")) + (image-rootfs-copy-metadata-file (string-append image-store-path "/metadata/image-rootfs-copy.scm")) + (store-copy-metadata-file (string-append image-store-path "/metadata/store-copy.scm"))) (unless (file-exists? image-store-path) (let* ((build-root (mktemp-directory "/tmp/fruix-bhyve-image-build.XXXXXX")) (rootfs (string-append build-root "/rootfs")) @@ -1546,7 +1658,10 @@ (temp-output (mktemp-directory (string-append store-dir "/.fruix-bhyve-image.XXXXXX"))) (temp-disk (string-append build-root "/disk.img")) (temp-esp (string-append build-root "/esp.img")) - (temp-root (string-append build-root "/root.ufs"))) + (temp-root (string-append build-root "/root.ufs")) + (rootfs-populate-metadata-temp-file (string-append temp-output "/metadata/rootfs-populate.scm")) + (image-rootfs-copy-metadata-temp-file (string-append temp-output "/metadata/image-rootfs-copy.scm")) + (store-copy-metadata-temp-file (string-append temp-output "/metadata/store-copy.scm"))) (dynamic-wind (lambda () #t) (lambda () @@ -1557,9 +1672,12 @@ #:shepherd-prefix shepherd-prefix #:declaration-source declaration-source #:declaration-origin declaration-origin - #:declaration-system-symbol declaration-system-symbol) - (copy-rootfs-for-image/isolated rootfs image-rootfs) - (copy-store-items-into-rootfs/isolated image-rootfs store-dir store-items) + #:declaration-system-symbol declaration-system-symbol + #:metadata-file rootfs-populate-metadata-temp-file) + (copy-rootfs-for-image/isolated rootfs image-rootfs + #:metadata-file image-rootfs-copy-metadata-temp-file) + (copy-store-items-into-rootfs/isolated image-rootfs store-dir store-items + #:metadata-file store-copy-metadata-temp-file) (mkdir-p (string-append esp-stage "/EFI/BOOT")) (copy-regular-file (string-append closure-path "/boot/loader.efi") (string-append esp-stage "/EFI/BOOT/BOOTX64.EFI")) @@ -1591,13 +1709,17 @@ (chmod temp-output #o755) (for-each (lambda (path) (chmod path #o644)) - (list (string-append temp-output "/disk.img") - (string-append temp-output "/esp.img") - (string-append temp-output "/root.ufs") - (string-append temp-output "/image-spec.scm") - (string-append temp-output "/closure-path") - (string-append temp-output "/.references") - (string-append temp-output "/.fruix-package"))) + (filter file-exists? + (list (string-append temp-output "/disk.img") + (string-append temp-output "/esp.img") + (string-append temp-output "/root.ufs") + (string-append temp-output "/image-spec.scm") + (string-append temp-output "/closure-path") + (string-append temp-output "/.references") + (string-append temp-output "/.fruix-package") + rootfs-populate-metadata-temp-file + image-rootfs-copy-metadata-temp-file + store-copy-metadata-temp-file))) (rename-file temp-output image-store-path)) (lambda () (when (file-exists? build-root) @@ -1606,6 +1728,9 @@ (disk-image . ,disk-image) (esp-image . ,esp-image) (root-image . ,root-image) + (rootfs-populate-metadata-file . ,rootfs-populate-metadata-file) + (image-rootfs-copy-metadata-file . ,image-rootfs-copy-metadata-file) + (store-copy-metadata-file . ,store-copy-metadata-file) (closure-path . ,closure-path) (host-base-stores . ,(assoc-ref closure 'host-base-stores)) (native-base-stores . ,(assoc-ref closure 'native-base-stores)) @@ -1715,7 +1840,17 @@ #:kind 'installer-image)) (disk-image (string-append image-store-path "/disk.img")) (esp-image (string-append image-store-path "/esp.img")) - (root-image (string-append image-store-path "/root.ufs"))) + (root-image (string-append image-store-path "/root.ufs")) + (installer-rootfs-populate-metadata-file + (string-append image-store-path "/metadata/installer-rootfs-populate.scm")) + (target-rootfs-populate-metadata-file + (string-append image-store-path "/metadata/target-rootfs-populate.scm")) + (installer-rootfs-copy-metadata-file + (string-append image-store-path "/metadata/installer-rootfs-copy.scm")) + (target-rootfs-copy-metadata-file + (string-append image-store-path "/metadata/target-rootfs-copy.scm")) + (store-copy-metadata-file + (string-append image-store-path "/metadata/store-copy.scm"))) (unless (file-exists? image-store-path) (let* ((build-root (mktemp-directory "/tmp/fruix-installer-image-build.XXXXXX")) (installer-rootfs (string-append build-root "/installer-rootfs")) @@ -1726,22 +1861,37 @@ (temp-disk (string-append build-root "/disk.img")) (temp-esp (string-append build-root "/esp.img")) (temp-root (string-append build-root "/root.ufs")) - (plan-root (string-append image-rootfs installer-plan-directory))) + (plan-root (string-append image-rootfs installer-plan-directory)) + (installer-rootfs-populate-metadata-temp-file + (string-append temp-output "/metadata/installer-rootfs-populate.scm")) + (target-rootfs-populate-metadata-temp-file + (string-append temp-output "/metadata/target-rootfs-populate.scm")) + (installer-rootfs-copy-metadata-temp-file + (string-append temp-output "/metadata/installer-rootfs-copy.scm")) + (target-rootfs-copy-metadata-temp-file + (string-append temp-output "/metadata/target-rootfs-copy.scm")) + (store-copy-metadata-temp-file + (string-append temp-output "/metadata/store-copy.scm"))) (dynamic-wind (lambda () #t) (lambda () - (populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path) + (populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path + #:metadata-file installer-rootfs-populate-metadata-temp-file) (populate-rootfs-from-closure os target-rootfs target-closure-path #:install-spec target-install-spec - #:install-metadata-path "/var/lib/fruix/install.scm") - (copy-rootfs-for-image/isolated installer-rootfs image-rootfs) + #:install-metadata-path "/var/lib/fruix/install.scm" + #:metadata-file target-rootfs-populate-metadata-temp-file) + (copy-rootfs-for-image/isolated installer-rootfs image-rootfs + #:metadata-file installer-rootfs-copy-metadata-temp-file) (mkdir-p plan-root) (mkdir-p (string-append image-rootfs "/usr/local/libexec")) (mkdir-p (string-append image-rootfs "/usr/local/etc/rc.d")) (copy-tree-contents/isolated target-rootfs (string-append plan-root "/target-rootfs") - #:name "fruix-installer-target-rootfs-copy") - (copy-store-items-into-rootfs/isolated image-rootfs store-dir combined-store-items) + #:name "fruix-installer-target-rootfs-copy" + #:metadata-file target-rootfs-copy-metadata-temp-file) + (copy-store-items-into-rootfs/isolated image-rootfs store-dir combined-store-items + #:metadata-file store-copy-metadata-temp-file) (write-file (string-append plan-root "/store-items") (string-append (string-join (map path-basename target-store-items) "\n") "\n")) (write-file (string-append plan-root "/install.scm") @@ -1803,14 +1953,20 @@ (chmod temp-output #o755) (for-each (lambda (path) (chmod path #o644)) - (list (string-append temp-output "/disk.img") - (string-append temp-output "/esp.img") - (string-append temp-output "/root.ufs") - (string-append temp-output "/installer-image-spec.scm") - (string-append temp-output "/installer-closure-path") - (string-append temp-output "/target-closure-path") - (string-append temp-output "/.references") - (string-append temp-output "/.fruix-package"))) + (filter file-exists? + (list (string-append temp-output "/disk.img") + (string-append temp-output "/esp.img") + (string-append temp-output "/root.ufs") + (string-append temp-output "/installer-image-spec.scm") + (string-append temp-output "/installer-closure-path") + (string-append temp-output "/target-closure-path") + (string-append temp-output "/.references") + (string-append temp-output "/.fruix-package") + installer-rootfs-populate-metadata-temp-file + target-rootfs-populate-metadata-temp-file + installer-rootfs-copy-metadata-temp-file + target-rootfs-copy-metadata-temp-file + store-copy-metadata-temp-file))) (rename-file temp-output image-store-path)) (lambda () (when (file-exists? build-root) @@ -1819,6 +1975,11 @@ (disk-image . ,disk-image) (esp-image . ,esp-image) (root-image . ,root-image) + (installer-rootfs-populate-metadata-file . ,installer-rootfs-populate-metadata-file) + (target-rootfs-populate-metadata-file . ,target-rootfs-populate-metadata-file) + (installer-rootfs-copy-metadata-file . ,installer-rootfs-copy-metadata-file) + (target-rootfs-copy-metadata-file . ,target-rootfs-copy-metadata-file) + (store-copy-metadata-file . ,store-copy-metadata-file) (installer-closure-path . ,installer-closure-path) (target-closure-path . ,target-closure-path) (closure-path . ,installer-closure-path) @@ -2048,7 +2209,17 @@ #:kind 'installer-iso)) (iso-image (string-append iso-store-path "/installer.iso")) (boot-efi-image (string-append iso-store-path "/efiboot.img")) - (root-image (string-append iso-store-path "/root.img"))) + (root-image (string-append iso-store-path "/root.img")) + (installer-rootfs-populate-metadata-file + (string-append iso-store-path "/metadata/installer-rootfs-populate.scm")) + (target-rootfs-populate-metadata-file + (string-append iso-store-path "/metadata/target-rootfs-populate.scm")) + (installer-rootfs-copy-metadata-file + (string-append iso-store-path "/metadata/installer-rootfs-copy.scm")) + (target-rootfs-copy-metadata-file + (string-append iso-store-path "/metadata/target-rootfs-copy.scm")) + (store-copy-metadata-file + (string-append iso-store-path "/metadata/store-copy.scm"))) (unless (file-exists? iso-store-path) (let* ((build-root (mktemp-directory "/tmp/fruix-installer-iso-build.XXXXXX")) (installer-rootfs (string-append build-root "/installer-rootfs")) @@ -2059,22 +2230,37 @@ (temp-iso (string-append build-root "/installer.iso")) (temp-esp (string-append build-root "/efiboot.img")) (temp-root (string-append build-root "/root.img")) - (plan-root (string-append image-rootfs installer-plan-directory))) + (plan-root (string-append image-rootfs installer-plan-directory)) + (installer-rootfs-populate-metadata-temp-file + (string-append temp-output "/metadata/installer-rootfs-populate.scm")) + (target-rootfs-populate-metadata-temp-file + (string-append temp-output "/metadata/target-rootfs-populate.scm")) + (installer-rootfs-copy-metadata-temp-file + (string-append temp-output "/metadata/installer-rootfs-copy.scm")) + (target-rootfs-copy-metadata-temp-file + (string-append temp-output "/metadata/target-rootfs-copy.scm")) + (store-copy-metadata-temp-file + (string-append temp-output "/metadata/store-copy.scm"))) (dynamic-wind (lambda () #t) (lambda () - (populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path) + (populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path + #:metadata-file installer-rootfs-populate-metadata-temp-file) (populate-rootfs-from-closure os target-rootfs target-closure-path #:install-spec target-install-spec - #:install-metadata-path "/var/lib/fruix/install.scm") - (copy-rootfs-for-image/isolated installer-rootfs image-rootfs) + #:install-metadata-path "/var/lib/fruix/install.scm" + #:metadata-file target-rootfs-populate-metadata-temp-file) + (copy-rootfs-for-image/isolated installer-rootfs image-rootfs + #:metadata-file installer-rootfs-copy-metadata-temp-file) (mkdir-p plan-root) (mkdir-p (string-append image-rootfs "/usr/local/libexec")) (mkdir-p (string-append image-rootfs "/usr/local/etc/rc.d")) (copy-tree-contents/isolated target-rootfs (string-append plan-root "/target-rootfs") - #:name "fruix-installer-iso-target-rootfs-copy") - (copy-store-items-into-rootfs/isolated image-rootfs store-dir combined-store-items) + #:name "fruix-installer-iso-target-rootfs-copy" + #:metadata-file target-rootfs-copy-metadata-temp-file) + (copy-store-items-into-rootfs/isolated image-rootfs store-dir combined-store-items + #:metadata-file store-copy-metadata-temp-file) (write-file (string-append plan-root "/store-items") (string-append (string-join (map path-basename target-runtime-store-items) "\n") "\n")) (write-file (string-append plan-root "/install.scm") @@ -2127,14 +2313,20 @@ (chmod temp-output #o755) (for-each (lambda (path) (chmod path #o644)) - (list (string-append temp-output "/installer.iso") - (string-append temp-output "/efiboot.img") - (string-append temp-output "/root.img") - (string-append temp-output "/installer-iso-spec.scm") - (string-append temp-output "/installer-closure-path") - (string-append temp-output "/target-closure-path") - (string-append temp-output "/.references") - (string-append temp-output "/.fruix-package"))) + (filter file-exists? + (list (string-append temp-output "/installer.iso") + (string-append temp-output "/efiboot.img") + (string-append temp-output "/root.img") + (string-append temp-output "/installer-iso-spec.scm") + (string-append temp-output "/installer-closure-path") + (string-append temp-output "/target-closure-path") + (string-append temp-output "/.references") + (string-append temp-output "/.fruix-package") + installer-rootfs-populate-metadata-temp-file + target-rootfs-populate-metadata-temp-file + installer-rootfs-copy-metadata-temp-file + target-rootfs-copy-metadata-temp-file + store-copy-metadata-temp-file))) (rename-file temp-output iso-store-path)) (lambda () (when (file-exists? build-root) @@ -2143,6 +2335,11 @@ (iso-image . ,iso-image) (boot-efi-image . ,boot-efi-image) (root-image . ,root-image) + (installer-rootfs-populate-metadata-file . ,installer-rootfs-populate-metadata-file) + (target-rootfs-populate-metadata-file . ,target-rootfs-populate-metadata-file) + (installer-rootfs-copy-metadata-file . ,installer-rootfs-copy-metadata-file) + (target-rootfs-copy-metadata-file . ,target-rootfs-copy-metadata-file) + (store-copy-metadata-file . ,store-copy-metadata-file) (installer-closure-path . ,installer-closure-path) (target-closure-path . ,target-closure-path) (closure-path . ,installer-closure-path) diff --git a/scripts/fruix.scm b/scripts/fruix.scm index 1c39fc5..2ceddc8 100644 --- a/scripts/fruix.scm +++ b/scripts/fruix.scm @@ -449,6 +449,9 @@ Common options:\n\ (esp_device . ,(assoc-ref result 'esp-device)) (root_device . ,(assoc-ref result 'root-device)) (install_metadata_path . ,(assoc-ref result 'install-metadata-path)) + (rootfs_populate_metadata_path . ,(assoc-ref result 'rootfs-populate-metadata-path)) + (rootfs_copy_metadata_path . ,(assoc-ref result 'rootfs-copy-metadata-path)) + (store_copy_metadata_path . ,(assoc-ref result 'store-copy-metadata-path)) (freebsd_base_name . ,(freebsd-base-name base)) (freebsd_base_version_label . ,(freebsd-base-version-label base)) (freebsd_base_release . ,(freebsd-base-release base)) @@ -528,6 +531,9 @@ Common options:\n\ (disk_image . ,(assoc-ref result 'disk-image)) (esp_image . ,(assoc-ref result 'esp-image)) (root_image . ,(assoc-ref result 'root-image)) + (rootfs_populate_metadata_file . ,(assoc-ref result 'rootfs-populate-metadata-file)) + (image_rootfs_copy_metadata_file . ,(assoc-ref result 'image-rootfs-copy-metadata-file)) + (store_copy_metadata_file . ,(assoc-ref result 'store-copy-metadata-file)) (closure_path . ,(assoc-ref result 'closure-path)) (host_base_store_count . ,(length host-base-stores)) (host_base_stores . ,(string-join host-base-stores ",")) @@ -591,6 +597,11 @@ Common options:\n\ (disk_image . ,(assoc-ref result 'disk-image)) (esp_image . ,(assoc-ref result 'esp-image)) (root_image . ,(assoc-ref result 'root-image)) + (installer_rootfs_populate_metadata_file . ,(assoc-ref result 'installer-rootfs-populate-metadata-file)) + (target_rootfs_populate_metadata_file . ,(assoc-ref result 'target-rootfs-populate-metadata-file)) + (installer_rootfs_copy_metadata_file . ,(assoc-ref result 'installer-rootfs-copy-metadata-file)) + (target_rootfs_copy_metadata_file . ,(assoc-ref result 'target-rootfs-copy-metadata-file)) + (store_copy_metadata_file . ,(assoc-ref result 'store-copy-metadata-file)) (installer_closure_path . ,(assoc-ref result 'installer-closure-path)) (target_closure_path . ,(assoc-ref result 'target-closure-path)) (host_base_store_count . ,(length host-base-stores)) @@ -656,6 +667,11 @@ Common options:\n\ (iso_image . ,(assoc-ref result 'iso-image)) (boot_efi_image . ,(assoc-ref result 'boot-efi-image)) (root_image . ,(assoc-ref result 'root-image)) + (installer_rootfs_populate_metadata_file . ,(assoc-ref result 'installer-rootfs-populate-metadata-file)) + (target_rootfs_populate_metadata_file . ,(assoc-ref result 'target-rootfs-populate-metadata-file)) + (installer_rootfs_copy_metadata_file . ,(assoc-ref result 'installer-rootfs-copy-metadata-file)) + (target_rootfs_copy_metadata_file . ,(assoc-ref result 'target-rootfs-copy-metadata-file)) + (store_copy_metadata_file . ,(assoc-ref result 'store-copy-metadata-file)) (installer_closure_path . ,(assoc-ref result 'installer-closure-path)) (target_closure_path . ,(assoc-ref result 'target-closure-path)) (host_base_store_count . ,(length host-base-stores))