From 13963e7f62438626977b790a110e5546e6244f03 Mon Sep 17 00:00:00 2001 From: Steffen Beyer Date: Wed, 1 Apr 2026 18:29:15 +0200 Subject: [PATCH] Define FreeBSD Fruix operating-system model --- docs/PROGRESS.md | 49 ++ .../phase7-operating-system-model-freebsd.md | 86 ++ modules/fruix/packages/freebsd.scm | 89 +- modules/fruix/system/freebsd.scm | 763 ++++++++++++++++++ .../phase7-minimal-operating-system.scm | 51 ++ .../run-phase7-operating-system-model.sh | 69 ++ .../validate-phase7-operating-system.scm | 53 ++ 7 files changed, 1159 insertions(+), 1 deletion(-) create mode 100644 docs/reports/phase7-operating-system-model-freebsd.md create mode 100644 modules/fruix/system/freebsd.scm create mode 100644 tests/system/phase7-minimal-operating-system.scm create mode 100755 tests/system/run-phase7-operating-system-model.sh create mode 100644 tests/system/validate-phase7-operating-system.scm diff --git a/docs/PROGRESS.md b/docs/PROGRESS.md index 6220766..065c54f 100644 --- a/docs/PROGRESS.md +++ b/docs/PROGRESS.md @@ -1867,3 +1867,52 @@ Next recommended step: 3. keep the two remaining Phase 6 follow-up blockers visible but scoped: - built-in downloader/root-daemon integration for real package origins - upstream-derived profile/bootstrap-platform support for `x86_64-freebsd15.0` + +## 2026-04-01 — Phase 7.1 completed: minimal Fruix operating-system model defined for FreeBSD + +Completed work: + +- added the first Fruix-owned FreeBSD system module: + - `modules/fruix/system/freebsd.scm` +- added the Phase 7.1 operating-system example and validation harnesses: + - `tests/system/phase7-minimal-operating-system.scm` + - `tests/system/validate-phase7-operating-system.scm` + - `tests/system/run-phase7-operating-system-model.sh` +- extended the FreeBSD package model with additional system-oriented prototype packages: + - `freebsd-bootloader` + - `freebsd-rc-scripts` + - `freebsd-runtime` + - `%freebsd-system-packages` +- wrote the Phase 7.1 report: + - `docs/reports/phase7-operating-system-model-freebsd.md` +- ran the operating-system model harness successfully and captured metadata under: + - `/tmp/phase7-os-model-metadata.txt` + +Important findings: + +- the FreeBSD track now has a concrete declarative operating-system object rather than only package/profile and service prototypes +- the model currently covers: + - host identity + - kernel and bootloader assets + - essential base packages + - users/groups + - file systems + - generated `/etc` payloads + - activation payload generation + - generated Shepherd configuration +- the selected first init strategy is now explicit in the model: + - `freebsd-init+rc.d-shepherd` +- observed metadata confirmed: + - `host_name=fruix-freebsd` + - `kernel_package=freebsd-kernel` + - `bootloader_package=freebsd-bootloader` + - `base_packages=freebsd-runtime,freebsd-userland,freebsd-libc,freebsd-rc-scripts,freebsd-bash` + - `users=root,operator` + - `groups=wheel,operator` + - `generated_files=boot/loader.conf,etc/rc.conf,etc/fstab,etc/hosts,etc/passwd,etc/group,etc/shells,etc/motd,activate,shepherd/init.scm` + - `init_mode=freebsd-init+rc.d-shepherd` + +Current assessment: + +- Phase 7.1 is now satisfied on the current FreeBSD prototype track +- the next step is to materialize this operating-system description into a reproducible system closure under `/frx/store` diff --git a/docs/reports/phase7-operating-system-model-freebsd.md b/docs/reports/phase7-operating-system-model-freebsd.md new file mode 100644 index 0000000..b1cefd5 --- /dev/null +++ b/docs/reports/phase7-operating-system-model-freebsd.md @@ -0,0 +1,86 @@ +# Phase 7.1: Minimal Fruix operating-system model for FreeBSD + +Date: 2026-04-01 + +## Summary + +This step introduces the first declarative Fruix operating-system model for the FreeBSD track. The goal is not full upstream Guix System integration yet, but a coherent Fruix-owned system description that can drive later closure and rootfs generation work. + +Added files: + +- `modules/fruix/system/freebsd.scm` +- `tests/system/phase7-minimal-operating-system.scm` +- `tests/system/validate-phase7-operating-system.scm` +- `tests/system/run-phase7-operating-system-model.sh` + +Updated file: + +- `modules/fruix/packages/freebsd.scm` + +## Validation command + +Run command: + +```sh +METADATA_OUT=/tmp/phase7-os-model-metadata.txt \ +./tests/system/run-phase7-operating-system-model.sh +``` + +## What the model describes + +The new module defines records and constructors for: + +- users +- groups +- file systems +- a FreeBSD-oriented operating-system object + +The minimal system description currently covers: + +- host identity +- kernel package +- bootloader package +- base packages +- users/groups +- file-system declarations +- generated `/etc` files +- a generated activation script +- a generated Shepherd configuration payload +- a declared init mode of: + - `freebsd-init+rc.d-shepherd` + +## Observed results + +Observed metadata included: + +- `host_name=fruix-freebsd` +- `kernel_package=freebsd-kernel` +- `bootloader_package=freebsd-bootloader` +- `base_packages=freebsd-runtime,freebsd-userland,freebsd-libc,freebsd-rc-scripts,freebsd-bash` +- `users=root,operator` +- `groups=wheel,operator` +- `file_system_count=3` +- `services=shepherd,ready-marker` +- `generated_files=boot/loader.conf,etc/rc.conf,etc/fstab,etc/hosts,etc/passwd,etc/group,etc/shells,etc/motd,activate,shepherd/init.scm` +- `init_mode=freebsd-init+rc.d-shepherd` +- `ready_marker=/var/lib/fruix/ready` + +## Important findings + +- the FreeBSD track now has a concrete declarative system object rather than only ad hoc package lists and shell prototypes +- the model is explicitly Fruix-owned and FreeBSD-oriented; it does not attempt a premature blanket rename or premature full Guix System integration +- the package layer was extended with additional system-oriented prototype packages needed by later Phase 7 work, including: + - `freebsd-bootloader` + - `freebsd-rc-scripts` + - `freebsd-runtime` + - `%freebsd-system-packages` +- the chosen first init strategy is now explicit in the model: + - FreeBSD init with declaratively generated `rc.d` launch of Shepherd + +## Conclusion + +Phase 7.1 is satisfied on the current FreeBSD prototype track: + +- a minimal Fruix operating-system model now exists for FreeBSD +- that model evaluates into a coherent system-closure specification +- the next step is to materialize that specification into a real system closure under `/frx/store` diff --git a/modules/fruix/packages/freebsd.scm b/modules/fruix/packages/freebsd.scm index 8b9ff9d..b5fe021 100644 --- a/modules/fruix/packages/freebsd.scm +++ b/modules/fruix/packages/freebsd.scm @@ -15,6 +15,9 @@ freebsd-kernel freebsd-kernel-headers freebsd-libc + freebsd-bootloader + freebsd-rc-scripts + freebsd-runtime freebsd-userland freebsd-clang-toolchain freebsd-gmake @@ -24,7 +27,8 @@ freebsd-sh freebsd-bash %freebsd-core-packages - %freebsd-development-profile-packages)) + %freebsd-development-profile-packages + %freebsd-system-packages)) (define-record-type (make-freebsd-package name version build-system inputs home-page synopsis @@ -91,8 +95,37 @@ and the userland C headers needed for development profiles." #:install-plan '((file "/lib/libc.so.7" "lib/libc.so.7") (file "/lib/libsys.so.7" "lib/libsys.so.7") + (file "/lib/libutil.so.10" "lib/libutil.so.10") + (file "/lib/libxo.so.0" "lib/libxo.so.0") + (file "/lib/libm.so.5" "lib/libm.so.5") + (file "/lib/lib80211.so.1" "lib/lib80211.so.1") + (file "/lib/libjail.so.1" "lib/libjail.so.1") + (file "/lib/libnv.so.1" "lib/libnv.so.1") + (file "/lib/libsbuf.so.6" "lib/libsbuf.so.6") + (file "/lib/libbsdxml.so.4" "lib/libbsdxml.so.4") + (file "/lib/libcrypt.so.5" "lib/libcrypt.so.5") + (file "/lib/libmd.so.7" "lib/libmd.so.7") (file "/libexec/ld-elf.so.1" "libexec/ld-elf.so.1")))) +(define freebsd-bootloader + (freebsd-package + #:name "freebsd-bootloader" + #:version freebsd-release + #:build-system 'copy-build-system + #:inputs (list freebsd-libc) + #:home-page "https://www.freebsd.org/" + #:synopsis "Prototype package for FreeBSD loader and boot assets" + #:description + "Prototype package definition that stages the FreeBSD boot loader and the +minimal loader support tree needed for declarative system-closure experiments." + #:license 'bsd-2 + #:install-plan + '((file "/boot/loader" "boot/loader") + (file "/boot/loader.efi" "boot/loader.efi") + (file "/boot/device.hints" "boot/device.hints") + (directory "/boot/defaults" "boot/defaults") + (directory "/boot/lua" "boot/lua")))) + (define freebsd-sh (freebsd-package #:name "freebsd-sh" @@ -134,6 +167,50 @@ userland commands needed for development and build experiments." (file "/usr/bin/tar" "bin/tar") (file "/usr/bin/xargs" "bin/xargs")))) +(define freebsd-rc-scripts + (freebsd-package + #:name "freebsd-rc-scripts" + #:version freebsd-release + #:build-system 'copy-build-system + #:inputs (list freebsd-sh) + #:home-page "https://www.freebsd.org/" + #:synopsis "Prototype package for FreeBSD init and rc script assets" + #:description + "Prototype package definition that stages the FreeBSD init and rc support +files needed by the first Fruix system-closure experiments." + #:license 'bsd-2 + #:install-plan + '((file "/etc/rc" "etc/rc") + (file "/etc/rc.subr" "etc/rc.subr") + (file "/etc/rc.shutdown" "etc/rc.shutdown") + (directory "/etc/rc.d" "etc/rc.d") + (directory "/etc/defaults" "etc/defaults")))) + +(define freebsd-runtime + (freebsd-package + #:name "freebsd-runtime" + #:version freebsd-release + #:build-system 'copy-build-system + #:inputs (list freebsd-libc freebsd-sh freebsd-userland freebsd-rc-scripts) + #:home-page "https://www.freebsd.org/" + #:synopsis "Prototype package for the minimal FreeBSD runtime" + #:description + "Prototype package definition that stages the minimal FreeBSD runtime +commands needed by the first declarative Fruix system and activation payload +experiments." + #:license 'bsd-2 + #:install-plan + '((file "/sbin/init" "sbin/init") + (file "/sbin/mount" "sbin/mount") + (file "/sbin/ifconfig" "sbin/ifconfig") + (file "/sbin/reboot" "sbin/reboot") + (file "/sbin/shutdown" "sbin/shutdown") + (file "/usr/sbin/service" "usr/sbin/service") + (file "/usr/sbin/pw" "usr/sbin/pw") + (file "/usr/bin/id" "usr/bin/id") + (file "/bin/hostname" "bin/hostname") + (file "/bin/kenv" "bin/kenv")))) + (define freebsd-clang-toolchain (freebsd-package #:name "freebsd-clang-toolchain" @@ -270,3 +347,13 @@ library for profile experiments." freebsd-zlib freebsd-sh freebsd-bash)) + +(define %freebsd-system-packages + (list freebsd-kernel + freebsd-bootloader + freebsd-libc + freebsd-rc-scripts + freebsd-runtime + freebsd-userland + freebsd-sh + freebsd-bash)) diff --git a/modules/fruix/system/freebsd.scm b/modules/fruix/system/freebsd.scm new file mode 100644 index 0000000..ac85853 --- /dev/null +++ b/modules/fruix/system/freebsd.scm @@ -0,0 +1,763 @@ +(define-module (fruix system freebsd) + #:use-module (fruix packages freebsd) + #:use-module (guix build utils) + #:use-module (ice-9 ftw) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 hash-table) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-13) + #:use-module (rnrs io ports) + #:export (user-group + user-group? + user-group-name + user-group-gid + user-group-system? + user-account + user-account? + user-account-name + user-account-uid + user-account-group + user-account-supplementary-groups + user-account-comment + user-account-home + user-account-shell + user-account-system? + file-system + file-system? + file-system-device + file-system-mount-point + file-system-type + file-system-options + file-system-needed-for-boot? + operating-system + operating-system? + operating-system-host-name + operating-system-kernel + operating-system-bootloader + operating-system-base-packages + operating-system-users + operating-system-groups + operating-system-file-systems + operating-system-services + operating-system-loader-entries + operating-system-rc-conf-entries + operating-system-ready-marker + validate-operating-system + operating-system-closure-spec + materialize-operating-system + materialize-rootfs + default-minimal-operating-system)) + +(define-record-type + (make-user-group name gid system?) + user-group? + (name user-group-name) + (gid user-group-gid) + (system? user-group-system?)) + +(define* (user-group #:key name gid (system? #t)) + (make-user-group name gid system?)) + +(define-record-type + (make-user-account name uid group supplementary-groups comment home shell system?) + user-account? + (name user-account-name) + (uid user-account-uid) + (group user-account-group) + (supplementary-groups user-account-supplementary-groups) + (comment user-account-comment) + (home user-account-home) + (shell user-account-shell) + (system? user-account-system?)) + +(define* (user-account #:key name uid group (supplementary-groups '()) + (comment "Fruix user") (home "/nonexistent") + (shell "/usr/sbin/nologin") (system? #t)) + (make-user-account name uid group supplementary-groups comment home shell system?)) + +(define-record-type + (make-file-system device mount-point type options needed-for-boot?) + file-system? + (device file-system-device) + (mount-point file-system-mount-point) + (type file-system-type) + (options file-system-options) + (needed-for-boot? file-system-needed-for-boot?)) + +(define* (file-system #:key device mount-point type (options "rw") + (needed-for-boot? #f)) + (make-file-system device mount-point type options needed-for-boot?)) + +(define-record-type + (make-operating-system host-name kernel bootloader base-packages users groups + file-systems services loader-entries rc-conf-entries + ready-marker) + operating-system? + (host-name operating-system-host-name) + (kernel operating-system-kernel) + (bootloader operating-system-bootloader) + (base-packages operating-system-base-packages) + (users operating-system-users) + (groups operating-system-groups) + (file-systems operating-system-file-systems) + (services operating-system-services) + (loader-entries operating-system-loader-entries) + (rc-conf-entries operating-system-rc-conf-entries) + (ready-marker operating-system-ready-marker)) + +(define* (operating-system #:key + (host-name "fruix-freebsd") + (kernel freebsd-kernel) + (bootloader freebsd-bootloader) + (base-packages %freebsd-system-packages) + (users (list (user-account #:name "root" + #:uid 0 + #:group "wheel" + #:comment "Charlie &" + #:home "/root" + #:shell "/bin/sh" + #:system? #t) + (user-account #:name "operator" + #:uid 1000 + #:group "operator" + #:supplementary-groups '("wheel") + #:comment "Fruix Operator" + #:home "/home/operator" + #:shell "/bin/sh" + #:system? #f))) + (groups (list (user-group #:name "wheel" #:gid 0 #:system? #t) + (user-group #:name "operator" #:gid 1000 #:system? #f))) + (file-systems (list (file-system #:device "/dev/ufs/fruix-root" + #:mount-point "/" + #:type "ufs" + #:options "rw" + #:needed-for-boot? #t) + (file-system #:device "devfs" + #:mount-point "/dev" + #:type "devfs" + #:options "rw" + #:needed-for-boot? #t) + (file-system #:device "tmpfs" + #:mount-point "/tmp" + #:type "tmpfs" + #:options "rw,size=64m" + #:needed-for-boot? #f))) + (services '(shepherd ready-marker)) + (loader-entries '(("autoboot_delay" . "1") + ("console" . "comconsole"))) + (rc-conf-entries '(("clear_tmp_enable" . "YES") + ("sendmail_enable" . "NONE") + ("sshd_enable" . "NO"))) + (ready-marker "/var/lib/fruix/ready")) + (make-operating-system host-name kernel bootloader base-packages users groups + file-systems services loader-entries rc-conf-entries + ready-marker)) + +(define default-minimal-operating-system (operating-system)) + +(define (getenv* name default) + (or (getenv name) default)) + +(define (trim-trailing-newlines str) + (let loop ((len (string-length str))) + (if (and (> len 0) + (char=? (string-ref str (- len 1)) #\newline)) + (loop (- len 1)) + (substring str 0 len)))) + +(define (command-output program . args) + (let* ((port (apply open-pipe* OPEN_READ program args)) + (output (get-string-all port)) + (status (close-pipe port))) + (unless (zero? status) + (error (format #f "command failed: ~a ~s => ~a" program args status))) + (trim-trailing-newlines output))) + +(define (write-file path content) + (mkdir-p (dirname path)) + (call-with-output-file path + (lambda (port) + (display content port)))) + +(define (string-hash text) + (let* ((tmp (string-append (getenv* "TMPDIR" "/tmp") "/fruix-system-hash.txt"))) + (write-file tmp text) + (command-output "sha256" "-q" tmp))) + +(define (file-hash path) + (command-output "sha256" "-q" path)) + +(define (directory-entries path) + (sort (filter (lambda (entry) + (not (member entry '("." "..")))) + (scandir path)) + stringstring (stat:type st))))))) + +(define (install-plan-signature entry) + (match entry + (('file source target) + (string-append "file-target:" target "\n" (path-signature source))) + (('directory source target) + (string-append "directory-target:" target "\n" (path-signature source))) + (_ + (error (format #f "unsupported install plan entry: ~s" entry))))) + +(define (package-manifest-string package input-paths) + (string-append + "name=" (freebsd-package-name package) "\n" + "version=" (freebsd-package-version package) "\n" + "build-system=" (symbol->string (freebsd-package-build-system package)) "\n" + "inputs=" (string-join input-paths ",") "\n" + "install-plan-signature=\n" + (string-join (map install-plan-signature + (freebsd-package-install-plan package)) + "\n"))) + +(define (copy-regular-file source destination) + (let ((mode (stat:perms (stat source)))) + (copy-file source destination) + (chmod destination mode))) + +(define (copy-node source destination) + (let ((kind (stat:type (lstat source)))) + (mkdir-p (dirname destination)) + (case kind + ((directory) + (mkdir-p destination) + (for-each (lambda (entry) + (copy-node (string-append source "/" entry) + (string-append destination "/" entry))) + (directory-entries source))) + ((symlink) + (symlink (readlink source) destination)) + (else + (copy-regular-file source destination))))) + +(define (materialize-plan-entry output-path entry) + (match entry + (('file source target) + (copy-node source (string-append output-path "/" target))) + (('directory source target) + (copy-node source (string-append output-path "/" target))) + (_ + (error (format #f "unsupported install plan entry: ~s" entry))))) + +(define (package-cache-key package) + (string-append (freebsd-package-name package) "-" (freebsd-package-version package))) + +(define (materialize-freebsd-package package store-dir cache) + (let ((cached (hash-ref cache (package-cache-key package) #f))) + (if cached + cached + (let* ((input-paths (map (lambda (input) + (materialize-freebsd-package input store-dir cache)) + (freebsd-package-inputs package))) + (manifest (package-manifest-string package input-paths)) + (hash (string-hash manifest)) + (output-path (string-append store-dir "/" hash "-" + (freebsd-package-name package) + "-" + (freebsd-package-version package)))) + (unless (file-exists? output-path) + (mkdir-p output-path) + (for-each (lambda (entry) + (materialize-plan-entry output-path entry)) + (freebsd-package-install-plan package)) + (write-file (string-append output-path "/.references") + (string-join input-paths "\n")) + (write-file (string-append output-path "/.fruix-package") manifest)) + (hash-set! cache (package-cache-key package) output-path) + output-path)))) + +(define (prefix-manifest-string source-path) + (string-append "prefix-source=" source-path "\n" (path-signature source-path))) + +(define (materialize-prefix source-path name version store-dir) + (let* ((manifest (prefix-manifest-string source-path)) + (hash (string-hash manifest)) + (output-path (string-append store-dir "/" hash "-" name "-" version))) + (unless (file-exists? output-path) + (mkdir-p output-path) + (for-each (lambda (entry) + (copy-node (string-append source-path "/" entry) + (string-append output-path "/" entry))) + (directory-entries source-path)) + (write-file (string-append output-path "/.fruix-package") manifest)) + output-path)) + +(define (package-names packages) + (map freebsd-package-name packages)) + +(define (duplicate-elements values) + (let loop ((rest values) (seen '()) (duplicates '())) + (match rest + (() (reverse duplicates)) + ((head . tail) + (if (member head seen) + (loop tail seen (if (member head duplicates) duplicates (cons head duplicates))) + (loop tail (cons head seen) duplicates)))))) + +(define (validate-operating-system os) + (let* ((host-name (operating-system-host-name os)) + (users (operating-system-users os)) + (groups (operating-system-groups os)) + (file-systems (operating-system-file-systems os)) + (user-names (map user-account-name users)) + (group-names (map user-group-name groups)) + (mount-points (map file-system-mount-point file-systems))) + (when (string-null? host-name) + (error "operating-system host-name must not be empty")) + (let ((dups (duplicate-elements user-names))) + (unless (null? dups) + (error "duplicate user names in operating-system" dups))) + (let ((dups (duplicate-elements group-names))) + (unless (null? dups) + (error "duplicate group names in operating-system" dups))) + (unless (member "/" mount-points) + (error "operating-system must declare a root file-system")) + (unless (member "root" user-names) + (error "operating-system must declare a root user")) + (unless (member "wheel" group-names) + (error "operating-system must declare a wheel group")) + #t)) + +(define (render-loader-conf loader-entries) + (string-append + (string-join (map (lambda (entry) + (format #f "~a=\"~a\"" (car entry) (cdr entry))) + loader-entries) + "\n") + "\n")) + +(define (render-rc.conf os) + (let* ((entries (append `(("hostname" . ,(operating-system-host-name os)) + ("fruix_shepherd_enable" . "YES")) + (operating-system-rc-conf-entries os)))) + (string-append + (string-join (map (lambda (entry) + (format #f "~a=\"~a\"" (car entry) (cdr entry))) + entries) + "\n") + "\n"))) + +(define (group-name->gid groups name) + (let ((group (find (lambda (item) + (string=? (user-group-name item) name)) + groups))) + (and group (user-group-gid group)))) + +(define (render-passwd os) + (let ((groups (operating-system-groups os))) + (string-append + (string-join + (map (lambda (account) + (format #f "~a:*:~a:~a:~a:~a:~a" + (user-account-name account) + (user-account-uid account) + (or (group-name->gid groups (user-account-group account)) + (error "unknown primary group" (user-account-group account))) + (user-account-comment account) + (user-account-home account) + (user-account-shell account))) + (operating-system-users os)) + "\n") + "\n"))) + +(define (render-group os) + (let ((users (operating-system-users os))) + (string-append + (string-join + (map (lambda (group) + (let ((members (filter-map (lambda (account) + (and (member (user-group-name group) + (user-account-supplementary-groups account)) + (user-account-name account))) + users))) + (format #f "~a:*:~a:~a" + (user-group-name group) + (user-group-gid group) + (string-join members ",")))) + (operating-system-groups os)) + "\n") + "\n"))) + +(define (render-fstab os) + (string-append + (string-join + (map (lambda (fs) + (format #f "~a\t~a\t~a\t~a\t~a\t~a" + (file-system-device fs) + (file-system-mount-point fs) + (file-system-type fs) + (file-system-options fs) + (if (string=? (file-system-mount-point fs) "/") 1 0) + (if (file-system-needed-for-boot? fs) 1 2))) + (operating-system-file-systems os)) + "\n") + "\n")) + +(define (render-hosts os) + (string-append + "127.0.0.1\tlocalhost " (operating-system-host-name os) "\n" + "::1\tlocalhost\n")) + +(define (render-shells os) + (let ((shells (delete-duplicates (map user-account-shell (operating-system-users os))))) + (string-append (string-join shells "\n") "\n"))) + +(define (render-motd os) + (string-append "Welcome to Fruix on FreeBSD (" (operating-system-host-name os) ")\n")) + +(define (render-activation-script os) + (let* ((users (operating-system-users os)) + (groups (operating-system-groups os)) + (non-root-groups (filter (lambda (group) + (> (user-group-gid group) 0)) + groups)) + (non-root-users (filter (lambda (account) + (> (user-account-uid account) 0)) + users))) + (string-append + "#!/bin/sh\n" + "set -eu\n" + "mkdir -p /var/lib/fruix /var/log /var/run /root /home /tmp\n" + "chmod 1777 /tmp\n" + (string-join + (append + (map (lambda (group) + (format #f "pw groupadd ~a -g ~a 2>/dev/null || true" + (user-group-name group) + (user-group-gid group))) + non-root-groups) + (map (lambda (account) + (let ((group (user-account-group account)) + (supplementary (user-account-supplementary-groups account))) + (format #f "pw useradd ~a -u ~a -g ~a~a -d ~a -m -s ~a -c '~a' 2>/dev/null || true" + (user-account-name account) + (user-account-uid account) + group + (if (null? supplementary) + "" + (string-append " -G " (string-join supplementary ","))) + (user-account-home account) + (user-account-shell account) + (user-account-comment account)))) + non-root-users)) + "\n") + "\n"))) + +(define (render-shepherd-config os) + (let ((ready-marker (operating-system-ready-marker os))) + (string-append + "(use-modules (shepherd service)\n" + " (ice-9 ftw))\n\n" + "(define ready-marker \"" ready-marker "\")\n\n" + "(define (ensure-parent-directory file)\n" + " (mkdir-p (dirname file)))\n\n" + "(register-services\n" + " (list\n" + " (service '(fruix-logger)\n" + " #:documentation \"Append a boot trace line for Fruix.\"\n" + " #:start (lambda _\n" + " (ensure-parent-directory \"/var/log/fruix-shepherd.log\")\n" + " (call-with-output-file \"/var/log/fruix-shepherd.log\"\n" + " (lambda (port)\n" + " (display \"fruix-shepherd-started\\n\" port))\n" + " #:append #t)\n" + " #t)\n" + " #:stop (lambda _ #f)\n" + " #:respawn? #f)\n" + " (service '(fruix-ready)\n" + " #:documentation \"Write the Fruix ready marker.\"\n" + " #:requirement '(fruix-logger)\n" + " #:start (lambda _\n" + " (ensure-parent-directory ready-marker)\n" + " (call-with-output-file ready-marker\n" + " (lambda (port) (display \"ready\" port)))\n" + " #t)\n" + " #:stop (lambda _ #f)\n" + " #:respawn? #f)))\n\n" + "(start-service (lookup-service 'fruix-ready))\n"))) + +(define (render-rc-script shepherd-store guile-store guile-extra-store) + (let ((ld-library-path (string-append guile-extra-store "/lib:" + guile-store "/lib:/usr/local/lib")) + (guile-load-path (string-append shepherd-store "/share/guile/site/3.0:" + guile-extra-store "/share/guile/site/3.0")) + (guile-load-compiled-path + (string-append shepherd-store "/lib/guile/3.0/site-ccache:" + guile-extra-store "/lib/guile/3.0/site-ccache")) + (guile-extensions-path (string-append guile-extra-store "/lib/guile/3.0/extensions"))) + (string-append + "#!/bin/sh\n" + "# PROVIDE: fruix_shepherd\n" + "# REQUIRE: FILESYSTEMS\n" + "# BEFORE: LOGIN\n" + "# KEYWORD: shutdown\n\n" + ". /etc/rc.subr\n\n" + "name=fruix_shepherd\n" + "rcvar=fruix_shepherd_enable\n" + ": ${fruix_shepherd_enable:=YES}\n" + "pidfile=/var/run/shepherd.pid\n" + "socket=/var/run/shepherd.sock\n" + "config=/run/current-system/shepherd/init.scm\n" + "logfile=/var/log/shepherd.log\n" + "command=" shepherd-store "/bin/shepherd\n" + "start_cmd=fruix_shepherd_start\n" + "stop_cmd=fruix_shepherd_stop\n" + "status_cmd=fruix_shepherd_status\n\n" + "fruix_shepherd_start()\n" + "{\n" + " env LD_LIBRARY_PATH='" ld-library-path "' \\\n" + " GUILE_LOAD_PATH='" guile-load-path "' \\\n" + " GUILE_LOAD_COMPILED_PATH='" guile-load-compiled-path "' \\\n" + " GUILE_EXTENSIONS_PATH='" guile-extensions-path "' \\\n" + " " shepherd-store "/bin/shepherd -I -s \"$socket\" -c \"$config\" --pid=\"$pidfile\" -l \"$logfile\" >/var/log/shepherd-bootstrap.out 2>&1 &\n" + " for _try in 1 2 3 4 5 6 7 8 9 10; do\n" + " [ -f \"$pidfile\" ] && [ -S \"$socket\" ] && return 0\n" + " sleep 1\n" + " done\n" + " return 1\n" + "}\n\n" + "fruix_shepherd_stop()\n" + "{\n" + " env LD_LIBRARY_PATH='" ld-library-path "' \\\n" + " GUILE_LOAD_PATH='" guile-load-path "' \\\n" + " GUILE_LOAD_COMPILED_PATH='" guile-load-compiled-path "' \\\n" + " GUILE_EXTENSIONS_PATH='" guile-extensions-path "' \\\n" + " " shepherd-store "/bin/herd -s \"$socket\" stop root >/dev/null 2>&1 || true\n" + " for _try in 1 2 3 4 5 6 7 8 9 10; do\n" + " [ ! -f \"$pidfile\" ] && return 0\n" + " sleep 1\n" + " done\n" + " kill \"$(cat \"$pidfile\")\" >/dev/null 2>&1 || true\n" + " rm -f \"$pidfile\"\n" + " return 0\n" + "}\n\n" + "fruix_shepherd_status()\n" + "{\n" + " [ -f \"$pidfile\" ] && kill -0 \"$(cat \"$pidfile\")\" >/dev/null 2>&1\n" + "}\n\n" + "load_rc_config $name\n" + "run_rc_command \"$1\"\n"))) + +(define (operating-system-generated-files os) + `(("boot/loader.conf" . ,(render-loader-conf (operating-system-loader-entries os))) + ("etc/rc.conf" . ,(render-rc.conf os)) + ("etc/fstab" . ,(render-fstab os)) + ("etc/hosts" . ,(render-hosts os)) + ("etc/passwd" . ,(render-passwd os)) + ("etc/group" . ,(render-group os)) + ("etc/shells" . ,(render-shells os)) + ("etc/motd" . ,(render-motd os)) + ("activate" . ,(render-activation-script os)) + ("shepherd/init.scm" . ,(render-shepherd-config os)))) + +(define (operating-system-closure-spec os) + (validate-operating-system os) + `((host-name . ,(operating-system-host-name os)) + (kernel-package . ,(freebsd-package-name (operating-system-kernel os))) + (bootloader-package . ,(freebsd-package-name (operating-system-bootloader os))) + (base-package-count . ,(length (operating-system-base-packages os))) + (base-packages . ,(package-names (operating-system-base-packages os))) + (user-count . ,(length (operating-system-users os))) + (users . ,(map user-account-name (operating-system-users os))) + (group-count . ,(length (operating-system-groups os))) + (groups . ,(map user-group-name (operating-system-groups os))) + (file-system-count . ,(length (operating-system-file-systems os))) + (file-systems . ,(map (lambda (fs) + `((device . ,(file-system-device fs)) + (mount-point . ,(file-system-mount-point fs)) + (type . ,(file-system-type fs)) + (options . ,(file-system-options fs)) + (needed-for-boot? . ,(file-system-needed-for-boot? fs)))) + (operating-system-file-systems os))) + (services . ,(operating-system-services os)) + (generated-files . ,(map car (operating-system-generated-files os))) + (init-mode . freebsd-init+rc.d-shepherd) + (ready-marker . ,(operating-system-ready-marker os)))) + +(define (same-file-contents? a b) + (zero? (system* "cmp" "-s" a b))) + +(define (merge-output-into-tree output-path tree-root) + (define (walk relative) + (let ((source (if (string-null? relative) + output-path + (string-append output-path "/" relative)))) + (for-each + (lambda (entry) + (unless (member entry '(".references" ".fruix-package")) + (let* ((entry-relative (if (string-null? relative) + entry + (string-append relative "/" entry))) + (source-entry (string-append output-path "/" entry-relative)) + (target-entry (string-append tree-root "/" entry-relative)) + (st (lstat source-entry))) + (if (eq? 'directory (stat:type st)) + (begin + (mkdir-p target-entry) + (walk entry-relative)) + (begin + (mkdir-p (dirname target-entry)) + (if (file-exists? target-entry) + (let ((existing (false-if-exception (readlink target-entry)))) + (unless (or (and existing + (string=? existing source-entry)) + (and existing + (file-exists? existing) + (same-file-contents? existing source-entry))) + (error (format #f "tree collision for ~a" target-entry)))) + (symlink source-entry target-entry))))))) + (directory-entries source)))) + (mkdir-p tree-root) + (walk "")) + +(define* (materialize-operating-system os + #:key + (store-dir "/frx/store") + (guile-prefix "/tmp/guile-freebsd-validate-install") + (guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install") + (shepherd-prefix "/tmp/shepherd-freebsd-validate-install")) + (validate-operating-system os) + (let* ((cache (make-hash-table)) + (kernel-store (materialize-freebsd-package (operating-system-kernel os) store-dir cache)) + (bootloader-store (materialize-freebsd-package (operating-system-bootloader os) store-dir cache)) + (base-package-stores (map (lambda (package) + (materialize-freebsd-package package store-dir cache)) + (operating-system-base-packages os))) + (guile-store (materialize-prefix guile-prefix "fruix-guile-runtime" "3.0" store-dir)) + (guile-extra-store (materialize-prefix guile-extra-prefix "fruix-guile-extra" "3.0" store-dir)) + (shepherd-store (materialize-prefix shepherd-prefix "fruix-shepherd-runtime" "1.0.9" store-dir)) + (generated-files (append (operating-system-generated-files os) + `(("usr/local/etc/rc.d/fruix-shepherd" + . ,(render-rc-script shepherd-store guile-store guile-extra-store))))) + (references (append (list kernel-store bootloader-store guile-store guile-extra-store shepherd-store) + base-package-stores)) + (manifest (string-append + "closure-spec=\n" + (object->string (operating-system-closure-spec os)) + "generated-files=\n" + (string-join (map (lambda (entry) + (string-append (car entry) "\n" (cdr entry))) + generated-files) + "\n") + "\nreferences=\n" + (string-join references "\n"))) + (hash (string-hash manifest)) + (closure-path (string-append store-dir "/" hash "-fruix-system-" + (operating-system-host-name os)))) + (unless (file-exists? closure-path) + (mkdir-p closure-path) + (mkdir-p (string-append closure-path "/boot/kernel")) + (symlink (string-append kernel-store "/boot/kernel/kernel") + (string-append closure-path "/boot/kernel/kernel")) + (symlink (string-append kernel-store "/boot/kernel/linker.hints") + (string-append closure-path "/boot/kernel/linker.hints")) + (for-each + (lambda (entry) + (let ((name (car entry))) + (symlink (string-append bootloader-store "/boot/" name) + (string-append closure-path "/boot/" name)))) + '(("loader") ("loader.efi") ("device.hints") ("defaults") ("lua"))) + (mkdir-p (string-append closure-path "/profile")) + (for-each (lambda (output) + (merge-output-into-tree output (string-append closure-path "/profile"))) + base-package-stores) + (for-each + (lambda (entry) + (write-file (string-append closure-path "/" (car entry)) (cdr entry))) + generated-files) + (chmod (string-append closure-path "/activate") #o555) + (chmod (string-append closure-path "/usr/local/etc/rc.d/fruix-shepherd") #o555) + (write-file (string-append closure-path "/parameters.scm") + (object->string (operating-system-closure-spec os))) + (write-file (string-append closure-path "/.references") + (string-join references "\n")) + (write-file (string-append closure-path "/.fruix-package") manifest)) + `((closure-path . ,closure-path) + (kernel-store . ,kernel-store) + (bootloader-store . ,bootloader-store) + (guile-store . ,guile-store) + (guile-extra-store . ,guile-extra-store) + (shepherd-store . ,shepherd-store) + (base-package-stores . ,base-package-stores) + (generated-files . ,(map car generated-files)) + (references . ,references)))) + +(define (symlink-force target link-name) + (when (or (file-exists? link-name) (false-if-exception (readlink link-name))) + (delete-file link-name)) + (mkdir-p (dirname link-name)) + (symlink target link-name)) + +(define* (materialize-rootfs os rootfs + #:key + (store-dir "/frx/store") + (guile-prefix "/tmp/guile-freebsd-validate-install") + (guile-extra-prefix "/tmp/guile-gnutls-freebsd-validate-install") + (shepherd-prefix "/tmp/shepherd-freebsd-validate-install")) + (let* ((closure (materialize-operating-system os + #:store-dir store-dir + #:guile-prefix guile-prefix + #:guile-extra-prefix guile-extra-prefix + #:shepherd-prefix shepherd-prefix)) + (closure-path (assoc-ref closure 'closure-path))) + (when (file-exists? rootfs) + (delete-file-recursively rootfs)) + (mkdir-p rootfs) + (for-each (lambda (dir) + (mkdir-p (string-append rootfs dir))) + '("/run" "/boot" "/etc" "/usr" "/usr/local" "/usr/local/etc" + "/usr/local/etc/rc.d" "/var" "/var/lib" "/var/lib/fruix" + "/var/log" "/var/run" "/tmp" "/dev" "/root" "/home")) + (chmod (string-append rootfs "/tmp") #o1777) + (symlink-force closure-path (string-append rootfs "/run/current-system")) + (symlink-force "/run/current-system/activate" (string-append rootfs "/activate")) + (for-each (lambda (dir) + (symlink-force (string-append "/run/current-system/profile/" dir) + (string-append rootfs "/" dir))) + '("bin" "sbin" "lib" "libexec")) + (for-each (lambda (dir) + (symlink-force (string-append "/run/current-system/profile/usr/" dir) + (string-append rootfs "/usr/" dir))) + '("bin" "sbin" "libexec")) + (for-each (lambda (path) + (symlink-force (string-append "/run/current-system/profile/etc/" path) + (string-append rootfs "/etc/" path))) + '("rc" "rc.subr" "rc.shutdown" "rc.d" "defaults")) + (for-each (lambda (path) + (symlink-force (string-append "/run/current-system/etc/" path) + (string-append rootfs "/etc/" path))) + '("rc.conf" "fstab" "hosts" "passwd" "group" "shells" "motd")) + (for-each (lambda (path) + (symlink-force (string-append "/run/current-system/boot/" path) + (string-append rootfs "/boot/" path))) + '("kernel" "loader" "loader.efi" "device.hints" "defaults" "lua" "loader.conf")) + (symlink-force "/run/current-system/usr/local/etc/rc.d/fruix-shepherd" + (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd")) + `((rootfs . ,rootfs) + (closure-path . ,closure-path) + (ready-marker . ,(operating-system-ready-marker os)) + (rc-script . ,(string-append closure-path "/usr/local/etc/rc.d/fruix-shepherd"))))) diff --git a/tests/system/phase7-minimal-operating-system.scm b/tests/system/phase7-minimal-operating-system.scm new file mode 100644 index 0000000..1260185 --- /dev/null +++ b/tests/system/phase7-minimal-operating-system.scm @@ -0,0 +1,51 @@ +(use-modules (fruix system freebsd) + (fruix packages freebsd)) + +(define phase7-operating-system + (operating-system + #:host-name "fruix-freebsd" + #:kernel freebsd-kernel + #:bootloader freebsd-bootloader + #:base-packages (list freebsd-runtime + freebsd-userland + freebsd-libc + freebsd-rc-scripts + freebsd-bash) + #:groups (list (user-group #:name "wheel" #:gid 0 #:system? #t) + (user-group #:name "operator" #:gid 1000 #:system? #f)) + #:users (list (user-account #:name "root" + #:uid 0 + #:group "wheel" + #:comment "Charlie &" + #:home "/root" + #:shell "/bin/sh" + #:system? #t) + (user-account #:name "operator" + #:uid 1000 + #:group "operator" + #:supplementary-groups '("wheel") + #:comment "Fruix Operator" + #:home "/home/operator" + #:shell "/bin/sh" + #:system? #f)) + #:file-systems (list (file-system #:device "/dev/ufs/fruix-root" + #:mount-point "/" + #:type "ufs" + #:options "rw" + #:needed-for-boot? #t) + (file-system #:device "devfs" + #:mount-point "/dev" + #:type "devfs" + #:options "rw" + #:needed-for-boot? #t) + (file-system #:device "tmpfs" + #:mount-point "/tmp" + #:type "tmpfs" + #:options "rw,size=64m")) + #:services '(shepherd ready-marker) + #:loader-entries '(("autoboot_delay" . "1") + ("console" . "comconsole")) + #:rc-conf-entries '(("clear_tmp_enable" . "YES") + ("sendmail_enable" . "NONE") + ("sshd_enable" . "NO")) + #:ready-marker "/var/lib/fruix/ready")) diff --git a/tests/system/run-phase7-operating-system-model.sh b/tests/system/run-phase7-operating-system-model.sh new file mode 100755 index 0000000..4bddbbf --- /dev/null +++ b/tests/system/run-phase7-operating-system-model.sh @@ -0,0 +1,69 @@ +#!/bin/sh +set -eu + +project_root=${PROJECT_ROOT:-$(pwd)} +guix_source_dir=${GUIX_SOURCE_DIR:-"$HOME/repos/guix"} +script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd) +runner_scm=$script_dir/validate-phase7-operating-system.scm +os_file=$script_dir/phase7-minimal-operating-system.scm + +if [ -n "${GUILE_BIN:-}" ]; then + guile_bin=$GUILE_BIN +elif [ -x /tmp/guile-freebsd-validate-install/bin/guile ]; then + guile_bin=/tmp/guile-freebsd-validate-install/bin/guile +else + cat >&2 <<'EOF' +A fixed local Guile build is required for this harness. +Set GUILE_BIN to a locally built fixed Guile, for example: + GUILE_BIN=/tmp/guile-freebsd-validate-install/bin/guile +EOF + exit 1 +fi + +if [ ! -x "$guile_bin" ]; then + echo "Guile binary is not executable: $guile_bin" >&2 + exit 1 +fi + +guile_prefix=$(CDPATH= cd -- "$(dirname "$guile_bin")/.." && pwd) +guile_lib_dir=$guile_prefix/lib +if [ -e "$guile_lib_dir/libguile-3.0.so.1" ]; then + if [ -n "${LD_LIBRARY_PATH:-}" ]; then + export LD_LIBRARY_PATH="$guile_lib_dir:$LD_LIBRARY_PATH" + else + export LD_LIBRARY_PATH="$guile_lib_dir" + fi +fi + +cleanup=0 +if [ -n "${WORKDIR:-}" ]; then + workdir=$WORKDIR + mkdir -p "$workdir" +else + workdir=$(mktemp -d /tmp/fruix-phase7-os-model.XXXXXX) + cleanup=1 +fi +if [ "${KEEP_WORKDIR:-0}" -eq 1 ]; then + cleanup=0 +fi + +cleanup_workdir() { + if [ "$cleanup" -eq 1 ]; then + rm -rf "$workdir" + fi +} +trap cleanup_workdir EXIT INT TERM + +export GUILE_AUTO_COMPILE=0 +export WORKDIR="$workdir" +export OS_FILE="$os_file" +if [ -n "${GUILE_LOAD_PATH:-}" ]; then + export GUILE_LOAD_PATH="$project_root/modules:$guix_source_dir:$GUILE_LOAD_PATH" +else + export GUILE_LOAD_PATH="$project_root/modules:$guix_source_dir" +fi + +printf 'Using Guile: %s\n' "$guile_bin" +printf 'Working directory: %s\n' "$workdir" + +"$guile_bin" -s "$runner_scm" diff --git a/tests/system/validate-phase7-operating-system.scm b/tests/system/validate-phase7-operating-system.scm new file mode 100644 index 0000000..dbadbfb --- /dev/null +++ b/tests/system/validate-phase7-operating-system.scm @@ -0,0 +1,53 @@ +(use-modules (fruix system freebsd) + (ice-9 format) + (ice-9 pretty-print) + (srfi srfi-1) + (srfi srfi-13) + (rnrs io ports)) + +(define workdir + (or (getenv "WORKDIR") + (error "WORKDIR environment variable is required"))) +(define os-file + (or (getenv "OS_FILE") + (error "OS_FILE environment variable is required"))) +(define metadata-file + (string-append workdir "/phase7-operating-system-metadata.txt")) + +(primitive-load os-file) +(validate-operating-system phase7-operating-system) + +(let* ((spec (operating-system-closure-spec phase7-operating-system)) + (generated-files (assoc-ref spec 'generated-files)) + (base-packages (assoc-ref spec 'base-packages))) + (call-with-output-file metadata-file + (lambda (port) + (format port "host_name=~a~%" (assoc-ref spec 'host-name)) + (format port "kernel_package=~a~%" (assoc-ref spec 'kernel-package)) + (format port "bootloader_package=~a~%" (assoc-ref spec 'bootloader-package)) + (format port "base_package_count=~a~%" (assoc-ref spec 'base-package-count)) + (format port "base_packages=~a~%" (string-join base-packages ",")) + (format port "user_count=~a~%" (assoc-ref spec 'user-count)) + (format port "users=~a~%" (string-join (assoc-ref spec 'users) ",")) + (format port "group_count=~a~%" (assoc-ref spec 'group-count)) + (format port "groups=~a~%" (string-join (assoc-ref spec 'groups) ",")) + (format port "file_system_count=~a~%" (assoc-ref spec 'file-system-count)) + (format port "services=~a~%" (string-join (map symbol->string (assoc-ref spec 'services)) ",")) + (format port "generated_files=~a~%" (string-join generated-files ",")) + (format port "init_mode=~a~%" (assoc-ref spec 'init-mode)) + (format port "ready_marker=~a~%" (assoc-ref spec 'ready-marker)) + (format port "spec_pretty=~a~%" + (string-map (lambda (ch) (if (char=? ch #\newline) #\space ch)) + (with-output-to-string + (lambda () + (pretty-print spec))))))) + + (when (getenv "METADATA_OUT") + (copy-file metadata-file (getenv "METADATA_OUT"))) + + (format #t "PASS phase7-operating-system-model~%") + (format #t "Metadata file: ~a~%" metadata-file) + (when (getenv "METADATA_OUT") + (format #t "Copied metadata to: ~a~%" (getenv "METADATA_OUT"))) + (display "--- metadata ---\n") + (display (call-with-input-file metadata-file get-string-all)))