122 lines
5.7 KiB
Scheme
122 lines
5.7 KiB
Scheme
(use-modules (fruix system freebsd)
|
|
(ice-9 format)
|
|
(ice-9 pretty-print)
|
|
(ice-9 popen)
|
|
(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 "/phase8-system-image-metadata.txt"))
|
|
(define disk-capacity
|
|
(let ((value (getenv "DISK_CAPACITY")))
|
|
(and value (not (string-null? value)) value)))
|
|
|
|
(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 "command failed" program args status))
|
|
(trim-trailing-newlines output)))
|
|
|
|
(define (assert-exists path)
|
|
(unless (file-exists? path)
|
|
(error "required path missing" path)))
|
|
|
|
(primitive-load os-file)
|
|
(validate-operating-system phase7-operating-system)
|
|
|
|
(let* ((image-a (if disk-capacity
|
|
(materialize-bhyve-image phase7-operating-system
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix
|
|
#:disk-capacity disk-capacity)
|
|
(materialize-bhyve-image phase7-operating-system
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix)))
|
|
(image-b (if disk-capacity
|
|
(materialize-bhyve-image phase7-operating-system
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix
|
|
#:disk-capacity disk-capacity)
|
|
(materialize-bhyve-image phase7-operating-system
|
|
#:store-dir store-dir
|
|
#:guile-prefix guile-prefix
|
|
#:guile-extra-prefix guile-extra-prefix
|
|
#:shepherd-prefix shepherd-prefix)))
|
|
(image-store-path (assoc-ref image-a 'image-store-path))
|
|
(image-store-path-rebuild (assoc-ref image-b 'image-store-path))
|
|
(disk-image (assoc-ref image-a 'disk-image))
|
|
(esp-image (assoc-ref image-a 'esp-image))
|
|
(root-image (assoc-ref image-a 'root-image))
|
|
(closure-path (assoc-ref image-a 'closure-path))
|
|
(image-spec (assoc-ref image-a 'image-spec))
|
|
(store-items (assoc-ref image-a 'store-items))
|
|
(raw-sha256 (command-output "sha256" "-q" disk-image))
|
|
(image-size-bytes (command-output "stat" "-f" "%z" disk-image)))
|
|
(for-each assert-exists
|
|
(list image-store-path disk-image esp-image root-image
|
|
(string-append image-store-path "/image-spec.scm")
|
|
(string-append image-store-path "/closure-path")
|
|
(string-append image-store-path "/.references")
|
|
(string-append image-store-path "/.fruix-package")))
|
|
(unless (string=? image-store-path image-store-path-rebuild)
|
|
(error "image store path was not reproducible" image-store-path image-store-path-rebuild))
|
|
(call-with-output-file metadata-file
|
|
(lambda (port)
|
|
(format port "store_dir=~a~%" store-dir)
|
|
(format port "image_store_path=~a~%" image-store-path)
|
|
(format port "image_store_path_rebuild=~a~%" image-store-path-rebuild)
|
|
(format port "disk_image=~a~%" disk-image)
|
|
(format port "esp_image=~a~%" esp-image)
|
|
(format port "root_image=~a~%" root-image)
|
|
(format port "closure_path=~a~%" closure-path)
|
|
(format port "disk_capacity=~a~%" (or disk-capacity "<default>"))
|
|
(format port "store_item_count=~a~%" (length store-items))
|
|
(format port "raw_sha256=~a~%" raw-sha256)
|
|
(format port "image_size_bytes=~a~%" image-size-bytes)
|
|
(format port "image_spec=~a~%"
|
|
(string-map (lambda (ch) (if (char=? ch #\newline) #\space ch))
|
|
(with-output-to-string
|
|
(lambda ()
|
|
(pretty-print image-spec)))))))
|
|
(when (getenv "METADATA_OUT")
|
|
(copy-file metadata-file (getenv "METADATA_OUT")))
|
|
(format #t "PASS phase8-system-image-materialization~%")
|
|
(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)))
|