aboutsummaryrefslogtreecommitdiff
path: root/gnu/build/marionette.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-23 20:59:13 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-23 21:13:18 +0100
commitf7f292d359e0eb77617f4ecf6b3164f868ec1784 (patch)
treec4f5d686c138d6e1bf343a40d3eafc4ffd734be6 /gnu/build/marionette.scm
parentb7d408ec1b591853b4a2fc209e577d60b147e03b (diff)
downloadpatches-f7f292d359e0eb77617f4ecf6b3164f868ec1784.tar
patches-f7f292d359e0eb77617f4ecf6b3164f868ec1784.tar.gz
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'.
Diffstat (limited to 'gnu/build/marionette.scm')
-rw-r--r--gnu/build/marionette.scm19
1 files changed, 19 insertions, 0 deletions
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")