diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/base.scm | 59 | ||||
| -rw-r--r-- | gnu/tests/install.scm | 66 |
2 files changed, 97 insertions, 28 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 5c2af5b6d4..6370d6951b 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -31,6 +31,8 @@ #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (gnu services networking) + #:use-module (gnu packages imagemagick) + #:use-module (gnu packages ocr) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) @@ -65,10 +67,16 @@ %base-user-accounts)))) -(define* (run-basic-test os command #:optional (name "basic")) +(define* (run-basic-test os command #:optional (name "basic") + #:key initialization) "Return a derivation called NAME that tests basic features of the OS started using COMMAND, a gexp that evaluates to a list of strings. Compare some -properties of running system to what's declared in OS, an <operating-system>." +properties of running system to what's declared in OS, an <operating-system>. + +When INITIALIZATION is true, it must be a one-argument procedure that is +passed a gexp denoting the marionette, and it must return gexp that is +inserted before the first test. This is used to introduce an extra +initialization step, such as entering a LUKS passphrase." (define test (with-imported-modules '((gnu build marionette)) #~(begin @@ -86,6 +94,9 @@ properties of running system to what's declared in OS, an <operating-system>." (test-begin "basic") + #$(and initialization + (initialization #~marionette)) + (test-assert "uname" (match (marionette-eval '(uname) marionette) (#("Linux" host-name version _ architecture) @@ -150,14 +161,20 @@ info --version") (marionette-type "root\n\nid -un > logged-in\n" marionette) ;; It can take a while before the shell commands are executed. - (let loop ((i 0)) - (unless (or (file-exists? "/root/logged-in") (> i 15)) - (sleep 1) - (loop (+ i 1)))) (marionette-eval '(use-modules (rnrs io ports)) marionette) - (marionette-eval '(call-with-input-file "/root/logged-in" - get-string-all) - marionette))) + (marionette-eval + '(let loop ((i 0)) + (catch 'system-error + (lambda () + (call-with-input-file "/root/logged-in" + get-string-all)) + (lambda args + (if (and (< i 15) (= ENOENT (system-error-errno args))) + (begin + (sleep 1) + (loop (+ i 1))) + (apply throw args))))) + marionette))) (test-assert "host name resolution" (match (marionette-eval @@ -182,14 +199,8 @@ info --version") (test-equal "locale" "en_US.utf8" - (marionette-eval '(begin - ;; XXX: This 'setenv' call wouldn't be needed - ;; but our glibc@2.23 currently ignores - ;; /run/current-system/locale. - (setenv "GUIX_LOCPATH" - "/run/current-system/locale") - (let ((before (setlocale LC_ALL "en_US.utf8"))) - (setlocale LC_ALL before))) + (marionette-eval '(let ((before (setlocale LC_ALL "en_US.utf8"))) + (setlocale LC_ALL before)) marionette)) (test-assert "/run/current-system is a GC root" @@ -235,6 +246,20 @@ info --version") marionette) (file-exists? "tty1.ppm"))) + (test-assert "screen text" + (let ((text (marionette-screen-text marionette + #:ocrad + #$(file-append ocrad + "/bin/ocrad")))) + ;; Check whether the welcome message and shell prompt are + ;; displayed. Note: OCR confuses "y" and "V" for instance, so + ;; we cannot reliably match the whole text. + (and (string-contains text "This is the GNU") + (string-contains text + (string-append + "root@" + #$(operating-system-host-name os)))))) + (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 98f8649af8..ecf1ac1923 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -24,6 +24,7 @@ #:use-module (gnu system install) #:use-module (gnu system vm) #:use-module ((gnu build vm) #:select (qemu-command)) + #:use-module (gnu packages ocr) #:use-module (gnu packages qemu) #:use-module (gnu packages package-management) #:use-module (guix store) @@ -398,17 +399,20 @@ by 'mdadm'.") (locale "en_US.UTF-8") (bootloader (grub-configuration (device "/dev/vdb"))) - (kernel-arguments '("console=ttyS0")) + + ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt + ;; detection logic in 'enter-luks-passphrase'. + + (mapped-devices (list (mapped-device + (source (uuid "12345678-1234-1234-1234-123456789abc")) + (target "the-root-device") + (type luks-device-mapping)))) (file-systems (cons (file-system (device "/dev/mapper/the-root-device") (title 'device) (mount-point "/") (type "ext4")) %base-file-systems)) - (mapped-devices (list (mapped-device - (source "REPLACE-WITH-LUKS-UUID") - (target "the-root-device") - (type luks-device-mapping)))) (users (cons (user-account (name "charlie") (group "users") @@ -435,7 +439,8 @@ parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 3M 1G \\ set 1 boot on \\ set 1 bios_grub on -echo -n thepassphrase | cryptsetup luksFormat -q /dev/vdb2 - +echo -n thepassphrase | \\ + cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 - echo -n thepassphrase | \\ cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device mkfs.ext4 -L my-root /dev/mapper/the-root-device @@ -443,15 +448,53 @@ mount LABEL=my-root /mnt herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm -cat /mnt/etc/config -luks_uuid=`cryptsetup luksUUID /dev/vdb2` -sed -i /mnt/etc/config.scm \\ - -e \"s/\\\"REPLACE-WITH-LUKS-UUID\\\"/(uuid \\\"$luks_uuid\\\")/g\" guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync reboot\n") +(define (enter-luks-passphrase marionette) + "Return a gexp to be inserted in the basic system test running on MARIONETTE +to enter the LUKS passphrase." + (let ((ocrad (file-append ocrad "/bin/ocrad"))) + #~(begin + (define (passphrase-prompt? text) + (string-contains (pk 'screen-text text) "Enter pass")) + + (define (bios-boot-screen? text) + ;; Return true if TEXT corresponds to the boot screen, before GRUB's + ;; menu. + (string-prefix? "SeaBIOS" text)) + + (test-assert "enter LUKS passphrase for GRUB" + (begin + ;; At this point we have no choice but to use OCR to determine + ;; when the passphrase should be entered. + (wait-for-screen-text #$marionette passphrase-prompt? + #:ocrad #$ocrad) + (marionette-type "thepassphrase\n" #$marionette) + + ;; Now wait until we leave the boot screen. This is necessary so + ;; we can then be sure we match the "Enter passphrase" prompt from + ;; 'cryptsetup', in the initrd. + (wait-for-screen-text #$marionette (negate bios-boot-screen?) + #:ocrad #$ocrad + #:timeout 20))) + + (test-assert "enter LUKS passphrase for the initrd" + (begin + ;; XXX: Here we use OCR as well but we could instead use QEMU + ;; '-serial stdio' and run it in an input pipe, + (wait-for-screen-text #$marionette passphrase-prompt? + #:ocrad #$ocrad + #:timeout 60) + (marionette-type "thepassphrase\n" #$marionette) + + ;; Take a screenshot for debugging purposes. + (marionette-control (string-append "screendump " #$output + "/post-initrd-passphrase.ppm") + #$marionette)))))) + (define %test-encrypted-os (system-test (name "encrypted-root-os") @@ -465,6 +508,7 @@ build (current-guix) and then store a couple of full system images.") #:script %encrypted-root-installation-script)) (command (qemu-command/writable-image image))) - (run-basic-test %encrypted-root-os command "encrypted-root-os"))))) + (run-basic-test %encrypted-root-os command "encrypted-root-os" + #:initialization enter-luks-passphrase))))) ;;; install.scm ends here |