Record staged image and install jail metadata

This commit is contained in:
2026-04-10 14:57:16 +02:00
parent 9d82529d03
commit 9fd1e5da14
2 changed files with 380 additions and 167 deletions
+364 -167
View File
@@ -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)
+16
View File
@@ -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))