aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/install.scm5
-rw-r--r--gnu/build/marionette.scm19
-rw-r--r--gnu/tests/base.scm13
-rw-r--r--gnu/tests/install.scm66
4 files changed, 90 insertions, 13 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 3d1594e203..5c2b35632d 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -46,6 +46,11 @@ Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd."
(install-grub-config grub.cfg mount-point)
+
+ ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
+ ;; partition.
+ (setenv "GRUB_ENABLE_CRYPTODISK" "y")
+
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 8070b6b439..506d6da420 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -27,6 +27,7 @@
marionette-eval
marionette-control
marionette-screen-text
+ wait-for-screen-text
%qwerty-us-keystrokes
marionette-type))
@@ -204,6 +205,24 @@ this by invoking OCRAD (file name for GNU Ocrad's command)"
(lambda ()
(false-if-exception (delete-file image))))))
+(define* (wait-for-screen-text marionette predicate
+ #:key (timeout 30) (ocrad "ocrad"))
+ "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
+PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded."
+ (define start
+ (car (gettimeofday)))
+
+ (define end
+ (+ start timeout))
+
+ (let loop ()
+ (if (> (car (gettimeofday)) end)
+ (error "'wait-for-screen-text' timeout" predicate)
+ (or (predicate (marionette-screen-text marionette #:ocrad ocrad))
+ (begin
+ (sleep 1)
+ (loop))))))
+
(define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes.
'((#\newline . "ret")
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 3be1c55b41..86242d9665 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -67,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
@@ -88,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)
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