diff --git a/examples/system/dev-tools.scm b/examples/system/dev-tools.scm new file mode 100644 index 0000000..2170034 --- /dev/null +++ b/examples/system/dev-tools.scm @@ -0,0 +1,18 @@ +;; Example Fruix development system declaration. +;; +;; You can use this as a starting point for /etc/fruix/system.scm and then run: +;; fruix system build /etc/fruix/system.scm --system dev-tools-operating-system +;; or on an installed Fruix node: +;; fruix system reconfigure /etc/fruix/system.scm --system dev-tools-operating-system + +(use-modules (fruix system freebsd) + (fruix packages freebsd)) + +(define dev-tools-operating-system + (operating-system + #:host-name "fruix-dev" + ;; The recovered development profile now includes: + ;; freebsd-nodejs, freebsd-npm, freebsd-ripgrep, freebsd-tmux, freebsd-neovim + ;; along with the existing compiler/build tools. + #:development-packages %freebsd-development-profile-packages + #:build-packages %freebsd-development-profile-packages)) diff --git a/modules/fruix/system/freebsd/render.scm b/modules/fruix/system/freebsd/render.scm index ace0c48..37c86b9 100644 --- a/modules/fruix/system/freebsd/render.scm +++ b/modules/fruix/system/freebsd/render.scm @@ -597,6 +597,9 @@ " fruix package search QUERY\n" " fruix package show NAME\n" " fruix package build NAME [--store DIR]\n" + " fruix package installed [--profile DIR]\n" + " fruix package install NAME... [--profile DIR] [--store DIR]\n" + " fruix package remove NAME... [--profile DIR] [--store DIR]\n" "EOF\n" "}\n\n" "die()\n" diff --git a/scripts/fruix.scm b/scripts/fruix.scm index bd91aa3..0287e15 100644 --- a/scripts/fruix.scm +++ b/scripts/fruix.scm @@ -7,6 +7,7 @@ (fruix system storage) (fruix system freebsd utils) (fruix packages freebsd) + (guix build utils) (ice-9 format) (ice-9 match) (ice-9 hash-table) @@ -55,9 +56,13 @@ Package actions:\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\ + installed List packages installed in a Fruix package profile.\n\ + install NAME... Add packages to a Fruix package profile.\n\ + remove NAME... Remove packages from a Fruix package profile.\n\ \n\ Package options:\n\ - --store DIR Store directory to use for 'build' (default: /frx/store).\n\ + --store DIR Store directory to use for 'build' or profile updates (default: /frx/store).\n\ + --profile DIR Package profile state directory (default: $HOME/.local/state/fruix/profiles/default).\n\ \n\ Source actions:\n\ materialize Materialize a declared FreeBSD source tree in /frx/store.\n\ @@ -289,24 +294,30 @@ Common options:\n\ (define (parse-package-arguments action rest) (let loop ((args rest) (positional '()) - (store-dir "/frx/store")) + (store-dir "/frx/store") + (profile-dir #f)) (match args (() (let ((positional (reverse positional))) `((command . "package") (action . ,action) (positional . ,positional) - (store-dir . ,store-dir)))) + (store-dir . ,store-dir) + (profile-dir . ,profile-dir)))) (("--help") (usage 0)) (((? (lambda (arg) (string-prefix? "--store=" arg)) arg) . tail) - (loop tail positional (option-value arg "--store="))) + (loop tail positional (option-value arg "--store=") profile-dir)) (("--store" value . tail) - (loop tail positional value)) + (loop tail positional value profile-dir)) + (((? (lambda (arg) (string-prefix? "--profile=" arg)) arg) . tail) + (loop tail positional store-dir (option-value arg "--profile="))) + (("--profile" value . tail) + (loop tail positional store-dir value)) (((? (lambda (arg) (string-prefix? "--" arg)) arg) . _) (error "unknown option" arg)) ((arg . tail) - (loop tail (cons arg positional) store-dir))))) + (loop tail (cons arg positional) store-dir profile-dir))))) (define (parse-native-build-arguments action rest) (let loop ((args rest) @@ -754,6 +765,179 @@ Common options:\n\ (references_file . ,(string-append store-path "/.references")) (package_metadata_file . ,(string-append store-path "/.fruix-package"))))) +(define profile-manifest-version "1") + +(define (default-package-profile-dir) + (let ((home (or (getenv "HOME") "."))) + (string-append home "/.local/state/fruix/profiles/default"))) + +(define (package-profile-manifest-path profile-dir) + (string-append profile-dir "/manifest.scm")) + +(define (package-profile-generation-file profile-dir) + (string-append profile-dir "/current-generation")) + +(define (package-profile-current-link profile-dir) + (string-append profile-dir "/current")) + +(define (package-profile-generate-link profile-dir generation) + (string-append profile-dir "/generations/" (number->string generation))) + +(define (path-directory path) + (let ((index (string-index-right path #\/))) + (if index + (substring path 0 index) + "."))) + +(define (path-present? path) + (or (file-exists? path) + (false-if-exception (readlink path)))) + +(define (symlink-force target link-name) + (mkdir-p (path-directory link-name)) + (delete-path-if-exists link-name) + (symlink target link-name)) + +(define (merge-node source destination) + (let ((kind (stat:type (lstat source)))) + (case kind + ((directory) + (mkdir-p destination) + (for-each (lambda (entry) + (merge-node (string-append source "/" entry) + (string-append destination "/" entry))) + (directory-entries source))) + ((symlink) + (unless (path-present? destination) + (mkdir-p (path-directory destination)) + (symlink (readlink source) destination))) + (else + (unless (file-exists? destination) + (copy-node source destination)))))) + +(define (merge-package-output source-root target-root) + (mkdir-p target-root) + (for-each (lambda (entry) + (unless (string-prefix? "." entry) + (merge-node (string-append source-root "/" entry) + (string-append target-root "/" entry)))) + (directory-entries source-root))) + +(define (package-profile-activate-script) + (string-append + "#!/bin/sh\n" + "set -eu\n" + "profile=$(CDPATH= cd -- \"$(dirname \"$0\")\" && pwd)\n" + "cat <string `((profile-version . ,profile-manifest-version) + (packages . ,normalized) + (package-stores . ,package-stores)))) + (profile-store (make-store-path store-dir "fruix-package-profile" payload + #:kind 'profile))) + (unless (file-exists? profile-store) + (mkdir-p profile-store) + (for-each (lambda (store) + (merge-package-output store profile-store)) + package-stores) + (write-file (string-append profile-store "/.references") + (string-join package-stores "\n")) + (write-file (string-append profile-store "/.fruix-profile.scm") + (object->string `((version . ,profile-manifest-version) + (packages . ,normalized) + (package-stores . ,package-stores)))) + (write-file (string-append profile-store "/activate") + (package-profile-activate-script)) + (chmod (string-append profile-store "/activate") #o555)) + `((profile-store . ,profile-store) + (package-stores . ,package-stores) + (packages . ,normalized)))) + +(define (next-package-profile-generation profile-dir) + (let ((path (package-profile-generation-file profile-dir))) + (if (file-exists? path) + (+ 1 (string->number (call-with-input-file path get-string-all))) + 1))) + +(define (update-package-profile profile-dir store-dir package-names) + (let* ((materialized (materialize-package-profile package-names store-dir)) + (normalized (assoc-ref materialized 'packages)) + (profile-store (assoc-ref materialized 'profile-store)) + (generation (next-package-profile-generation profile-dir)) + (generation-link (package-profile-generate-link profile-dir generation)) + (current-link (package-profile-current-link profile-dir)) + (activate-link (string-append profile-dir "/activate")) + (manifest-path (package-profile-manifest-path profile-dir))) + (mkdir-p (string-append profile-dir "/generations")) + (symlink-force profile-store generation-link) + (symlink-force (string-append "generations/" (number->string generation)) + current-link) + (symlink-force "current/activate" activate-link) + (write-file (package-profile-generation-file profile-dir) + (number->string generation)) + (write-file manifest-path + (object->string `((version . ,profile-manifest-version) + (generation . ,generation) + (profile-store . ,profile-store) + (packages . ,normalized)))) + `((profile-dir . ,profile-dir) + (generation . ,generation) + (profile-store . ,profile-store) + (current-link . ,current-link) + (activate-link . ,activate-link) + (manifest-path . ,manifest-path) + (packages . ,normalized) + (package-count . ,(length normalized))))) + +(define (emit-package-profile-metadata action store-dir result) + (emit-metadata + `((action . ,action) + (store_dir . ,store-dir) + (profile_dir . ,(assoc-ref result 'profile-dir)) + (generation . ,(assoc-ref result 'generation)) + (profile_store . ,(assoc-ref result 'profile-store)) + (current_link . ,(assoc-ref result 'current-link)) + (activate_link . ,(assoc-ref result 'activate-link)) + (manifest_path . ,(assoc-ref result 'manifest-path)) + (package_count . ,(assoc-ref result 'package-count)) + (packages . ,(string-join (assoc-ref result 'packages) ","))))) + (define (shell-quote text) (string-append "'" (string-replace-all text "'" "'\"'\"'") "'")) @@ -1154,10 +1338,12 @@ Common options:\n\ #:disk-capacity disk-capacity)))))))))))) ((string=? command "package") (let* ((positional (assoc-ref parsed 'positional)) + (profile-dir (or (assoc-ref parsed 'profile-dir) + (default-package-profile-dir))) (name-or-query (match positional ((value . _) value) (() #f)))) - (unless (member action '("list" "search" "show" "build")) + (unless (member action '("list" "search" "show" "build" "installed" "install" "remove")) (error "unknown package action" action)) (cond ((string=? action "list") @@ -1188,7 +1374,36 @@ Common options:\n\ (materialize-freebsd-package package store-dir (make-hash-table) - (make-hash-table)))))))) + (make-hash-table))))) + ((string=? action "installed") + (for-each (lambda (name) + (let ((package (find-freebsd-package name))) + (if package + (format #t "~a~%" (package-summary-line package)) + (format #t "~a\tunknown\tunknown\tUnknown package recorded in profile\n" name)))) + (package-profile-package-names profile-dir))) + ((string=? action "install") + (unless (pair? positional) + (error "package install requires at least one package name")) + (emit-package-profile-metadata + "package-install" + store-dir + (update-package-profile profile-dir + store-dir + (append (package-profile-package-names profile-dir) + positional)))) + ((string=? action "remove") + (unless (pair? positional) + (error "package remove requires at least one package name")) + (let ((removals (normalize-package-names positional))) + (emit-package-profile-metadata + "package-remove" + store-dir + (update-package-profile profile-dir + store-dir + (filter (lambda (name) + (not (member name removals))) + (package-profile-package-names profile-dir))))))))) ((string=? command "source") (let* ((positional (assoc-ref parsed 'positional)) (cache-dir (assoc-ref parsed 'cache-dir)) diff --git a/tests/package-profile.scm b/tests/package-profile.scm new file mode 100644 index 0000000..a7dd51c --- /dev/null +++ b/tests/package-profile.scm @@ -0,0 +1,147 @@ +(use-modules (ice-9 match) + (srfi srfi-1) + (srfi srfi-13) + (srfi srfi-64) + (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))))))) + +(define (path-present? path) + (or (file-exists? path) + (false-if-exception (readlink path)))) + +(test-begin "package-profile") + +(let* ((store-dir (mktemp-directory "/tmp/fruix-package-profile-store.XXXXXX")) + (profile-dir (mktemp-directory "/tmp/fruix-package-profile-state.XXXXXX")) + (install-output + (cli-output "package" "install" + "freebsd-nodejs" "freebsd-npm" + "--store" store-dir + "--profile" profile-dir)) + (installed-output-1 + (cli-output "package" "installed" + "--profile" profile-dir)) + (install-output-2 + (cli-output "package" "install" + "freebsd-ripgrep" "freebsd-tmux" + "--store" store-dir + "--profile" profile-dir)) + (remove-output + (cli-output "package" "remove" + "freebsd-npm" "freebsd-tmux" + "--store" store-dir + "--profile" profile-dir)) + (installed-output-2 + (cli-output "package" "installed" + "--profile" profile-dir)) + (current-link (string-append profile-dir "/current")) + (activate-link (string-append profile-dir "/activate")) + (manifest-path (string-append profile-dir "/manifest.scm")) + (first-profile-store (metadata-value install-output "profile_store")) + (second-profile-store (metadata-value install-output-2 "profile_store")) + (third-profile-store (metadata-value remove-output "profile_store"))) + (test-equal "package install reports action" + "package-install" + (metadata-value install-output "action")) + (test-equal "first profile generation is 1" + "1" + (metadata-value install-output "generation")) + (test-assert "profile current link exists" + (false-if-exception (readlink current-link))) + (test-assert "profile activate link exists" + (false-if-exception (readlink activate-link))) + (test-assert "profile manifest exists" + (file-exists? manifest-path)) + (test-assert "node is present in the first profile store" + (path-present? (string-append first-profile-store "/bin/node"))) + (test-assert "npm is present in the first profile store" + (path-present? (string-append first-profile-store "/bin/npm"))) + (test-assert "activate script exists in the first profile store" + (path-present? (string-append first-profile-store "/activate"))) + (test-assert "installed lists nodejs after first install" + (member "freebsd-nodejs" + (map summary-line-name (output-lines installed-output-1)))) + (test-assert "installed lists npm after first install" + (member "freebsd-npm" + (map summary-line-name (output-lines installed-output-1)))) + (test-equal "activate script exposes node" + "v24.14.0" + (command-output "sh" "-eu" "-c" + "eval \"$($0)\"; node --version" + activate-link)) + + (test-equal "second profile generation is 2" + "2" + (metadata-value install-output-2 "generation")) + (test-assert "ripgrep is present after second install" + (path-present? (string-append second-profile-store "/bin/rg"))) + (test-assert "tmux is present after second install" + (path-present? (string-append second-profile-store "/bin/tmux"))) + (test-equal "activate script exposes ripgrep after second install" + "ripgrep 15.1.0" + (car (output-lines + (command-output "sh" "-eu" "-c" + "eval \"$($0)\"; rg --version | head -1" + activate-link)))) + + (test-equal "package remove reports action" + "package-remove" + (metadata-value remove-output "action")) + (test-equal "third profile generation is 3" + "3" + (metadata-value remove-output "generation")) + (test-assert "node remains after remove" + (path-present? (string-append third-profile-store "/bin/node"))) + (test-assert "ripgrep remains after remove" + (path-present? (string-append third-profile-store "/bin/rg"))) + (test-assert "npm is removed from the current profile" + (not (path-present? (string-append third-profile-store "/bin/npm")))) + (test-assert "tmux is removed from the current profile" + (not (path-present? (string-append third-profile-store "/bin/tmux")))) + (test-assert "installed still lists nodejs" + (member "freebsd-nodejs" + (map summary-line-name (output-lines installed-output-2)))) + (test-assert "installed still lists ripgrep" + (member "freebsd-ripgrep" + (map summary-line-name (output-lines installed-output-2)))) + (test-assert "installed no longer lists npm" + (not (member "freebsd-npm" + (map summary-line-name (output-lines installed-output-2))))) + (test-assert "installed no longer lists tmux" + (not (member "freebsd-tmux" + (map summary-line-name (output-lines installed-output-2)))))) + +(test-end "package-profile") diff --git a/tests/run-package-profile.sh b/tests/run-package-profile.sh new file mode 100755 index 0000000..98a565f --- /dev/null +++ b/tests/run-package-profile.sh @@ -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-profile.scm"