123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285 |
- (define-module (gnu tests reconfigure)
- #:use-module (gnu bootloader)
- #:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system accounts)
- #:use-module (gnu system shadow)
- #:use-module (gnu system vm)
- #:use-module (gnu tests)
- #:use-module (guix derivations)
- #:use-module (guix gexp)
- #:use-module (guix monads)
- #:use-module (guix scripts system reconfigure)
- #:use-module (guix store)
- #:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
- (define* (run-switch-to-system-test)
- "Run a test of an OS running SWITCH-SYSTEM-PROGRAM, which creates a new
- generation of the system profile."
- (define os
- (marionette-operating-system
- (operating-system
- (inherit (simple-operating-system))
- (users (cons (user-account
- (name "jakob")
- (group "users")
- (home-directory "/home/jakob"))
- %base-user-accounts)))
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (define vm (virtual-machine os))
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
- (define marionette
- (make-marionette (list #$vm)))
-
- (define (system-generations marionette)
- (marionette-eval
- '(begin
- (use-modules (ice-9 ftw)
- (srfi srfi-1))
- (let* ((profile-dir "/var/guix/profiles/")
- (entries (map first (cddr (file-system-tree profile-dir)))))
- (remove (lambda (entry)
- (member entry '("per-user" "system")))
- entries)))
- marionette))
- (mkdir #$output)
- (chdir #$output)
- (test-begin "switch-to-system")
- (let ((generations-prior (system-generations marionette)))
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
- (test-equal "script created new generation"
- (length (system-generations marionette))
- (1+ (length generations-prior)))
- (test-assert "script activated the new generation"
- (and (eqv? 'symlink
- (marionette-eval
- '(stat:type (lstat "/run/current-system"))
- marionette))
- (string= #$os
- (marionette-eval
- '(readlink "/run/current-system")
- marionette))))
- (test-assert "script activated user accounts"
- (marionette-eval
- '(string-contains (call-with-input-file "/etc/passwd"
- (lambda (port)
- (get-string-all port)))
- "jakob")
- marionette)))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (gexp->derivation "switch-to-system" (test (switch-system-program os))))
- (define* (run-upgrade-services-test)
- "Run a test of an OS running UPGRADE-SERVICES-PROGRAM, which upgrades the
- Shepherd (PID 1) by unloading obsolete services and loading new services."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (define vm (virtual-machine os))
- (define dummy-service
-
-
- (shepherd-service (provision '(dummy))
- (start #~(const #t))
- (stop #~(const #t))
- (respawn? #f)))
- (define (test enable-dummy disable-dummy)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
- (define marionette
- (make-marionette (list #$vm)))
-
- (define (running-services marionette)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (map live-service-canonical-name (current-services)))
- marionette))
- (mkdir #$output)
- (chdir #$output)
- (test-begin "upgrade-services")
- (let ((services-prior (running-services marionette)))
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$enable-dummy)
- marionette))
- (test-assert "script started new service"
- (and (not (memq 'dummy services-prior))
- (memq 'dummy (running-services marionette))))
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$disable-dummy)
- marionette))
- (test-assert "script stopped obsolete service"
- (not (memq 'dummy (running-services marionette)))))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (gexp->derivation
- "upgrade-services"
- (let* ((file (shepherd-service-file dummy-service))
- (enable (upgrade-services-program (list file) '(dummy) '() '()))
- (disable (upgrade-services-program '() '() '(dummy) '())))
- (test enable disable))))
- (define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
- bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (define vm (virtual-machine os))
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
- (define marionette
- (make-marionette (list #$vm)))
-
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (call-with-input-file "/boot/grub/grub.cfg"
- (lambda (port)
- (get-string-all port))))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
- (mkdir #$output)
- (chdir #$output)
- (test-begin "install-bootloader")
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
-
-
-
-
-
-
-
-
-
-
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
-
-
-
-
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file #f "/")))))
- (define %test-switch-to-system
- (system-test
- (name "switch-to-system")
- (description "Create a new generation of the system profile.")
- (value (run-switch-to-system-test))))
- (define %test-upgrade-services
- (system-test
- (name "upgrade-services")
- (description "Upgrade the Shepherd by unloading obsolete services and
- loading new services.")
- (value (run-upgrade-services-test))))
- (define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
|