171 lines
7.2 KiB
Scheme
171 lines
7.2 KiB
Scheme
(use-modules (ice-9 match)
|
|
(srfi srfi-1)
|
|
(srfi srfi-13)
|
|
(srfi srfi-64)
|
|
(fruix system freebsd utils))
|
|
|
|
(define repo-root
|
|
(or (getenv "FRUIX_REPO_ROOT")
|
|
(error "FRUIX_REPO_ROOT is not set")))
|
|
|
|
(define guile-bin
|
|
(or (getenv "GUILE_BIN")
|
|
(error "GUILE_BIN is not set")))
|
|
|
|
(define fruix-script
|
|
(string-append repo-root "/scripts/fruix.scm"))
|
|
|
|
(define (cli-output . args)
|
|
(apply command-output guile-bin
|
|
(append '("--no-auto-compile" "-s")
|
|
(list fruix-script)
|
|
args)))
|
|
|
|
(define (output-lines text)
|
|
(filter (lambda (line) (not (string-null? line)))
|
|
(string-split text #\newline)))
|
|
|
|
(define (summary-line-name line)
|
|
(car (string-split line #\tab)))
|
|
|
|
(define (metadata-value text key)
|
|
(let ((prefix (string-append key "=")))
|
|
(let loop ((lines (output-lines text)))
|
|
(match lines
|
|
(() #f)
|
|
((line . rest)
|
|
(if (string-prefix? prefix line)
|
|
(substring line (string-length prefix))
|
|
(loop rest)))))))
|
|
|
|
(define (path-present? path)
|
|
(or (file-exists? path)
|
|
(false-if-exception (readlink path))))
|
|
|
|
(define (read-scheme-file path)
|
|
(call-with-input-file path read))
|
|
|
|
(test-begin "package-profile")
|
|
|
|
(let* ((store-dir (mktemp-directory "/tmp/fruix-package-profile-store.XXXXXX"))
|
|
(profile-dir (mktemp-directory "/tmp/fruix-package-profile-state.XXXXXX"))
|
|
(install-output
|
|
(cli-output "package" "install"
|
|
"freebsd-nodejs" "freebsd-npm"
|
|
"--store" store-dir
|
|
"--profile" profile-dir))
|
|
(installed-output-1
|
|
(cli-output "package" "installed"
|
|
"--profile" profile-dir))
|
|
(install-output-2
|
|
(cli-output "package" "install"
|
|
"freebsd-ripgrep" "freebsd-tmux"
|
|
"--store" store-dir
|
|
"--profile" profile-dir))
|
|
(remove-output
|
|
(cli-output "package" "remove"
|
|
"freebsd-npm" "freebsd-tmux"
|
|
"--store" store-dir
|
|
"--profile" profile-dir))
|
|
(installed-output-2
|
|
(cli-output "package" "installed"
|
|
"--profile" profile-dir))
|
|
(current-link (string-append profile-dir "/current"))
|
|
(activate-link (string-append profile-dir "/activate"))
|
|
(manifest-path (string-append profile-dir "/manifest.scm"))
|
|
(first-profile-store (metadata-value install-output "profile_store"))
|
|
(first-profile-jail-metadata-file (metadata-value install-output "profile_jail_metadata_file"))
|
|
(second-profile-store (metadata-value install-output-2 "profile_store"))
|
|
(third-profile-store (metadata-value remove-output "profile_store")))
|
|
(test-equal "package install reports action"
|
|
"package-install"
|
|
(metadata-value install-output "action"))
|
|
(test-equal "first profile generation is 1"
|
|
"1"
|
|
(metadata-value install-output "generation"))
|
|
(test-assert "profile current link exists"
|
|
(false-if-exception (readlink current-link)))
|
|
(test-assert "profile activate link exists"
|
|
(false-if-exception (readlink activate-link)))
|
|
(test-assert "profile manifest exists"
|
|
(file-exists? manifest-path))
|
|
(test-assert "node is present in the first profile store"
|
|
(path-present? (string-append first-profile-store "/bin/node")))
|
|
(test-assert "npm is present in the first profile store"
|
|
(path-present? (string-append first-profile-store "/bin/npm")))
|
|
(test-assert "activate script exists in the first profile store"
|
|
(path-present? (string-append first-profile-store "/activate")))
|
|
(test-assert "profile materialization records jail metadata"
|
|
(and first-profile-jail-metadata-file
|
|
(file-exists? first-profile-jail-metadata-file)))
|
|
(when first-profile-jail-metadata-file
|
|
(let* ((metadata (read-scheme-file first-profile-jail-metadata-file))
|
|
(mode-entry (assoc 'mode metadata))
|
|
(run-metadata-entry (assoc 'run-metadata metadata))
|
|
(run-metadata (and run-metadata-entry (cdr run-metadata-entry)))
|
|
(mounts-entry (and run-metadata (assoc 'mounts run-metadata)))
|
|
(network-entry (and run-metadata (assoc 'network? run-metadata))))
|
|
(test-equal "profile jail metadata records copy mode"
|
|
'copy
|
|
(and mode-entry (cdr mode-entry)))
|
|
(test-assert "profile jail metadata records network disabled"
|
|
(and network-entry (eq? (cdr network-entry) #f)))
|
|
(test-assert "profile jail metadata omits host /etc mount"
|
|
(not (string-contains (object->string (and mounts-entry (cdr mounts-entry))) "\"/etc\"")))
|
|
(test-assert "profile jail metadata omits devfs mount"
|
|
(not (string-contains (object->string (and mounts-entry (cdr mounts-entry))) "(devfs")))))
|
|
(test-assert "installed lists nodejs after first install"
|
|
(member "freebsd-nodejs"
|
|
(map summary-line-name (output-lines installed-output-1))))
|
|
(test-assert "installed lists npm after first install"
|
|
(member "freebsd-npm"
|
|
(map summary-line-name (output-lines installed-output-1))))
|
|
(test-equal "activate script exposes node"
|
|
"v24.14.0"
|
|
(command-output "sh" "-eu" "-c"
|
|
"eval \"$($0)\"; node --version"
|
|
activate-link))
|
|
|
|
(test-equal "second profile generation is 2"
|
|
"2"
|
|
(metadata-value install-output-2 "generation"))
|
|
(test-assert "ripgrep is present after second install"
|
|
(path-present? (string-append second-profile-store "/bin/rg")))
|
|
(test-assert "tmux is present after second install"
|
|
(path-present? (string-append second-profile-store "/bin/tmux")))
|
|
(test-equal "activate script exposes ripgrep after second install"
|
|
"ripgrep 15.1.0"
|
|
(car (output-lines
|
|
(command-output "sh" "-eu" "-c"
|
|
"eval \"$($0)\"; rg --version | head -1"
|
|
activate-link))))
|
|
|
|
(test-equal "package remove reports action"
|
|
"package-remove"
|
|
(metadata-value remove-output "action"))
|
|
(test-equal "third profile generation is 3"
|
|
"3"
|
|
(metadata-value remove-output "generation"))
|
|
(test-assert "node remains after remove"
|
|
(path-present? (string-append third-profile-store "/bin/node")))
|
|
(test-assert "ripgrep remains after remove"
|
|
(path-present? (string-append third-profile-store "/bin/rg")))
|
|
(test-assert "npm is removed from the current profile"
|
|
(not (path-present? (string-append third-profile-store "/bin/npm"))))
|
|
(test-assert "tmux is removed from the current profile"
|
|
(not (path-present? (string-append third-profile-store "/bin/tmux"))))
|
|
(test-assert "installed still lists nodejs"
|
|
(member "freebsd-nodejs"
|
|
(map summary-line-name (output-lines installed-output-2))))
|
|
(test-assert "installed still lists ripgrep"
|
|
(member "freebsd-ripgrep"
|
|
(map summary-line-name (output-lines installed-output-2))))
|
|
(test-assert "installed no longer lists npm"
|
|
(not (member "freebsd-npm"
|
|
(map summary-line-name (output-lines installed-output-2)))))
|
|
(test-assert "installed no longer lists tmux"
|
|
(not (member "freebsd-tmux"
|
|
(map summary-line-name (output-lines installed-output-2))))))
|
|
|
|
(test-end "package-profile")
|