cli: add installer-tui prototype action

This commit is contained in:
2026-04-07 13:13:53 +02:00
parent 598e78ee7c
commit 896d7eb598
+39 -2
View File
@@ -1,7 +1,9 @@
#!/tmp/guile-freebsd-validate-install/bin/guile -s
!#
(use-modules (fruix system freebsd)
(use-modules (fruix installer)
(fruix system freebsd)
(fruix system storage)
(fruix system freebsd utils)
(fruix packages freebsd)
(ice-9 format)
@@ -25,6 +27,7 @@ System actions:\n\
image Materialize the Fruix disk image in /frx/store.\n\
installer Materialize a bootable Fruix installer image in /frx/store.\n\
installer-iso Materialize a bootable Fruix installer ISO in /frx/store.\n\
installer-tui Run the experimental Fruix Newt installer prototype.\n\
install Install the Fruix system onto --target PATH.\n\
rootfs Materialize a rootfs tree at --rootfs DIR or ROOTFS-DIR.\n\
\n\
@@ -618,6 +621,28 @@ Common options:\n\
(target_store_item_count . ,(length target-store-items))
(installer_store_item_count . ,(length installer-store-items))))))
(define (emit-installer-tui-metadata os-file resolved-symbol store-dir state result)
(emit-metadata
`((action . "installer-tui")
(os_file . ,os-file)
(system_variable . ,resolved-symbol)
(store_dir . ,store-dir)
(newt_available . ,(assoc-ref result 'available?))
(newt_result . ,(assoc-ref result 'result))
(missing_bindings . ,(assoc-ref result 'missing-bindings))
(step_count . ,(assoc-ref result 'step-count))
(step_ids . ,(assoc-ref result 'step-ids))
(selected_step . ,(installer-state-selected-step state))
(host_name . ,(installer-state-host-name state))
(target_device . ,(installer-state-target-device state))
(root_size . ,(installer-state-root-size state))
(disk_capacity . ,(installer-state-disk-capacity state))
(network_mode . ,(installer-state-network-mode state))
(storage_layout . ,(and (installer-state-storage-layout state)
(storage-layout-spec (installer-state-storage-layout state))))
(effective_storage_layout . ,(and (installer-state-effective-storage-layout state)
(storage-layout-spec (installer-state-effective-storage-layout state)))))))
(define (emit-native-build-promotion-metadata store-dir result-root result)
(emit-metadata
`((action . "promote")
@@ -839,7 +864,7 @@ Common options:\n\
(reboot? (assoc-ref parsed 'reboot?))
(system-name (assoc-ref parsed 'system-name))
(requested-symbol (and system-name (string->symbol system-name))))
(unless (member action '("build" "deploy" "image" "installer" "installer-iso" "install" "rootfs"))
(unless (member action '("build" "deploy" "image" "installer" "installer-iso" "installer-tui" "install" "rootfs"))
(error "unknown system action" action))
(let* ((deploy-host (or deploy-host-opt
(and (string=? action "deploy")
@@ -998,6 +1023,18 @@ Common options:\n\
#:declaration-system-symbol resolved-symbol
#:install-target-device (or install-target-device "/dev/vtbd0")
#:root-size root-size)))
((string=? action "installer-tui")
(let* ((seed-target-device (or install-target-device
(and target
(string-prefix? "/dev/" target)
target)))
(state (operating-system->installer-state os
#:target-device seed-target-device
#:root-size root-size
#:disk-capacity disk-capacity))
(result (run-newt-installer state)))
(emit-installer-tui-metadata
os-file resolved-symbol store-dir state result)))
((string=? action "install")
(unless target
(error "install action requires TARGET or --target PATH"))