1439 lines
83 KiB
Scheme
1439 lines
83 KiB
Scheme
(define-module (fruix system freebsd media)
|
|
#:use-module (fruix packages freebsd)
|
|
#:use-module (fruix system freebsd build)
|
|
#:use-module (fruix system freebsd model)
|
|
#:use-module (fruix system freebsd render)
|
|
#:use-module (fruix system freebsd source)
|
|
#:use-module (fruix system freebsd utils)
|
|
#:use-module (guix build utils)
|
|
#:use-module (ice-9 format)
|
|
#:use-module (ice-9 hash-table)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-13)
|
|
#:use-module (rnrs io ports)
|
|
#:export (operating-system-install-spec
|
|
operating-system-image-spec
|
|
operating-system-installer-image-spec
|
|
operating-system-installer-iso-spec
|
|
installer-operating-system
|
|
materialize-operating-system
|
|
materialize-rootfs
|
|
install-operating-system
|
|
materialize-bhyve-image
|
|
materialize-installer-image
|
|
materialize-installer-iso))
|
|
|
|
(define (same-file-contents? a b)
|
|
(zero? (system* "cmp" "-s" a b)))
|
|
|
|
(define (merge-output-into-tree output-path tree-root)
|
|
(define (walk relative)
|
|
(let ((source (if (string-null? relative)
|
|
output-path
|
|
(string-append output-path "/" relative))))
|
|
(for-each
|
|
(lambda (entry)
|
|
(unless (or (member entry '(".references" ".fruix-package"))
|
|
(string-prefix? "." entry))
|
|
(let* ((entry-relative (if (string-null? relative)
|
|
entry
|
|
(string-append relative "/" entry)))
|
|
(source-entry (string-append output-path "/" entry-relative))
|
|
(target-entry (string-append tree-root "/" entry-relative))
|
|
(st (lstat source-entry)))
|
|
(if (eq? 'directory (stat:type st))
|
|
(begin
|
|
(mkdir-p target-entry)
|
|
(walk entry-relative))
|
|
(begin
|
|
(mkdir-p (dirname target-entry))
|
|
(if (file-exists? target-entry)
|
|
(let ((existing (false-if-exception (readlink target-entry))))
|
|
(unless (or (and existing
|
|
(string=? existing source-entry))
|
|
(and existing
|
|
(file-exists? existing)
|
|
(same-file-contents? existing source-entry)))
|
|
(error (format #f "tree collision for ~a" target-entry))))
|
|
(symlink source-entry target-entry)))))))
|
|
(directory-entries source))))
|
|
(mkdir-p tree-root)
|
|
(walk ""))
|
|
|
|
(define (hash-table-values table)
|
|
(hash-fold (lambda (_ value result)
|
|
(cons value result))
|
|
'()
|
|
table))
|
|
|
|
|
|
(define* (materialize-operating-system os
|
|
#:key
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install"))
|
|
(validate-operating-system os)
|
|
(let* ((cache (make-hash-table))
|
|
(source-cache (make-hash-table))
|
|
(kernel-package (operating-system-kernel os))
|
|
(bootloader-package (operating-system-bootloader os))
|
|
(base-packages (operating-system-base-packages os))
|
|
(kernel-store (materialize-freebsd-package kernel-package store-dir cache source-cache))
|
|
(bootloader-store (materialize-freebsd-package bootloader-package store-dir cache source-cache))
|
|
(base-package-stores (map (lambda (package)
|
|
(materialize-freebsd-package package store-dir cache source-cache))
|
|
base-packages))
|
|
(base-package-pairs (map cons base-packages base-package-stores))
|
|
(store-classification
|
|
(append (list (cons kernel-package kernel-store)
|
|
(cons bootloader-package bootloader-store))
|
|
base-package-pairs))
|
|
(guile-runtime-extra-files
|
|
'(("/usr/local/lib/libgc-threaded.so.1" . "lib/libgc-threaded.so.1")
|
|
("/usr/local/lib/libffi.so.8" . "lib/libffi.so.8")
|
|
("/usr/local/lib/libintl.so.8" . "lib/libintl.so.8")
|
|
("/usr/local/lib/libunistring.so.5" . "lib/libunistring.so.5")
|
|
("/usr/local/lib/libiconv.so.2" . "lib/libiconv.so.2")
|
|
("/usr/local/lib/libgmp.so.10" . "lib/libgmp.so.10")))
|
|
(guile-extra-runtime-files
|
|
'(("/usr/local/lib/libevent-2.1.so.7" . "lib/libevent-2.1.so.7")
|
|
("/usr/local/lib/libgnutls.so.30" . "lib/libgnutls.so.30")
|
|
("/usr/local/lib/libp11-kit.so.0" . "lib/libp11-kit.so.0")
|
|
("/usr/local/lib/libidn2.so.0" . "lib/libidn2.so.0")
|
|
("/usr/local/lib/libtasn1.so.6" . "lib/libtasn1.so.6")
|
|
("/usr/local/lib/libhogweed.so.6" . "lib/libhogweed.so.6")
|
|
("/usr/local/lib/libnettle.so.8" . "lib/libnettle.so.8")))
|
|
(guile-store (materialize-prefix guile-prefix "fruix-guile-runtime" "3.0" store-dir
|
|
#:extra-files guile-runtime-extra-files))
|
|
(guile-extra-store (materialize-prefix guile-extra-prefix "fruix-guile-extra" "3.0" store-dir
|
|
#:extra-files (append guile-runtime-extra-files
|
|
guile-extra-runtime-files)))
|
|
(shepherd-store (materialize-prefix shepherd-prefix "fruix-shepherd-runtime" "1.0.9" store-dir))
|
|
(host-base-stores
|
|
(delete-duplicates
|
|
(map cdr
|
|
(filter (lambda (entry)
|
|
(freebsd-host-staged-package? (car entry)))
|
|
store-classification))))
|
|
(native-base-stores
|
|
(delete-duplicates
|
|
(map cdr
|
|
(filter (lambda (entry)
|
|
(freebsd-native-build-package? (car entry)))
|
|
store-classification))))
|
|
(fruix-runtime-stores (list guile-store guile-extra-store shepherd-store))
|
|
(source-materializations
|
|
(delete-duplicates (hash-table-values source-cache)))
|
|
(materialized-source-stores
|
|
(delete-duplicates (map (lambda (result)
|
|
(assoc-ref result 'source-store-path))
|
|
source-materializations)))
|
|
(metadata-files
|
|
`(("metadata/freebsd-base.scm"
|
|
. ,(object->string (freebsd-base-spec (operating-system-freebsd-base os))))
|
|
("metadata/freebsd-source.scm"
|
|
. ,(object->string (freebsd-source-spec (freebsd-base-source (operating-system-freebsd-base os)))))
|
|
("metadata/freebsd-source-materializations.scm"
|
|
. ,(object->string (map freebsd-source-materialization-spec source-materializations)))
|
|
("metadata/host-base-provenance.scm"
|
|
. ,(object->string (host-freebsd-provenance)))
|
|
("metadata/store-layout.scm"
|
|
. ,(object->string
|
|
`((freebsd-base . ,(freebsd-base-spec (operating-system-freebsd-base os)))
|
|
(freebsd-source . ,(freebsd-source-spec (freebsd-base-source (operating-system-freebsd-base os))))
|
|
(materialized-source-store-count . ,(length materialized-source-stores))
|
|
(materialized-source-stores . ,materialized-source-stores)
|
|
(host-base-store-count . ,(length host-base-stores))
|
|
(host-base-stores . ,host-base-stores)
|
|
(native-base-store-count . ,(length native-base-stores))
|
|
(native-base-stores . ,native-base-stores)
|
|
(fruix-runtime-store-count . ,(length fruix-runtime-stores))
|
|
(fruix-runtime-stores . ,fruix-runtime-stores)
|
|
(host-base-replacement-order . ,%freebsd-host-staged-replacement-order)
|
|
(init-mode . ,(operating-system-init-mode os)))))))
|
|
(generated-files (append (operating-system-generated-files os
|
|
#:guile-store guile-store
|
|
#:guile-extra-store guile-extra-store
|
|
#:shepherd-store shepherd-store)
|
|
metadata-files
|
|
`(("usr/local/etc/rc.d/fruix-activate"
|
|
. ,(render-activation-rc-script))
|
|
("usr/local/etc/rc.d/fruix-shepherd"
|
|
. ,(render-rc-script shepherd-store guile-store guile-extra-store)))))
|
|
(references (delete-duplicates (append materialized-source-stores host-base-stores native-base-stores fruix-runtime-stores)))
|
|
(manifest (string-append
|
|
"closure-spec=\n"
|
|
(object->string (operating-system-closure-spec os))
|
|
"generated-files=\n"
|
|
(string-join (map (lambda (entry)
|
|
(string-append (car entry) "\n" (cdr entry)))
|
|
generated-files)
|
|
"\n")
|
|
"\nreferences=\n"
|
|
(string-join references "\n")))
|
|
(hash (sha256-string manifest))
|
|
(closure-path (string-append store-dir "/" hash "-fruix-system-"
|
|
(operating-system-host-name os))))
|
|
(unless (file-exists? closure-path)
|
|
(mkdir-p closure-path)
|
|
(mkdir-p (string-append closure-path "/boot/kernel"))
|
|
(symlink (string-append kernel-store "/boot/kernel/kernel")
|
|
(string-append closure-path "/boot/kernel/kernel"))
|
|
(symlink (string-append kernel-store "/boot/kernel/linker.hints")
|
|
(string-append closure-path "/boot/kernel/linker.hints"))
|
|
(for-each
|
|
(lambda (entry)
|
|
(let ((name (car entry)))
|
|
(symlink (string-append bootloader-store "/boot/" name)
|
|
(string-append closure-path "/boot/" name))))
|
|
'(("loader") ("loader.efi") ("device.hints") ("defaults") ("lua")))
|
|
(mkdir-p (string-append closure-path "/profile"))
|
|
(for-each (lambda (output)
|
|
(merge-output-into-tree output (string-append closure-path "/profile")))
|
|
base-package-stores)
|
|
(for-each
|
|
(lambda (entry)
|
|
(write-file (string-append closure-path "/" (car entry)) (cdr entry)))
|
|
generated-files)
|
|
(chmod (string-append closure-path "/activate") #o555)
|
|
(when (file-exists? (string-append closure-path "/etc/master.passwd"))
|
|
(chmod (string-append closure-path "/etc/master.passwd") #o600))
|
|
(chmod (string-append closure-path "/usr/local/etc/rc.d/fruix-activate") #o555)
|
|
(chmod (string-append closure-path "/usr/local/etc/rc.d/fruix-shepherd") #o555)
|
|
(when (file-exists? (string-append closure-path "/boot/fruix-pid1"))
|
|
(chmod (string-append closure-path "/boot/fruix-pid1") #o555))
|
|
(write-file (string-append closure-path "/parameters.scm")
|
|
(object->string (operating-system-closure-spec os)))
|
|
(write-file (string-append closure-path "/.references")
|
|
(string-join references "\n"))
|
|
(write-file (string-append closure-path "/.fruix-package") manifest))
|
|
`((closure-path . ,closure-path)
|
|
(kernel-store . ,kernel-store)
|
|
(bootloader-store . ,bootloader-store)
|
|
(guile-store . ,guile-store)
|
|
(guile-extra-store . ,guile-extra-store)
|
|
(shepherd-store . ,shepherd-store)
|
|
(base-package-stores . ,base-package-stores)
|
|
(host-base-stores . ,host-base-stores)
|
|
(native-base-stores . ,native-base-stores)
|
|
(fruix-runtime-stores . ,fruix-runtime-stores)
|
|
(freebsd-base-file . ,(string-append closure-path "/metadata/freebsd-base.scm"))
|
|
(freebsd-source-file . ,(string-append closure-path "/metadata/freebsd-source.scm"))
|
|
(freebsd-source-materializations-file . ,(string-append closure-path "/metadata/freebsd-source-materializations.scm"))
|
|
(materialized-source-stores . ,materialized-source-stores)
|
|
(host-base-provenance-file . ,(string-append closure-path "/metadata/host-base-provenance.scm"))
|
|
(store-layout-file . ,(string-append closure-path "/metadata/store-layout.scm"))
|
|
(generated-files . ,(map car generated-files))
|
|
(references . ,references))))
|
|
|
|
(define (symlink-force target link-name)
|
|
(when (or (file-exists? link-name) (false-if-exception (readlink link-name)))
|
|
(delete-file link-name))
|
|
(mkdir-p (dirname link-name))
|
|
(symlink target link-name))
|
|
|
|
(define system-generation-layout-version "1")
|
|
|
|
(define* (system-generation-metadata-object os closure-path
|
|
#:key
|
|
(generation-number 1)
|
|
install-spec
|
|
install-metadata-path)
|
|
`((system-generation-version . ,system-generation-layout-version)
|
|
(generation-number . ,generation-number)
|
|
(host-name . ,(operating-system-host-name os))
|
|
(ready-marker . ,(operating-system-ready-marker os))
|
|
(init-mode . ,(operating-system-init-mode os))
|
|
(closure-path . ,closure-path)
|
|
(parameters-file . ,(string-append closure-path "/parameters.scm"))
|
|
(freebsd-base-file . ,(string-append closure-path "/metadata/freebsd-base.scm"))
|
|
(freebsd-source-file . ,(string-append closure-path "/metadata/freebsd-source.scm"))
|
|
(freebsd-source-materializations-file
|
|
. ,(string-append closure-path "/metadata/freebsd-source-materializations.scm"))
|
|
(host-base-provenance-file . ,(string-append closure-path "/metadata/host-base-provenance.scm"))
|
|
(store-layout-file . ,(string-append closure-path "/metadata/store-layout.scm"))
|
|
(install-metadata-path . ,install-metadata-path)
|
|
(install-spec . ,install-spec)))
|
|
|
|
(define (system-generation-provenance-object closure-path)
|
|
`((closure-path . ,closure-path)
|
|
(parameters-file . ,(string-append closure-path "/parameters.scm"))
|
|
(freebsd-base-file . ,(string-append closure-path "/metadata/freebsd-base.scm"))
|
|
(freebsd-source-file . ,(string-append closure-path "/metadata/freebsd-source.scm"))
|
|
(freebsd-source-materializations-file
|
|
. ,(string-append closure-path "/metadata/freebsd-source-materializations.scm"))
|
|
(host-base-provenance-file . ,(string-append closure-path "/metadata/host-base-provenance.scm"))
|
|
(store-layout-file . ,(string-append closure-path "/metadata/store-layout.scm"))))
|
|
|
|
(define* (populate-system-generation-layout os rootfs closure-path
|
|
#:key
|
|
(generation-number 1)
|
|
install-spec
|
|
install-metadata-path)
|
|
(let* ((system-root (string-append rootfs "/var/lib/fruix/system"))
|
|
(generation-name (number->string generation-number))
|
|
(generation-link-target (string-append "generations/" generation-name))
|
|
(generation-dir (string-append system-root "/generations/" generation-name))
|
|
(gcroots-dir (string-append rootfs "/frx/var/fruix/gcroots"))
|
|
(generation-install-file (string-append generation-dir "/install.scm"))
|
|
(root-install-file (and install-metadata-path
|
|
(string-append rootfs install-metadata-path))))
|
|
(mkdir-p generation-dir)
|
|
(symlink-force closure-path (string-append generation-dir "/closure"))
|
|
(write-file (string-append generation-dir "/metadata.scm")
|
|
(object->string
|
|
(system-generation-metadata-object os closure-path
|
|
#:generation-number generation-number
|
|
#:install-spec install-spec
|
|
#:install-metadata-path install-metadata-path)))
|
|
(write-file (string-append generation-dir "/provenance.scm")
|
|
(object->string (system-generation-provenance-object closure-path)))
|
|
(when (and root-install-file (file-exists? root-install-file))
|
|
(copy-regular-file root-install-file generation-install-file)
|
|
(chmod generation-install-file #o644))
|
|
(symlink-force generation-link-target (string-append system-root "/current"))
|
|
(write-file (string-append system-root "/current-generation")
|
|
(string-append generation-name "\n"))
|
|
(mkdir-p gcroots-dir)
|
|
(symlink-force closure-path (string-append gcroots-dir "/system-" generation-name))
|
|
(symlink-force closure-path (string-append gcroots-dir "/current-system"))))
|
|
|
|
(define* (populate-rootfs-from-closure os rootfs closure-path
|
|
#:key
|
|
install-spec
|
|
install-metadata-path)
|
|
(when (file-exists? rootfs)
|
|
(delete-file-recursively rootfs))
|
|
(mkdir-p rootfs)
|
|
(for-each (lambda (dir)
|
|
(mkdir-p (string-append rootfs dir)))
|
|
'("/run" "/boot" "/etc" "/etc/ssh" "/usr" "/usr/share" "/usr/local" "/usr/local/etc"
|
|
"/usr/local/etc/rc.d" "/var" "/var/cron" "/var/db" "/var/lib" "/var/lib/fruix"
|
|
"/var/log" "/var/run" "/tmp" "/dev" "/root" "/home"))
|
|
(chmod (string-append rootfs "/tmp") #o1777)
|
|
(symlink-force closure-path (string-append rootfs "/run/current-system"))
|
|
(symlink-force "/run/current-system/activate" (string-append rootfs "/activate"))
|
|
(for-each (lambda (dir)
|
|
(symlink-force (string-append "/run/current-system/profile/" dir)
|
|
(string-append rootfs "/" dir)))
|
|
'("bin" "sbin" "lib" "libexec"))
|
|
(for-each (lambda (dir)
|
|
(symlink-force (string-append "/run/current-system/profile/usr/" dir)
|
|
(string-append rootfs "/usr/" dir)))
|
|
'("bin" "lib" "sbin" "libexec"))
|
|
(when (file-exists? (string-append closure-path "/profile/usr/share/locale"))
|
|
(symlink-force "/run/current-system/profile/usr/share/locale"
|
|
(string-append rootfs "/usr/share/locale")))
|
|
(for-each (lambda (path)
|
|
(symlink-force (string-append "/run/current-system/profile/etc/" path)
|
|
(string-append rootfs "/etc/" path)))
|
|
'("rc" "rc.subr" "rc.shutdown" "rc.d" "defaults"
|
|
"devd.conf" "network.subr" "newsyslog.conf" "syslog.conf"))
|
|
(for-each (lambda (path)
|
|
(symlink-force (string-append "/run/current-system/etc/" path)
|
|
(string-append rootfs "/etc/" path)))
|
|
'("rc.conf" "fstab" "hosts" "shells" "motd" "ttys"))
|
|
(for-each (lambda (path)
|
|
(copy-regular-file (string-append closure-path "/etc/" path)
|
|
(string-append rootfs "/etc/" path)))
|
|
'("passwd" "master.passwd" "group" "login.conf"))
|
|
(when (file-exists? (string-append closure-path "/etc/ssh/sshd_config"))
|
|
(symlink-force "/run/current-system/etc/ssh/sshd_config"
|
|
(string-append rootfs "/etc/ssh/sshd_config")))
|
|
(for-each (lambda (path)
|
|
(symlink-force (string-append "/run/current-system/boot/" path)
|
|
(string-append rootfs "/boot/" path)))
|
|
'("kernel" "loader" "loader.efi" "device.hints" "defaults" "lua" "loader.conf"))
|
|
(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"))
|
|
(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))
|
|
(rc-script . ,(string-append closure-path "/usr/local/etc/rc.d/fruix-shepherd"))))
|
|
|
|
(define* (materialize-rootfs os rootfs
|
|
#:key
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install"))
|
|
(let* ((closure (materialize-operating-system os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(closure-path (assoc-ref closure 'closure-path)))
|
|
(populate-rootfs-from-closure os rootfs closure-path)))
|
|
|
|
(define (assoc-remove keys entries)
|
|
(filter (lambda (entry)
|
|
(not (member (car entry) keys)))
|
|
entries))
|
|
|
|
(define (ensure-installer-groups groups)
|
|
(append groups
|
|
(filter (lambda (group)
|
|
(not (any (lambda (existing)
|
|
(string=? (user-group-name existing)
|
|
(user-group-name group)))
|
|
groups)))
|
|
(list (user-group #:name "sshd" #:gid 22 #:system? #t)
|
|
(user-group #:name "_dhcp" #:gid 65 #:system? #t)))))
|
|
|
|
(define (ensure-installer-users users)
|
|
(append users
|
|
(filter (lambda (user)
|
|
(not (any (lambda (existing)
|
|
(string=? (user-account-name existing)
|
|
(user-account-name user)))
|
|
users)))
|
|
(list (user-account #:name "sshd"
|
|
#:uid 22
|
|
#:group "sshd"
|
|
#:comment "Secure Shell Daemon"
|
|
#:home "/var/empty"
|
|
#:shell "/usr/sbin/nologin"
|
|
#:system? #t)
|
|
(user-account #:name "_dhcp"
|
|
#:uid 65
|
|
#:group "_dhcp"
|
|
#:comment "dhcp programs"
|
|
#:home "/var/empty"
|
|
#:shell "/usr/sbin/nologin"
|
|
#:system? #t)))))
|
|
|
|
(define* (installer-operating-system os
|
|
#:key
|
|
(host-name (string-append (operating-system-host-name os)
|
|
"-installer"))
|
|
(root-partition-label "fruix-installer-root")
|
|
(ready-marker "/var/lib/fruix/installer/ready"))
|
|
(operating-system
|
|
#:host-name host-name
|
|
#:freebsd-base (operating-system-freebsd-base os)
|
|
#:kernel (operating-system-kernel os)
|
|
#:bootloader (operating-system-bootloader os)
|
|
#:base-packages (operating-system-base-packages os)
|
|
#:users (ensure-installer-users (operating-system-users os))
|
|
#:groups (ensure-installer-groups (operating-system-groups os))
|
|
#:file-systems (list (file-system #:device (string-append "/dev/gpt/" root-partition-label)
|
|
#:mount-point "/"
|
|
#:type "ufs"
|
|
#:options "rw"
|
|
#:needed-for-boot? #t)
|
|
(file-system #:device "devfs"
|
|
#:mount-point "/dev"
|
|
#:type "devfs"
|
|
#:options "rw"
|
|
#:needed-for-boot? #t)
|
|
(file-system #:device "tmpfs"
|
|
#:mount-point "/tmp"
|
|
#:type "tmpfs"
|
|
#:options "rw,size=64m"))
|
|
#:services '(shepherd ready-marker sshd)
|
|
#:loader-entries (operating-system-loader-entries os)
|
|
#:rc-conf-entries (append (assoc-remove '("sshd_enable" "fruix_installer_enable")
|
|
(operating-system-rc-conf-entries os))
|
|
'(("sshd_enable" . "YES")
|
|
("fruix_installer_enable" . "YES")))
|
|
#:init-mode 'freebsd-init+rc.d-shepherd
|
|
#:ready-marker ready-marker
|
|
#:root-authorized-keys (operating-system-root-authorized-keys os)))
|
|
|
|
(define* (operating-system-install-spec os
|
|
#:key
|
|
target
|
|
(target-kind 'raw-file)
|
|
(boot-mode 'uefi)
|
|
(partition-scheme 'gpt)
|
|
(efi-size "64m")
|
|
(root-size #f)
|
|
(disk-capacity #f)
|
|
(efi-partition-label "efiboot")
|
|
(root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
`((host-name . ,(operating-system-host-name os))
|
|
(freebsd-base . ,(freebsd-base-spec (operating-system-freebsd-base os)))
|
|
(install-mode . non-interactive)
|
|
(target . ,target)
|
|
(target-kind . ,target-kind)
|
|
(boot-mode . ,boot-mode)
|
|
(partition-scheme . ,partition-scheme)
|
|
(efi-size . ,efi-size)
|
|
(root-size . ,root-size)
|
|
(disk-capacity . ,disk-capacity)
|
|
(efi-partition-label . ,efi-partition-label)
|
|
(root-partition-label . ,root-partition-label)
|
|
(serial-console . ,serial-console)
|
|
(init-mode . ,(operating-system-init-mode os))))
|
|
|
|
(define* (operating-system-image-spec os
|
|
#:key
|
|
(boot-mode 'uefi)
|
|
(image-format 'raw)
|
|
(partition-scheme 'gpt)
|
|
(efi-size "64m")
|
|
(root-size "256m")
|
|
(disk-capacity #f)
|
|
(efi-partition-label "efiboot")
|
|
(root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
`((host-name . ,(operating-system-host-name os))
|
|
(freebsd-base . ,(freebsd-base-spec (operating-system-freebsd-base os)))
|
|
(boot-mode . ,boot-mode)
|
|
(image-format . ,image-format)
|
|
(partition-scheme . ,partition-scheme)
|
|
(efi-size . ,efi-size)
|
|
(root-size . ,root-size)
|
|
(disk-capacity . ,disk-capacity)
|
|
(efi-partition-label . ,efi-partition-label)
|
|
(root-partition-label . ,root-partition-label)
|
|
(serial-console . ,serial-console)
|
|
(init-mode . ,(operating-system-init-mode os))))
|
|
|
|
(define* (operating-system-installer-image-spec os
|
|
#:key
|
|
(install-target-device "/dev/vtbd1")
|
|
(installer-host-name (string-append (operating-system-host-name os)
|
|
"-installer"))
|
|
(efi-size "64m")
|
|
(root-size "10g")
|
|
(disk-capacity #f)
|
|
(installer-efi-partition-label "efiboot")
|
|
(installer-root-partition-label "fruix-installer-root")
|
|
(target-efi-partition-label "efiboot")
|
|
(target-root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
(let* ((installer-os (installer-operating-system os
|
|
#:host-name installer-host-name
|
|
#:root-partition-label installer-root-partition-label))
|
|
(target-install-spec (operating-system-install-spec os
|
|
#:target install-target-device
|
|
#:target-kind 'block-device
|
|
#:efi-size efi-size
|
|
#:root-size #f
|
|
#:disk-capacity #f
|
|
#:efi-partition-label target-efi-partition-label
|
|
#:root-partition-label target-root-partition-label
|
|
#:serial-console serial-console)))
|
|
`((installer-host-name . ,installer-host-name)
|
|
(install-target-device . ,install-target-device)
|
|
(installer-root-partition-label . ,installer-root-partition-label)
|
|
(installer-image . ,(operating-system-image-spec installer-os
|
|
#:efi-size efi-size
|
|
#:root-size root-size
|
|
#:disk-capacity disk-capacity
|
|
#:efi-partition-label installer-efi-partition-label
|
|
#:root-partition-label installer-root-partition-label
|
|
#:serial-console serial-console))
|
|
(target-install . ,target-install-spec))))
|
|
|
|
(define* (operating-system-installer-iso-spec os
|
|
#:key
|
|
(install-target-device "/dev/vtbd0")
|
|
(installer-host-name (string-append (operating-system-host-name os)
|
|
"-installer"))
|
|
(root-size #f)
|
|
(iso-volume-label "FRUIX_INSTALLER")
|
|
(installer-root-partition-label "fruix-installer-root")
|
|
(target-efi-partition-label "efiboot")
|
|
(target-root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
(let ((target-install-spec (operating-system-install-spec os
|
|
#:target install-target-device
|
|
#:target-kind 'block-device
|
|
#:efi-size "64m"
|
|
#:root-size #f
|
|
#:disk-capacity #f
|
|
#:efi-partition-label target-efi-partition-label
|
|
#:root-partition-label target-root-partition-label
|
|
#:serial-console serial-console)))
|
|
`((installer-host-name . ,installer-host-name)
|
|
(install-target-device . ,install-target-device)
|
|
(boot-mode . uefi)
|
|
(image-format . iso9660)
|
|
(iso-volume-label . ,iso-volume-label)
|
|
(root-size . ,root-size)
|
|
(installer-root-partition-label . ,installer-root-partition-label)
|
|
(target-install . ,target-install-spec))))
|
|
|
|
(define image-builder-version "2")
|
|
(define install-builder-version "1")
|
|
(define installer-image-builder-version "1")
|
|
(define installer-iso-builder-version "2")
|
|
|
|
(define (operating-system-install-metadata-object install-spec closure-path store-items)
|
|
`((install-version . ,install-builder-version)
|
|
(install-spec . ,install-spec)
|
|
(closure-path . ,closure-path)
|
|
(store-item-count . ,(length store-items))
|
|
(store-items . ,store-items)))
|
|
|
|
(define (render-installer-run-script store-dir plan-directory)
|
|
(let ((target-rootfs (string-append plan-directory "/target-rootfs"))
|
|
(store-items-file (string-append plan-directory "/store-items"))
|
|
(install-metadata-source (string-append plan-directory "/install.scm"))
|
|
(target-loader-efi (string-append plan-directory "/loader.efi"))
|
|
(state-file (string-append plan-directory "/state"))
|
|
(log-file "/var/log/fruix-installer.log")
|
|
(target-device-file (string-append plan-directory "/target-device"))
|
|
(efi-size-file (string-append plan-directory "/efi-size"))
|
|
(efi-label-file (string-append plan-directory "/efi-partition-label"))
|
|
(root-label-file (string-append plan-directory "/root-partition-label")))
|
|
(string-append
|
|
"#!/bin/sh\n"
|
|
"set -eu\n"
|
|
"PATH=/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/local/bin\n"
|
|
"umask 022\n"
|
|
"target_rootfs='" target-rootfs "'\n"
|
|
"store_items_file='" store-items-file "'\n"
|
|
"install_metadata_source='" install-metadata-source "'\n"
|
|
"target_loader_efi='" target-loader-efi "'\n"
|
|
"state_file='" state-file "'\n"
|
|
"log_file='" log-file "'\n"
|
|
"target_device=$(cat '" target-device-file "')\n"
|
|
"efi_size=$(cat '" efi-size-file "')\n"
|
|
"efi_partition_label=$(cat '" efi-label-file "')\n"
|
|
"root_partition_label=$(cat '" root-label-file "')\n"
|
|
"esp_device=\"${target_device}p1\"\n"
|
|
"root_device=\"${target_device}p2\"\n"
|
|
"mnt_root=/var/run/fruix-installer/target-root\n"
|
|
"mnt_esp=/var/run/fruix-installer/target-esp\n"
|
|
"write_state()\n"
|
|
"{\n"
|
|
" mkdir -p \"$(dirname \"$state_file\")\"\n"
|
|
" printf '%s\\n' \"$1\" >\"$state_file\"\n"
|
|
"}\n"
|
|
"cleanup()\n"
|
|
"{\n"
|
|
" umount \"$mnt_esp\" >/dev/null 2>&1 || true\n"
|
|
" umount \"$mnt_root\" >/dev/null 2>&1 || true\n"
|
|
"}\n"
|
|
"cleanup_and_record()\n"
|
|
"{\n"
|
|
" status=\"$1\"\n"
|
|
" if [ \"$status\" -ne 0 ]; then\n"
|
|
" echo \"fruix-installer:failed status=$status\"\n"
|
|
" write_state failed\n"
|
|
" fi\n"
|
|
" cleanup\n"
|
|
"}\n"
|
|
"trap 'status=$?; cleanup_and_record \"$status\"' EXIT\n"
|
|
"trap 'exit 1' INT TERM\n"
|
|
"mkdir -p \"$(dirname \"$log_file\")\" /var/run/fruix-installer\n"
|
|
"exec >>\"$log_file\" 2>&1\n"
|
|
"echo 'fruix-installer:start'\n"
|
|
"write_state starting\n"
|
|
"[ -e \"$target_device\" ] || { echo \"fruix-installer:error missing target device $target_device\"; exit 1; }\n"
|
|
"gpart destroy -F \"$target_device\" >/dev/null 2>&1 || true\n"
|
|
"gpart create -s gpt \"$target_device\"\n"
|
|
"gpart add -a 1m -s \"$efi_size\" -t efi -l \"$efi_partition_label\" \"$target_device\"\n"
|
|
"gpart add -a 1m -t freebsd-ufs -l \"$root_partition_label\" \"$target_device\"\n"
|
|
"newfs_msdos -L EFISYS \"$esp_device\"\n"
|
|
"newfs -U -L \"$root_partition_label\" \"$root_device\"\n"
|
|
"mkdir -p \"$mnt_root\" \"$mnt_esp\"\n"
|
|
"mount -t ufs \"$root_device\" \"$mnt_root\"\n"
|
|
"mount -t msdosfs \"$esp_device\" \"$mnt_esp\"\n"
|
|
"write_state copying-rootfs\n"
|
|
"(cd \"$target_rootfs\" && pax -rw -pe . \"$mnt_root\")\n"
|
|
"mkdir -p \"$mnt_root" store-dir "\"\n"
|
|
"write_state copying-store\n"
|
|
"while IFS= read -r item_base || [ -n \"$item_base\" ]; do\n"
|
|
" [ -n \"$item_base\" ] || continue\n"
|
|
" (cd '" store-dir "' && pax -rw -pe \"$item_base\" \"$mnt_root" store-dir "\")\n"
|
|
"done <\"$store_items_file\"\n"
|
|
"mkdir -p \"$mnt_root/var/lib/fruix\" \"$mnt_root/var/lib/fruix/system/generations/1\" \"$mnt_esp/EFI/BOOT\"\n"
|
|
"cp \"$target_loader_efi\" \"$mnt_esp/EFI/BOOT/BOOTX64.EFI\"\n"
|
|
"cp \"$install_metadata_source\" \"$mnt_root/var/lib/fruix/install.scm\"\n"
|
|
"cp \"$install_metadata_source\" \"$mnt_root/var/lib/fruix/system/generations/1/install.scm\"\n"
|
|
"sync\n"
|
|
"echo 'fruix-installer:done'\n"
|
|
"write_state done\n")))
|
|
|
|
(define (render-installer-rc-script plan-directory)
|
|
(string-append
|
|
"#!/bin/sh\n"
|
|
"# PROVIDE: fruix_installer\n"
|
|
"# REQUIRE: NETWORKING sshd fruix_shepherd\n"
|
|
"# KEYWORD: shutdown\n\n"
|
|
". /etc/rc.subr\n\n"
|
|
"name=fruix_installer\n"
|
|
"rcvar=fruix_installer_enable\n"
|
|
": ${fruix_installer_enable:=YES}\n"
|
|
"pidfile=/var/run/fruix-installer.pid\n"
|
|
"command=/usr/sbin/daemon\n"
|
|
"command_args='-c -f -p /var/run/fruix-installer.pid -o /var/log/fruix-installer-bootstrap.out /usr/local/libexec/fruix-installer-run'\n"
|
|
"start_cmd=fruix_installer_start\n"
|
|
"stop_cmd=fruix_installer_stop\n"
|
|
"status_cmd=fruix_installer_status\n\n"
|
|
"fruix_installer_start()\n"
|
|
"{\n"
|
|
" mkdir -p '" plan-directory "' /var/run\n"
|
|
" $command $command_args\n"
|
|
"}\n\n"
|
|
"fruix_installer_stop()\n"
|
|
"{\n"
|
|
" [ -f \"$pidfile\" ] && kill \"$(cat \"$pidfile\")\" >/dev/null 2>&1 || true\n"
|
|
" rm -f \"$pidfile\"\n"
|
|
" return 0\n"
|
|
"}\n\n"
|
|
"fruix_installer_status()\n"
|
|
"{\n"
|
|
" [ -f '" plan-directory "/state' ]\n"
|
|
"}\n\n"
|
|
"load_rc_config $name\n"
|
|
"run_rc_command \"$1\"\n"))
|
|
|
|
(define (resize-gpt-image image disk-capacity)
|
|
(when disk-capacity
|
|
(run-command "truncate" "-s" disk-capacity image)
|
|
(let ((md (command-output "mdconfig" "-a" "-t" "vnode" "-f" image)))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(run-command "gpart" "recover" (string-append "/dev/" md)))
|
|
(lambda ()
|
|
(run-command "mdconfig" "-d" "-u" (string-drop md 2)))))))
|
|
|
|
(define* (install-operating-system os
|
|
#:key
|
|
target
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install")
|
|
(efi-size "64m")
|
|
(root-size #f)
|
|
(disk-capacity #f)
|
|
(efi-partition-label "efiboot")
|
|
(root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
(unless (and (string? target) (not (string-null? target)))
|
|
(error "install target must be a non-empty path" target))
|
|
(let* ((closure (materialize-operating-system os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(closure-path (assoc-ref closure 'closure-path))
|
|
(store-items (store-reference-closure (list closure-path)))
|
|
(target-kind (if (string-prefix? "/dev/" target)
|
|
'block-device
|
|
'raw-file))
|
|
(install-spec (operating-system-install-spec os
|
|
#:target target
|
|
#:target-kind target-kind
|
|
#:efi-size efi-size
|
|
#:root-size root-size
|
|
#:disk-capacity disk-capacity
|
|
#:efi-partition-label efi-partition-label
|
|
#:root-partition-label root-partition-label
|
|
#:serial-console serial-console))
|
|
(build-root (mktemp-directory "/tmp/fruix-system-install.XXXXXX"))
|
|
(rootfs (string-append build-root "/rootfs"))
|
|
(mnt-root (string-append build-root "/mnt-root"))
|
|
(mnt-esp (string-append build-root "/mnt-esp"))
|
|
(install-metadata-relative-path "/var/lib/fruix/install.scm")
|
|
(target-device #f)
|
|
(target-md #f)
|
|
(esp-device #f)
|
|
(root-device #f)
|
|
(root-mounted? #f)
|
|
(esp-mounted? #f))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(populate-rootfs-from-closure os rootfs closure-path
|
|
#:install-spec install-spec
|
|
#:install-metadata-path install-metadata-relative-path)
|
|
(mkdir-p mnt-root)
|
|
(mkdir-p mnt-esp)
|
|
(case target-kind
|
|
((raw-file)
|
|
(unless disk-capacity
|
|
(error "raw-file install target requires --disk-capacity" target))
|
|
(mkdir-p (dirname target))
|
|
(delete-path-if-exists target)
|
|
(run-command "truncate" "-s" disk-capacity target)
|
|
(let ((md (command-output "mdconfig" "-a" "-t" "vnode" "-f" target)))
|
|
(set! target-md md)
|
|
(set! target-device (string-append "/dev/" md))))
|
|
((block-device)
|
|
(set! target-device target)))
|
|
(system* "sh" "-c"
|
|
(string-append "gpart destroy -F " target-device " >/dev/null 2>&1"))
|
|
(run-command "gpart" "create" "-s" "gpt" target-device)
|
|
(run-command "gpart" "add" "-a" "1m" "-s" efi-size
|
|
"-t" "efi" "-l" efi-partition-label target-device)
|
|
(if root-size
|
|
(run-command "gpart" "add" "-a" "1m" "-s" root-size
|
|
"-t" "freebsd-ufs" "-l" root-partition-label target-device)
|
|
(run-command "gpart" "add" "-a" "1m"
|
|
"-t" "freebsd-ufs" "-l" root-partition-label target-device))
|
|
(set! esp-device (string-append target-device "p1"))
|
|
(set! root-device (string-append target-device "p2"))
|
|
(run-command "newfs_msdos" "-L" "EFISYS" esp-device)
|
|
(run-command "newfs" "-U" "-L" root-partition-label root-device)
|
|
(run-command "mount" "-t" "ufs" root-device mnt-root)
|
|
(set! root-mounted? #t)
|
|
(run-command "mount" "-t" "msdosfs" esp-device mnt-esp)
|
|
(set! esp-mounted? #t)
|
|
(copy-tree-contents rootfs mnt-root)
|
|
(copy-store-items-into-rootfs mnt-root store-dir store-items)
|
|
(mkdir-p (string-append mnt-esp "/EFI/BOOT"))
|
|
(copy-regular-file (string-append closure-path "/boot/loader.efi")
|
|
(string-append mnt-esp "/EFI/BOOT/BOOTX64.EFI"))
|
|
(let ((install-metadata-file (string-append mnt-root install-metadata-relative-path)))
|
|
(write-file install-metadata-file
|
|
(object->string
|
|
(operating-system-install-metadata-object install-spec closure-path store-items)))
|
|
(chmod install-metadata-file #o644)
|
|
(populate-system-generation-layout os mnt-root closure-path
|
|
#:install-spec install-spec
|
|
#:install-metadata-path install-metadata-relative-path))
|
|
(run-command "sync")
|
|
`((target . ,target)
|
|
(target-kind . ,target-kind)
|
|
(target-device . ,target-device)
|
|
(esp-device . ,esp-device)
|
|
(root-device . ,root-device)
|
|
(install-spec . ,install-spec)
|
|
(install-metadata-path . ,install-metadata-relative-path)
|
|
(closure-path . ,closure-path)
|
|
(host-base-stores . ,(assoc-ref closure 'host-base-stores))
|
|
(native-base-stores . ,(assoc-ref closure 'native-base-stores))
|
|
(fruix-runtime-stores . ,(assoc-ref closure 'fruix-runtime-stores))
|
|
(freebsd-base-file . ,(assoc-ref closure 'freebsd-base-file))
|
|
(freebsd-source-file . ,(assoc-ref closure 'freebsd-source-file))
|
|
(freebsd-source-materializations-file . ,(assoc-ref closure 'freebsd-source-materializations-file))
|
|
(materialized-source-stores . ,(assoc-ref closure 'materialized-source-stores))
|
|
(host-base-provenance-file . ,(assoc-ref closure 'host-base-provenance-file))
|
|
(store-layout-file . ,(assoc-ref closure 'store-layout-file))
|
|
(store-items . ,store-items)))
|
|
(lambda ()
|
|
(when esp-mounted?
|
|
(system* "umount" mnt-esp)
|
|
(set! esp-mounted? #f))
|
|
(when root-mounted?
|
|
(system* "umount" mnt-root)
|
|
(set! root-mounted? #f))
|
|
(when target-md
|
|
(system* "mdconfig" "-d" "-u" (string-drop target-md 2))
|
|
(set! target-md #f))
|
|
(when (file-exists? build-root)
|
|
(delete-file-recursively build-root))))))
|
|
|
|
(define* (materialize-bhyve-image os
|
|
#:key
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install")
|
|
(efi-size "64m")
|
|
(root-size "256m")
|
|
(disk-capacity #f)
|
|
(efi-partition-label "efiboot")
|
|
(root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
(let* ((closure (materialize-operating-system os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(closure-path (assoc-ref closure 'closure-path))
|
|
(image-spec (operating-system-image-spec os
|
|
#:efi-size efi-size
|
|
#:root-size root-size
|
|
#:disk-capacity disk-capacity
|
|
#:efi-partition-label efi-partition-label
|
|
#:root-partition-label root-partition-label
|
|
#:serial-console serial-console))
|
|
(store-items (store-reference-closure (list closure-path)))
|
|
(manifest (string-append
|
|
"image-builder-version=\n"
|
|
image-builder-version
|
|
"\nimage-spec=\n"
|
|
(object->string image-spec)
|
|
"closure-path=\n"
|
|
closure-path
|
|
"\nstore-items=\n"
|
|
(string-join store-items "\n")
|
|
"\n"))
|
|
(hash (sha256-string manifest))
|
|
(image-store-path (string-append store-dir "/" hash "-fruix-bhyve-image-"
|
|
(operating-system-host-name os)))
|
|
(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")))
|
|
(unless (file-exists? image-store-path)
|
|
(let* ((build-root (mktemp-directory "/tmp/fruix-bhyve-image-build.XXXXXX"))
|
|
(rootfs (string-append build-root "/rootfs"))
|
|
(image-rootfs (string-append build-root "/image-rootfs"))
|
|
(esp-stage (string-append build-root "/esp-stage"))
|
|
(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")))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(materialize-rootfs os rootfs
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix)
|
|
(copy-rootfs-for-image rootfs image-rootfs)
|
|
(copy-store-items-into-rootfs image-rootfs store-dir store-items)
|
|
(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"))
|
|
(run-command "makefs" "-t" "ffs" "-T" "0" "-B" "little"
|
|
"-s" root-size
|
|
"-o" (string-append "label=" root-partition-label
|
|
",version=2,bsize=32768,fsize=4096,density=16384")
|
|
temp-root image-rootfs)
|
|
(run-command "makefs" "-t" "msdos" "-T" "0"
|
|
"-o" "fat_type=32"
|
|
"-o" "sectors_per_cluster=1"
|
|
"-o" "volume_label=EFISYS"
|
|
"-o" "volume_id=305419896"
|
|
"-s" efi-size
|
|
temp-esp esp-stage)
|
|
(run-command "mkimg" "-s" "gpt" "-f" "raw" "-t" "0"
|
|
"-p" (string-append "efi/" efi-partition-label ":=" temp-esp)
|
|
"-p" (string-append "freebsd-ufs/" root-partition-label ":=" temp-root)
|
|
"-o" temp-disk)
|
|
(resize-gpt-image temp-disk disk-capacity)
|
|
(mkdir-p temp-output)
|
|
(copy-regular-file temp-disk (string-append temp-output "/disk.img"))
|
|
(copy-regular-file temp-esp (string-append temp-output "/esp.img"))
|
|
(copy-regular-file temp-root (string-append temp-output "/root.ufs"))
|
|
(write-file (string-append temp-output "/image-spec.scm") (object->string image-spec))
|
|
(write-file (string-append temp-output "/closure-path") closure-path)
|
|
(write-file (string-append temp-output "/.references") (string-join store-items "\n"))
|
|
(write-file (string-append temp-output "/.fruix-package") manifest)
|
|
(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")))
|
|
(rename-file temp-output image-store-path))
|
|
(lambda ()
|
|
(when (file-exists? build-root)
|
|
(delete-file-recursively build-root))))))
|
|
`((image-store-path . ,image-store-path)
|
|
(disk-image . ,disk-image)
|
|
(esp-image . ,esp-image)
|
|
(root-image . ,root-image)
|
|
(closure-path . ,closure-path)
|
|
(host-base-stores . ,(assoc-ref closure 'host-base-stores))
|
|
(native-base-stores . ,(assoc-ref closure 'native-base-stores))
|
|
(fruix-runtime-stores . ,(assoc-ref closure 'fruix-runtime-stores))
|
|
(freebsd-base-file . ,(assoc-ref closure 'freebsd-base-file))
|
|
(freebsd-source-file . ,(assoc-ref closure 'freebsd-source-file))
|
|
(freebsd-source-materializations-file . ,(assoc-ref closure 'freebsd-source-materializations-file))
|
|
(materialized-source-stores . ,(assoc-ref closure 'materialized-source-stores))
|
|
(host-base-provenance-file . ,(assoc-ref closure 'host-base-provenance-file))
|
|
(store-layout-file . ,(assoc-ref closure 'store-layout-file))
|
|
(image-spec . ,image-spec)
|
|
(store-items . ,store-items))))
|
|
|
|
(define* (materialize-installer-image os
|
|
#:key
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install")
|
|
(install-target-device "/dev/vtbd1")
|
|
(efi-size "64m")
|
|
(root-size "10g")
|
|
(disk-capacity #f)
|
|
(installer-host-name (string-append (operating-system-host-name os)
|
|
"-installer"))
|
|
(installer-efi-partition-label "efiboot")
|
|
(installer-root-partition-label "fruix-installer-root")
|
|
(target-efi-partition-label "efiboot")
|
|
(target-root-partition-label "fruix-root")
|
|
(serial-console "comconsole"))
|
|
(let* ((installer-os (installer-operating-system os
|
|
#:host-name installer-host-name
|
|
#:root-partition-label installer-root-partition-label))
|
|
(target-closure (materialize-operating-system os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(installer-closure (materialize-operating-system installer-os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(target-closure-path (assoc-ref target-closure 'closure-path))
|
|
(installer-closure-path (assoc-ref installer-closure 'closure-path))
|
|
(target-store-items (store-reference-closure (list target-closure-path)))
|
|
(installer-store-items (store-reference-closure (list installer-closure-path)))
|
|
(combined-store-items (delete-duplicates (append installer-store-items target-store-items)))
|
|
(installer-image-spec (operating-system-installer-image-spec os
|
|
#:install-target-device install-target-device
|
|
#:installer-host-name installer-host-name
|
|
#:efi-size efi-size
|
|
#:root-size root-size
|
|
#:disk-capacity disk-capacity
|
|
#:installer-efi-partition-label installer-efi-partition-label
|
|
#:installer-root-partition-label installer-root-partition-label
|
|
#:target-efi-partition-label target-efi-partition-label
|
|
#:target-root-partition-label target-root-partition-label
|
|
#:serial-console serial-console))
|
|
(image-spec (assoc-ref installer-image-spec 'installer-image))
|
|
(target-install-spec (assoc-ref installer-image-spec 'target-install))
|
|
(install-metadata (operating-system-install-metadata-object target-install-spec
|
|
target-closure-path
|
|
target-store-items))
|
|
(installer-plan-directory "/var/lib/fruix/installer")
|
|
(installer-state-path (string-append installer-plan-directory "/state"))
|
|
(installer-log-path "/var/log/fruix-installer.log")
|
|
(manifest (string-append
|
|
"installer-image-builder-version=\n"
|
|
installer-image-builder-version
|
|
"\ninstaller-image-spec=\n"
|
|
(object->string installer-image-spec)
|
|
"installer-closure-path=\n"
|
|
installer-closure-path
|
|
"\ntarget-closure-path=\n"
|
|
target-closure-path
|
|
"\ncombined-store-items=\n"
|
|
(string-join combined-store-items "\n")
|
|
"\ntarget-store-items=\n"
|
|
(string-join target-store-items "\n")
|
|
"\ninstall-metadata=\n"
|
|
(object->string install-metadata)
|
|
"\n"))
|
|
(hash (sha256-string manifest))
|
|
(image-store-path (string-append store-dir "/" hash "-fruix-installer-image-"
|
|
(operating-system-host-name installer-os)))
|
|
(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")))
|
|
(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"))
|
|
(target-rootfs (string-append build-root "/target-rootfs"))
|
|
(image-rootfs (string-append build-root "/image-rootfs"))
|
|
(esp-stage (string-append build-root "/esp-stage"))
|
|
(temp-output (mktemp-directory (string-append store-dir "/.fruix-installer-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"))
|
|
(plan-root (string-append image-rootfs installer-plan-directory)))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path)
|
|
(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 installer-rootfs image-rootfs)
|
|
(mkdir-p plan-root)
|
|
(mkdir-p (string-append image-rootfs "/usr/local/libexec"))
|
|
(mkdir-p (string-append image-rootfs "/usr/local/etc/rc.d"))
|
|
(mkdir-p (string-append plan-root "/target-rootfs"))
|
|
(copy-tree-contents target-rootfs (string-append plan-root "/target-rootfs"))
|
|
(copy-store-items-into-rootfs image-rootfs store-dir combined-store-items)
|
|
(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")
|
|
(object->string install-metadata))
|
|
(copy-regular-file (string-append target-closure-path "/boot/loader.efi")
|
|
(string-append plan-root "/loader.efi"))
|
|
(write-file (string-append plan-root "/target-device")
|
|
(string-append install-target-device "\n"))
|
|
(write-file (string-append plan-root "/efi-size")
|
|
(string-append efi-size "\n"))
|
|
(write-file (string-append plan-root "/efi-partition-label")
|
|
(string-append target-efi-partition-label "\n"))
|
|
(write-file (string-append plan-root "/root-partition-label")
|
|
(string-append target-root-partition-label "\n"))
|
|
(write-file (string-append plan-root "/state") "pending\n")
|
|
(write-file (string-append image-rootfs "/usr/local/libexec/fruix-installer-run")
|
|
(render-installer-run-script store-dir installer-plan-directory))
|
|
(write-file (string-append image-rootfs "/usr/local/etc/rc.d/fruix-installer")
|
|
(render-installer-rc-script installer-plan-directory))
|
|
(chmod (string-append image-rootfs "/usr/local/libexec/fruix-installer-run") #o555)
|
|
(chmod (string-append image-rootfs "/usr/local/etc/rc.d/fruix-installer") #o555)
|
|
(mkdir-p (string-append esp-stage "/EFI/BOOT"))
|
|
(copy-regular-file (string-append installer-closure-path "/boot/loader.efi")
|
|
(string-append esp-stage "/EFI/BOOT/BOOTX64.EFI"))
|
|
(run-command "makefs" "-t" "ffs" "-T" "0" "-B" "little"
|
|
"-s" root-size
|
|
"-o" (string-append "label=" installer-root-partition-label
|
|
",version=2,bsize=32768,fsize=4096,density=16384")
|
|
temp-root image-rootfs)
|
|
(run-command "makefs" "-t" "msdos" "-T" "0"
|
|
"-o" "fat_type=32"
|
|
"-o" "sectors_per_cluster=1"
|
|
"-o" "volume_label=EFISYS"
|
|
"-o" "volume_id=305419896"
|
|
"-s" efi-size
|
|
temp-esp esp-stage)
|
|
(run-command "mkimg" "-s" "gpt" "-f" "raw" "-t" "0"
|
|
"-p" (string-append "efi/" installer-efi-partition-label ":=" temp-esp)
|
|
"-p" (string-append "freebsd-ufs/" installer-root-partition-label ":=" temp-root)
|
|
"-o" temp-disk)
|
|
(resize-gpt-image temp-disk disk-capacity)
|
|
(mkdir-p temp-output)
|
|
(copy-regular-file temp-disk (string-append temp-output "/disk.img"))
|
|
(copy-regular-file temp-esp (string-append temp-output "/esp.img"))
|
|
(copy-regular-file temp-root (string-append temp-output "/root.ufs"))
|
|
(write-file (string-append temp-output "/installer-image-spec.scm")
|
|
(object->string installer-image-spec))
|
|
(write-file (string-append temp-output "/installer-closure-path") installer-closure-path)
|
|
(write-file (string-append temp-output "/target-closure-path") target-closure-path)
|
|
(write-file (string-append temp-output "/.references")
|
|
(string-join combined-store-items "\n"))
|
|
(write-file (string-append temp-output "/.fruix-package") manifest)
|
|
(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")))
|
|
(rename-file temp-output image-store-path))
|
|
(lambda ()
|
|
(when (file-exists? build-root)
|
|
(delete-file-recursively build-root))))))
|
|
`((image-store-path . ,image-store-path)
|
|
(disk-image . ,disk-image)
|
|
(esp-image . ,esp-image)
|
|
(root-image . ,root-image)
|
|
(installer-closure-path . ,installer-closure-path)
|
|
(target-closure-path . ,target-closure-path)
|
|
(closure-path . ,installer-closure-path)
|
|
(image-spec . ,image-spec)
|
|
(installer-image-spec . ,installer-image-spec)
|
|
(install-spec . ,target-install-spec)
|
|
(installer-state-path . ,installer-state-path)
|
|
(installer-log-path . ,installer-log-path)
|
|
(install-target-device . ,install-target-device)
|
|
(host-base-stores . ,(assoc-ref target-closure 'host-base-stores))
|
|
(native-base-stores . ,(assoc-ref target-closure 'native-base-stores))
|
|
(fruix-runtime-stores . ,(assoc-ref target-closure 'fruix-runtime-stores))
|
|
(freebsd-base-file . ,(assoc-ref target-closure 'freebsd-base-file))
|
|
(freebsd-source-file . ,(assoc-ref target-closure 'freebsd-source-file))
|
|
(freebsd-source-materializations-file . ,(assoc-ref target-closure 'freebsd-source-materializations-file))
|
|
(materialized-source-stores . ,(assoc-ref target-closure 'materialized-source-stores))
|
|
(host-base-provenance-file . ,(assoc-ref target-closure 'host-base-provenance-file))
|
|
(store-layout-file . ,(assoc-ref target-closure 'store-layout-file))
|
|
(store-items . ,combined-store-items)
|
|
(target-store-items . ,target-store-items)
|
|
(installer-store-items . ,installer-store-items))))
|
|
|
|
(define (resolved-path path)
|
|
(let ((target (false-if-exception (readlink path))))
|
|
(if target
|
|
(if (string-prefix? "/" target)
|
|
target
|
|
(string-append (dirname path) "/" target))
|
|
path)))
|
|
|
|
(define (copy-resolved-node source destination)
|
|
(copy-node (resolved-path source) destination))
|
|
|
|
(define (sanitize-iso-volume-label label)
|
|
(let* ((text (if (and (string? label) (not (string-null? label)))
|
|
label
|
|
"FRUIX_INSTALLER"))
|
|
(upper (string-upcase text))
|
|
(chars (map (lambda (ch)
|
|
(if (or (char-alphabetic? ch)
|
|
(char-numeric? ch)
|
|
(memv ch '(#\_ #\-)))
|
|
ch
|
|
#\_))
|
|
(string->list upper)))
|
|
(sanitized (list->string chars)))
|
|
(if (> (string-length sanitized) 32)
|
|
(substring sanitized 0 32)
|
|
sanitized)))
|
|
|
|
(define (source-store-item? item)
|
|
(string-contains (path-basename item) "-freebsd-source-"))
|
|
|
|
(define (runtime-store-items items)
|
|
(filter (lambda (item)
|
|
(not (source-store-item? item)))
|
|
items))
|
|
|
|
(define (write-installer-iso-loader-conf source-path destination)
|
|
(let* ((mode (stat:perms (stat source-path)))
|
|
(base (call-with-input-file source-path get-string-all))
|
|
(extra (string-append
|
|
"mdroot_load=\"YES\"\n"
|
|
"mdroot_type=\"mfs_root\"\n"
|
|
"mdroot_name=\"/boot/root.img\"\n"
|
|
"vfs.root.mountfrom=\"ufs:/dev/md0\"\n"
|
|
"vfs.root.mountfrom.options=\"rw\"\n")))
|
|
(write-file destination
|
|
(string-append base
|
|
(if (or (string-null? base)
|
|
(char=? (string-ref base (- (string-length base) 1)) #\newline))
|
|
""
|
|
"\n")
|
|
extra))
|
|
(chmod destination mode)))
|
|
|
|
(define (rewrite-installer-iso-fstab image-rootfs installer-closure-path)
|
|
(let ((fstab-path (string-append image-rootfs "/frx/store/"
|
|
(path-basename installer-closure-path)
|
|
"/etc/fstab")))
|
|
(rewrite-text-file fstab-path
|
|
'(("/dev/gpt/fruix-installer-root\t/\tufs"
|
|
. "/dev/md0\t/\tufs")))))
|
|
|
|
(define* (make-ufs-image output-path source-root label #:key size)
|
|
(apply run-command
|
|
(append (list "makefs" "-t" "ffs" "-T" "0" "-B" "little")
|
|
(if size
|
|
(list "-s" size)
|
|
'())
|
|
(list "-o" (string-append "label=" label
|
|
",version=2,bsize=32768,fsize=4096,density=16384")
|
|
output-path
|
|
source-root))))
|
|
|
|
(define (make-efi-boot-image loader-efi output-path)
|
|
(let ((stage-root (mktemp-directory "/tmp/fruix-installer-iso-esp.XXXXXX")))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(mkdir-p (string-append stage-root "/EFI/BOOT"))
|
|
(copy-regular-file loader-efi
|
|
(string-append stage-root "/EFI/BOOT/BOOTX64.EFI"))
|
|
(run-command "makefs" "-t" "msdos" "-T" "0"
|
|
"-o" "fat_type=12"
|
|
"-o" "sectors_per_cluster=1"
|
|
"-o" "volume_label=EFISYS"
|
|
"-s" "2048k"
|
|
output-path stage-root))
|
|
(lambda ()
|
|
(when (file-exists? stage-root)
|
|
(delete-file-recursively stage-root))))))
|
|
|
|
(define (populate-installer-iso-boot-tree installer-closure-path iso-root root-image-path)
|
|
(let ((boot-root (string-append iso-root "/boot")))
|
|
(mkdir-p (string-append boot-root "/kernel"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/kernel/kernel")
|
|
(string-append boot-root "/kernel/kernel"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/kernel/linker.hints")
|
|
(string-append boot-root "/kernel/linker.hints"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/loader")
|
|
(string-append boot-root "/loader"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/loader.efi")
|
|
(string-append boot-root "/loader.efi"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/device.hints")
|
|
(string-append boot-root "/device.hints"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/defaults")
|
|
(string-append boot-root "/defaults"))
|
|
(copy-resolved-node (string-append installer-closure-path "/boot/lua")
|
|
(string-append boot-root "/lua"))
|
|
(write-installer-iso-loader-conf (string-append installer-closure-path "/boot/loader.conf")
|
|
(string-append boot-root "/loader.conf"))
|
|
(copy-regular-file root-image-path
|
|
(string-append boot-root "/root.img"))))
|
|
|
|
(define* (materialize-installer-iso os
|
|
#:key
|
|
(store-dir "/frx/store")
|
|
(guile-prefix "/tmp/guile-freebsd-validate-install")
|
|
(guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install")
|
|
(shepherd-prefix "/tmp/shepherd-freebsd-validate-install")
|
|
(install-target-device "/dev/vtbd0")
|
|
(root-size #f)
|
|
(installer-host-name (string-append (operating-system-host-name os)
|
|
"-installer"))
|
|
(installer-root-partition-label "fruix-installer-root")
|
|
(target-efi-partition-label "efiboot")
|
|
(target-root-partition-label "fruix-root")
|
|
(serial-console "comconsole")
|
|
(iso-volume-label "FRUIX_INSTALLER"))
|
|
(let* ((installer-os (installer-operating-system os
|
|
#:host-name installer-host-name
|
|
#:root-partition-label installer-root-partition-label))
|
|
(target-closure (materialize-operating-system os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(installer-closure (materialize-operating-system installer-os
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix))
|
|
(target-closure-path (assoc-ref target-closure 'closure-path))
|
|
(installer-closure-path (assoc-ref installer-closure 'closure-path))
|
|
(target-closure-store-items (store-reference-closure (list target-closure-path)))
|
|
(target-runtime-store-items (runtime-store-items target-closure-store-items))
|
|
(installer-store-items (runtime-store-items
|
|
(store-reference-closure (list installer-closure-path))))
|
|
(combined-store-items (delete-duplicates (append installer-store-items target-runtime-store-items)))
|
|
(sanitized-iso-volume-label (sanitize-iso-volume-label iso-volume-label))
|
|
(installer-iso-spec (operating-system-installer-iso-spec os
|
|
#:install-target-device install-target-device
|
|
#:installer-host-name installer-host-name
|
|
#:root-size root-size
|
|
#:iso-volume-label sanitized-iso-volume-label
|
|
#:installer-root-partition-label installer-root-partition-label
|
|
#:target-efi-partition-label target-efi-partition-label
|
|
#:target-root-partition-label target-root-partition-label
|
|
#:serial-console serial-console))
|
|
(target-install-spec (assoc-ref installer-iso-spec 'target-install))
|
|
(install-metadata (operating-system-install-metadata-object target-install-spec
|
|
target-closure-path
|
|
target-closure-store-items))
|
|
(installer-plan-directory "/var/lib/fruix/installer")
|
|
(installer-state-path (string-append installer-plan-directory "/state"))
|
|
(installer-log-path "/var/log/fruix-installer.log")
|
|
(manifest (string-append
|
|
"installer-iso-builder-version=\n"
|
|
installer-iso-builder-version
|
|
"\ninstaller-iso-spec=\n"
|
|
(object->string installer-iso-spec)
|
|
"installer-closure-path=\n"
|
|
installer-closure-path
|
|
"\ntarget-closure-path=\n"
|
|
target-closure-path
|
|
"\ncombined-store-items=\n"
|
|
(string-join combined-store-items "\n")
|
|
"\ntarget-store-items=\n"
|
|
(string-join target-closure-store-items "\n")
|
|
"\ninstall-metadata=\n"
|
|
(object->string install-metadata)
|
|
"\n"))
|
|
(hash (sha256-string manifest))
|
|
(iso-store-path (string-append store-dir "/" hash "-fruix-installer-iso-"
|
|
(operating-system-host-name installer-os)))
|
|
(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")))
|
|
(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"))
|
|
(target-rootfs (string-append build-root "/target-rootfs"))
|
|
(image-rootfs (string-append build-root "/image-rootfs"))
|
|
(iso-root (string-append build-root "/iso-root"))
|
|
(temp-output (mktemp-directory (string-append store-dir "/.fruix-installer-iso.XXXXXX")))
|
|
(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)))
|
|
(dynamic-wind
|
|
(lambda () #t)
|
|
(lambda ()
|
|
(populate-rootfs-from-closure installer-os installer-rootfs installer-closure-path)
|
|
(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 installer-rootfs image-rootfs)
|
|
(mkdir-p plan-root)
|
|
(mkdir-p (string-append image-rootfs "/usr/local/libexec"))
|
|
(mkdir-p (string-append image-rootfs "/usr/local/etc/rc.d"))
|
|
(mkdir-p (string-append plan-root "/target-rootfs"))
|
|
(copy-tree-contents target-rootfs (string-append plan-root "/target-rootfs"))
|
|
(copy-store-items-into-rootfs image-rootfs store-dir combined-store-items)
|
|
(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")
|
|
(object->string install-metadata))
|
|
(copy-regular-file (string-append target-closure-path "/boot/loader.efi")
|
|
(string-append plan-root "/loader.efi"))
|
|
(write-file (string-append plan-root "/target-device")
|
|
(string-append install-target-device "\n"))
|
|
(write-file (string-append plan-root "/efi-size") "64m\n")
|
|
(write-file (string-append plan-root "/efi-partition-label")
|
|
(string-append target-efi-partition-label "\n"))
|
|
(write-file (string-append plan-root "/root-partition-label")
|
|
(string-append target-root-partition-label "\n"))
|
|
(write-file (string-append plan-root "/state") "pending\n")
|
|
(write-file (string-append image-rootfs "/usr/local/libexec/fruix-installer-run")
|
|
(render-installer-run-script store-dir installer-plan-directory))
|
|
(write-file (string-append image-rootfs "/usr/local/etc/rc.d/fruix-installer")
|
|
(render-installer-rc-script installer-plan-directory))
|
|
(chmod (string-append image-rootfs "/usr/local/libexec/fruix-installer-run") #o555)
|
|
(chmod (string-append image-rootfs "/usr/local/etc/rc.d/fruix-installer") #o555)
|
|
(rewrite-installer-iso-fstab image-rootfs installer-closure-path)
|
|
(make-ufs-image temp-root image-rootfs installer-root-partition-label #:size root-size)
|
|
(populate-installer-iso-boot-tree installer-closure-path iso-root temp-root)
|
|
(make-efi-boot-image (resolved-path (string-append installer-closure-path "/boot/loader.efi")) temp-esp)
|
|
(run-command "makefs" "-t" "cd9660" "-T" "0"
|
|
"-o" (string-append "bootimage=efi;" temp-esp)
|
|
"-o" "no-emul-boot"
|
|
"-o" "platformid=efi"
|
|
"-o" "rockridge"
|
|
"-o" (string-append "label=" sanitized-iso-volume-label)
|
|
temp-iso iso-root)
|
|
(mkdir-p temp-output)
|
|
(copy-regular-file temp-iso (string-append temp-output "/installer.iso"))
|
|
(copy-regular-file temp-esp (string-append temp-output "/efiboot.img"))
|
|
(copy-regular-file temp-root (string-append temp-output "/root.img"))
|
|
(write-file (string-append temp-output "/installer-iso-spec.scm")
|
|
(object->string installer-iso-spec))
|
|
(write-file (string-append temp-output "/installer-closure-path") installer-closure-path)
|
|
(write-file (string-append temp-output "/target-closure-path") target-closure-path)
|
|
(write-file (string-append temp-output "/.references")
|
|
(string-join combined-store-items "\n"))
|
|
(write-file (string-append temp-output "/.fruix-package") manifest)
|
|
(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")))
|
|
(rename-file temp-output iso-store-path))
|
|
(lambda ()
|
|
(when (file-exists? build-root)
|
|
(delete-file-recursively build-root))))))
|
|
`((iso-store-path . ,iso-store-path)
|
|
(iso-image . ,iso-image)
|
|
(boot-efi-image . ,boot-efi-image)
|
|
(root-image . ,root-image)
|
|
(installer-closure-path . ,installer-closure-path)
|
|
(target-closure-path . ,target-closure-path)
|
|
(closure-path . ,installer-closure-path)
|
|
(installer-iso-spec . ,installer-iso-spec)
|
|
(install-spec . ,target-install-spec)
|
|
(installer-state-path . ,installer-state-path)
|
|
(installer-log-path . ,installer-log-path)
|
|
(install-target-device . ,install-target-device)
|
|
(host-base-stores . ,(assoc-ref target-closure 'host-base-stores))
|
|
(native-base-stores . ,(assoc-ref target-closure 'native-base-stores))
|
|
(fruix-runtime-stores . ,(assoc-ref target-closure 'fruix-runtime-stores))
|
|
(freebsd-base-file . ,(assoc-ref target-closure 'freebsd-base-file))
|
|
(freebsd-source-file . ,(assoc-ref target-closure 'freebsd-source-file))
|
|
(freebsd-source-materializations-file . ,(assoc-ref target-closure 'freebsd-source-materializations-file))
|
|
(materialized-source-stores . ,(assoc-ref target-closure 'materialized-source-stores))
|
|
(host-base-provenance-file . ,(assoc-ref target-closure 'host-base-provenance-file))
|
|
(store-layout-file . ,(assoc-ref target-closure 'store-layout-file))
|
|
(store-items . ,combined-store-items)
|
|
(target-store-items . ,target-closure-store-items)
|
|
(installer-store-items . ,installer-store-items))))
|