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
modules/fruix/packages/freebsd.scm
+42
View File
@@ -58,6 +58,10 @@
freebsd-ripgrep
freebsd-tmux
freebsd-neovim
%freebsd-all-packages
all-freebsd-packages
find-freebsd-package
search-freebsd-packages
freebsd-native-kernel
freebsd-native-world
freebsd-native-runtime
@@ -978,3 +982,41 @@ FreeBSD base input."
(define %freebsd-core-packages %freebsd-host-staged-core-packages)
(define %freebsd-development-profile-packages %freebsd-host-staged-development-profile-packages)
(define %freebsd-system-packages %freebsd-host-staged-system-packages)
(define (freebsd-package-name<? left right)
(let ((left-name (freebsd-package-name left))
(right-name (freebsd-package-name right)))
(if (string=? left-name right-name)
(string<? (freebsd-package-version left)
(freebsd-package-version right))
(string<? left-name right-name))))
(define %freebsd-all-packages
(sort (delete-duplicates
(append %freebsd-host-staged-all-packages
%freebsd-native-system-packages
%freebsd-native-development-profile-packages)
(lambda (left right)
(string=? (freebsd-package-name left)
(freebsd-package-name right))))
freebsd-package-name<?))
(define (all-freebsd-packages)
%freebsd-all-packages)
(define (find-freebsd-package name)
(find (lambda (package)
(string=? (freebsd-package-name package) name))
%freebsd-all-packages))
(define (search-freebsd-packages query)
(let ((needle (string-downcase query)))
(filter (lambda (package)
(or (string-null? needle)
(string-contains (string-downcase (freebsd-package-name package))
needle)
(string-contains (string-downcase (freebsd-package-synopsis package))
needle)
(string-contains (string-downcase (freebsd-package-description package))
needle)))
%freebsd-all-packages)))
modules/fruix/system/freebsd/render.scm
+13
View File
@@ -593,6 +593,10 @@
" fruix system reconfigure [DECLARATION [--system NAME] ...]\n"
" fruix system switch /frx/store/...-fruix-system-...\n"
" fruix system rollback\n"
" fruix package list\n"
" fruix package search QUERY\n"
" fruix package show NAME\n"
" fruix package build NAME [--store DIR]\n"
"EOF\n"
"}\n\n"
"die()\n"
@@ -701,6 +705,10 @@
" run_node_cli system build \"$@\"\n"
" fi\n"
"}\n\n"
"package_command()\n"
"{\n"
" run_node_cli package \"$@\"\n"
"}\n\n"
"deploy_system()\n"
"{\n"
" [ $# -ge 1 ] || die \"deploy requires TARGET and a declaration file or closure path\"\n"
@@ -1054,6 +1062,11 @@
" ;;\n"
" esac\n"
" ;;\n"
" package)\n"
" [ $# -ge 2 ] || { usage >&2; exit 1; }\n"
" shift 1\n"
" package_command \"$@\"\n"
" ;;\n"
" --help|-h|'')\n"
" usage\n"
" ;;\n"
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))
tests/package-cli.scm
+102
View File
@@ -0,0 +1,102 @@
(use-modules (ice-9 match)
(srfi srfi-1)
(srfi srfi-13)
(srfi srfi-64)
(fruix packages freebsd)
(fruix system freebsd utils))
(define repo-root
(or (getenv "FRUIX_REPO_ROOT")
(error "FRUIX_REPO_ROOT is not set")))
(define guile-bin
(or (getenv "GUILE_BIN")
(error "GUILE_BIN is not set")))
(define fruix-script
(string-append repo-root "/scripts/fruix.scm"))
(define (cli-output . args)
(apply command-output guile-bin
(append '("--no-auto-compile" "-s")
(list fruix-script)
args)))
(define (output-lines text)
(filter (lambda (line) (not (string-null? line)))
(string-split text #\newline)))
(define (summary-line-name line)
(car (string-split line #\tab)))
(define (metadata-value text key)
(let ((prefix (string-append key "=")))
(let loop ((lines (output-lines text)))
(match lines
(() #f)
((line . rest)
(if (string-prefix? prefix line)
(substring line (string-length prefix))
(loop rest)))))))
(test-begin "package-cli")
(test-assert "find-freebsd-package locates nodejs"
(let ((package (find-freebsd-package "freebsd-nodejs")))
(and package
(string=? (freebsd-package-version package) "24.14.0_2"))))
(test-assert "search-freebsd-packages finds nodejs by name"
(member "freebsd-nodejs"
(map freebsd-package-name
(search-freebsd-packages "node"))))
(test-assert "search-freebsd-packages finds npm by text"
(member "freebsd-npm"
(map freebsd-package-name
(search-freebsd-packages "node"))))
(let ((list-output (cli-output "package" "list")))
(test-assert "package list prints nodejs"
(member "freebsd-nodejs"
(map summary-line-name (output-lines list-output))))
(test-assert "package list prints neovim"
(member "freebsd-neovim"
(map summary-line-name (output-lines list-output)))))
(let ((search-output (cli-output "package" "search" "node")))
(test-assert "package search prints nodejs"
(member "freebsd-nodejs"
(map summary-line-name (output-lines search-output))))
(test-assert "package search prints npm"
(member "freebsd-npm"
(map summary-line-name (output-lines search-output)))))
(let ((show-output (cli-output "package" "show" "freebsd-nodejs")))
(test-equal "package show reports name"
"freebsd-nodejs"
(metadata-value show-output "package_name"))
(test-equal "package show reports version"
"24.14.0_2"
(metadata-value show-output "package_version"))
(test-equal "package show reports build system"
"copy-build-system"
(metadata-value show-output "build_system"))
(test-assert "package show reports node binary target"
(string-contains (metadata-value show-output "install_targets") "bin/node")))
(let* ((store-dir (mktemp-directory "/tmp/fruix-package-cli-store.XXXXXX"))
(build-output (cli-output "package" "build" "freebsd-ripgrep" "--store" store-dir))
(store-path (metadata-value build-output "store_path")))
(test-equal "package build reports action"
"package-build"
(metadata-value build-output "action"))
(test-equal "package build reports package name"
"freebsd-ripgrep"
(metadata-value build-output "package_name"))
(test-assert "package build creates store path"
(file-exists? store-path))
(test-assert "package build stages rg binary"
(file-exists? (string-append store-path "/bin/rg"))))
(test-end "package-cli")
tests/run-package-cli.sh
Executable
+17
View File
@@ -0,0 +1,17 @@
#!/bin/sh
set -eu
repo_root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd)
. "$HOME/.local/opt/fruix-builder/env.sh"
guile_version=$($GUILE_BIN -c '(display (effective-version))')
guile_load_path="$repo_root/modules:$GUIX_SOURCE_DIR:$HOME/.local/opt/fruix-builder/shepherd/share/guile/site/$guile_version${GUILE_LOAD_PATH:+:$GUILE_LOAD_PATH}"
guile_load_compiled_path="$HOME/.local/opt/fruix-builder/shepherd/lib/guile/$guile_version/site-ccache${GUILE_LOAD_COMPILED_PATH:+:$GUILE_LOAD_COMPILED_PATH}"
env \
FRUIX_REPO_ROOT="$repo_root" \
GUILE_BIN="$GUILE_BIN" \
GUILE_AUTO_COMPILE=0 \
GUILE_LOAD_PATH="$guile_load_path" \
GUILE_LOAD_COMPILED_PATH="$guile_load_compiled_path" \
"$GUILE_BIN" --no-auto-compile "$repo_root/tests/package-cli.scm"