Define FreeBSD Fruix operating-system model

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`

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`

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 <freebsd-package>
   (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))

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 <user-group>
+  (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 <user-account>
+  (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 <file-system>
+  (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 <operating-system>
+  (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))
+        string<?))
+
+(define (path-signature path)
+  (let ((st (lstat path)))
+    (case (stat:type st)
+      ((regular)
+       (string-append "file:" path ":" (file-hash path)))
+      ((symlink)
+       (string-append "symlink:" path ":" (readlink path)))
+      ((directory)
+       (string-join
+        (cons (string-append "directory:" path)
+              (apply append
+                     (map (lambda (entry)
+                            (list (path-signature (string-append path "/" entry))))
+                          (directory-entries path))))
+        "\n"))
+      (else
+       (string-append "other:" path ":" (symbol->string (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")))))

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"))

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"

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)))