self/fruix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Recover package CLI helpers and commands

Browse Source
This commit is contained in:
Steffen Beyer
2026-04-08 19:39:34 +02:00
parent dc1c3fa33d
commit 3144d0df0f
5 changed files with 291 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
scripts/fruix.scm
+117
View File
@@ -3,11 +3,13 @@
(use-modules (fruix installer)
(fruix system freebsd)
(fruix system freebsd build)
(fruix system storage)
(fruix system freebsd utils)
(fruix packages freebsd)
(ice-9 format)
(ice-9 match)
(ice-9 hash-table)
(srfi srfi-1)
(srfi srfi-13)
(rnrs io ports))
@@ -18,6 +20,7 @@
\n\
Commands:\n\
system ACTION ... Build or materialize Fruix system artifacts.\n\
package ACTION ... Inspect or materialize Fruix packages.\n\
source ACTION ... Fetch or snapshot declarative FreeBSD source inputs.\n\
native-build ACTION ... Promote native build results into Fruix store objects.\n\
\n\
@@ -47,6 +50,15 @@ System options:\n\
--identity FILE SSH identity file for 'deploy'.\n\
--reboot Reboot the remote node after 'deploy'.\n\
\n\
Package actions:\n\
list List known Fruix packages.\n\
search QUERY Search known Fruix packages by name or text.\n\
show NAME Show metadata for one Fruix package.\n\
build NAME Materialize one Fruix package in /frx/store.\n\
\n\
Package options:\n\
--store DIR Store directory to use for 'build' (default: /frx/store).\n\
\n\
Source actions:\n\
materialize Materialize a declared FreeBSD source tree in /frx/store.\n\
\n\
@@ -274,6 +286,28 @@ Common options:\n\
((arg . tail)
(loop tail (cons arg positional) source-name store-dir cache-dir)))))
(define (parse-package-arguments action rest)
(let loop ((args rest)
(positional '())
(store-dir "/frx/store"))
(match args
(()
(let ((positional (reverse positional)))
`((command . "package")
(action . ,action)
(positional . ,positional)
(store-dir . ,store-dir))))
(("--help")
(usage 0))
(((? (lambda (arg) (string-prefix? "--store=" arg)) arg) . tail)
(loop tail positional (option-value arg "--store=")))
(("--store" value . tail)
(loop tail positional value))
(((? (lambda (arg) (string-prefix? "--" arg)) arg) . _)
(error "unknown option" arg))
((arg . tail)
(loop tail (cons arg positional) store-dir)))))
(define (parse-native-build-arguments action rest)
(let loop ((args rest)
(positional '())
@@ -306,12 +340,16 @@ Common options:\n\
(usage 0))
((_ "system" "--help")
(usage 0))
((_ "package" "--help")
(usage 0))
((_ "source" "--help")
(usage 0))
((_ "native-build" "--help")
(usage 0))
((_ "system" action . rest)
(parse-system-arguments action rest))
((_ "package" action . rest)
(parse-package-arguments action rest))
((_ "source" action . rest)
(parse-source-arguments action rest))
((_ "native-build" action . rest)
@@ -674,6 +712,48 @@ Common options:\n\
(headers_store . ,(assoc-ref result 'headers-store))
(bootloader_store . ,(assoc-ref result 'bootloader-store)))))
(define (package-summary-line package)
(string-append (freebsd-package-name package)
"\t"
(freebsd-package-version package)
"\t"
(symbol->string (freebsd-package-build-system package))
"\t"
(freebsd-package-synopsis package)))
(define (emit-package-show-metadata package)
(emit-metadata
`((action . "package-show")
(package_name . ,(freebsd-package-name package))
(package_version . ,(freebsd-package-version package))
(build_system . ,(freebsd-package-build-system package))
(input_count . ,(length (freebsd-package-inputs package)))
(inputs . ,(string-join (map freebsd-package-name
(freebsd-package-inputs package))
","))
(home_page . ,(freebsd-package-home-page package))
(synopsis . ,(freebsd-package-synopsis package))
(description . ,(freebsd-package-description package))
(license . ,(freebsd-package-license package))
(install_target_count . ,(length (freebsd-package-install-plan package)))
(install_targets
. ,(string-join (map (lambda (entry)
(match entry
((_ _ target) target)))
(freebsd-package-install-plan package))
",")))))
(define (emit-package-build-metadata store-dir package store-path)
(emit-metadata
`((action . "package-build")
(store_dir . ,store-dir)
(package_name . ,(freebsd-package-name package))
(package_version . ,(freebsd-package-version package))
(build_system . ,(freebsd-package-build-system package))
(store_path . ,store-path)
(references_file . ,(string-append store-path "/.references"))
(package_metadata_file . ,(string-append store-path "/.fruix-package")))))
(define (shell-quote text)
(string-append "'" (string-replace-all text "'" "'\"'\"'") "'"))
@@ -1072,6 +1152,43 @@ Common options:\n\
#:declaration-system-symbol resolved-symbol
#:root-size root-size
#:disk-capacity disk-capacity))))))))))))
((string=? command "package")
(let* ((positional (assoc-ref parsed 'positional))
(name-or-query (match positional
((value . _) value)
(() #f))))
(unless (member action '("list" "search" "show" "build"))
(error "unknown package action" action))
(cond
((string=? action "list")
(for-each (lambda (package)
(format #t "~a~%" (package-summary-line package)))
(all-freebsd-packages)))
((string=? action "search")
(unless name-or-query
(error "package search requires QUERY"))
(for-each (lambda (package)
(format #t "~a~%" (package-summary-line package)))
(search-freebsd-packages name-or-query)))
((string=? action "show")
(unless name-or-query
(error "package show requires NAME"))
(let ((package (find-freebsd-package name-or-query)))
(unless package
(error "unknown package" name-or-query))
(emit-package-show-metadata package)))
((string=? action "build")
(unless name-or-query
(error "package build requires NAME"))
(let ((package (find-freebsd-package name-or-query)))
(unless package
(error "unknown package" name-or-query))
(emit-package-build-metadata
store-dir package
(materialize-freebsd-package package
store-dir
(make-hash-table)
(make-hash-table))))))))
((string=? command "source")
(let* ((positional (assoc-ref parsed 'positional))
(cache-dir (assoc-ref parsed 'cache-dir))