Files
fruix/tests/system/materialize-phase7-rootfs.scm

140 lines
7.4 KiB
Scheme

(use-modules (fruix system freebsd)
(ice-9 format)
(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 store-dir
(or (getenv "STORE_DIR")
"/frx/store"))
(define guile-prefix
(or (getenv "GUILE_PREFIX")
"/tmp/guile-freebsd-validate-install"))
(define guile-extra-prefix
(or (getenv "GUILE_EXTRA_PREFIX")
"/tmp/guile-gnutls-freebsd-validate-install"))
(define shepherd-prefix
(or (getenv "SHEPHERD_PREFIX")
"/tmp/shepherd-freebsd-validate-install"))
(define metadata-file
(string-append workdir "/phase7-rootfs-metadata.txt"))
(define rootfs
(string-append workdir "/rootfs"))
(primitive-load os-file)
(validate-operating-system phase7-operating-system)
(define (assert-exists path)
(unless (or (file-exists? path)
(false-if-exception (readlink path)))
(error "required path missing" path)))
(define (assert-symlink-target path expected)
(let ((actual (readlink path)))
(unless (string=? actual expected)
(error "unexpected symlink target" path actual expected))
actual))
(let* ((result (materialize-rootfs phase7-operating-system rootfs
#:store-dir store-dir
#:guile-prefix guile-prefix
#:guile-extra-prefix guile-extra-prefix
#:shepherd-prefix shepherd-prefix))
(closure-path (assoc-ref result 'closure-path))
(ready-marker (assoc-ref result 'ready-marker))
(rc-script (assoc-ref result 'rc-script))
(run-current-system-target (assert-symlink-target (string-append rootfs "/run/current-system")
closure-path))
(activate-target (assert-symlink-target (string-append rootfs "/activate")
"/run/current-system/activate"))
(bin-target (assert-symlink-target (string-append rootfs "/bin")
"/run/current-system/profile/bin"))
(sbin-target (assert-symlink-target (string-append rootfs "/sbin")
"/run/current-system/profile/sbin"))
(lib-target (assert-symlink-target (string-append rootfs "/lib")
"/run/current-system/profile/lib"))
(boot-kernel-target (assert-symlink-target (string-append rootfs "/boot/kernel")
"/run/current-system/boot/kernel"))
(boot-loader-target (assert-symlink-target (string-append rootfs "/boot/loader")
"/run/current-system/boot/loader"))
(boot-loader-efi-target (assert-symlink-target (string-append rootfs "/boot/loader.efi")
"/run/current-system/boot/loader.efi"))
(rc-conf-target (assert-symlink-target (string-append rootfs "/etc/rc.conf")
"/run/current-system/etc/rc.conf"))
(fstab-target (assert-symlink-target (string-append rootfs "/etc/fstab")
"/run/current-system/etc/fstab"))
(passwd-target (assert-symlink-target (string-append rootfs "/etc/passwd")
"/run/current-system/etc/passwd"))
(group-target (assert-symlink-target (string-append rootfs "/etc/group")
"/run/current-system/etc/group"))
(rc-script-target (assert-symlink-target (string-append rootfs "/usr/local/etc/rc.d/fruix-shepherd")
"/run/current-system/usr/local/etc/rc.d/fruix-shepherd"))
(rc-conf-content (call-with-input-file (string-append closure-path "/etc/rc.conf") get-string-all))
(fstab-content (call-with-input-file (string-append closure-path "/etc/fstab") get-string-all))
(activation-content (call-with-input-file (string-append closure-path "/activate") get-string-all))
(shepherd-content (call-with-input-file (string-append closure-path "/shepherd/init.scm") get-string-all))
(loader-conf-content (call-with-input-file (string-append closure-path "/boot/loader.conf") get-string-all)))
(for-each assert-exists
(list rootfs closure-path rc-script
(string-append rootfs "/etc/rc")
(string-append rootfs "/etc/rc.subr")
(string-append rootfs "/etc/rc.d")
(string-append rootfs "/etc/defaults")
(string-append rootfs "/etc/motd")
(string-append rootfs "/usr/sbin")
(string-append rootfs "/usr/bin")
(string-append rootfs "/var/lib/fruix")
(string-append rootfs "/var/log")
(string-append rootfs "/var/run")
(string-append rootfs "/tmp")))
(unless (string-contains rc-conf-content "hostname=\"fruix-freebsd\"")
(error "rc.conf does not contain the expected hostname"))
(unless (string-contains rc-conf-content "fruix_shepherd_enable=\"YES\"")
(error "rc.conf does not enable fruix_shepherd"))
(unless (and (string-contains fstab-content "/dev/ufs/fruix-root")
(string-contains fstab-content "devfs")
(string-contains fstab-content "tmpfs"))
(error "fstab content was incomplete"))
(unless (string-contains activation-content "pw useradd operator")
(error "activation script does not provision the operator account"))
(unless (string-contains shepherd-content ready-marker)
(error "shepherd configuration does not mention the ready marker"))
(unless (string-contains loader-conf-content "console=\"comconsole\"")
(error "loader.conf does not contain the expected serial console setting"))
(call-with-output-file metadata-file
(lambda (port)
(format port "rootfs=~a~%" rootfs)
(format port "closure_path=~a~%" closure-path)
(format port "run_current_system_target=~a~%" run-current-system-target)
(format port "activate_target=~a~%" activate-target)
(format port "bin_target=~a~%" bin-target)
(format port "sbin_target=~a~%" sbin-target)
(format port "lib_target=~a~%" lib-target)
(format port "boot_kernel_target=~a~%" boot-kernel-target)
(format port "boot_loader_target=~a~%" boot-loader-target)
(format port "boot_loader_efi_target=~a~%" boot-loader-efi-target)
(format port "rc_conf_target=~a~%" rc-conf-target)
(format port "fstab_target=~a~%" fstab-target)
(format port "passwd_target=~a~%" passwd-target)
(format port "group_target=~a~%" group-target)
(format port "rc_script=~a~%" rc-script)
(format port "rc_script_target=~a~%" rc-script-target)
(format port "ready_marker=~a~%" ready-marker)
(format port "validation_mode=static-rootfs-check~%")
(format port "ready_state_mode=freebsd-init+rc.d-shepherd~%")))
(when (getenv "METADATA_OUT")
(copy-file metadata-file (getenv "METADATA_OUT")))
(format #t "PASS phase7-rootfs\n")
(format #t "Metadata file: ~a\n" metadata-file)
(when (getenv "METADATA_OUT")
(format #t "Copied metadata to: ~a\n" (getenv "METADATA_OUT")))
(display "--- metadata ---\n")
(display (call-with-input-file metadata-file get-string-all)))