mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
install: Enable "cryptodisk" handling in GRUB.
This allows 'grub-install' to do the right thing when / or /boot is a LUKS-encrypted partition. Fixes <http://bugs.gnu.org/21843>. * gnu/build/install.scm (install-grub): Add 'setenv' to set 'GRUB_ENABLE_CRYPTODISK'. (wait-for-screen-text): New test. * gnu/tests/base.scm (run-basic-test): Add #:initialization parameter and honor it. * gnu/tests/install.scm (%encrypted-root-os)[kernel-arguments]: Remove. (%encrypted-root-installation-script): Pass '--uuid' to 'cryptsetup luksFormat'. Remove 'sed' invocation. (enter-luks-passphrase): New procedure. (%test-encrypted-os)[value]: Pass #:initialization to 'run-basic-test'.
This commit is contained in:
Ludovic Courtès
parent
b7d408ec1b
commit
f7f292d359
4 changed files with 90 additions and 13 deletions
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue