cli: add installer-tui prototype action
This commit is contained in:
+39
-2
@@ -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"))
|
||||
|
||||
Reference in New Issue
Block a user