From f7f292d359e0eb77617f4ecf6b3164f868ec1784 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 23 Nov 2016 20:59:13 +0100
Subject: 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'.
---
 gnu/build/install.scm    |  5 +++++
 gnu/build/marionette.scm | 19 +++++++++++++++++++
 2 files changed, 24 insertions(+)

(limited to 'gnu/build')

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")
-- 
cgit v1.2.3