01/10: tests: 'run-basic-test' can enter a root password.

[guix-commits]

mothacehe pushed a commit to branch wip-installer-tests
in repository guix.

commit 65f3ebf1cff627f24da25852c42790147d4d4924
Author: Ludovic Courtès <address@hidden>
AuthorDate: Fri Feb 21 15:07:44 2020 +0100

    tests: 'run-basic-test' can enter a root password.
    
    * gnu/tests/base.scm (run-basic-test): Add #:root-password and honor it.
---
 gnu/tests/base.scm | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index a891711..37b83dc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2018 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -55,7 +55,7 @@
 
 
 (define* (run-basic-test os command #:optional (name "basic")
-                         #:key initialization)
+                         #:key initialization root-password)
   "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>.
@@ -63,7 +63,10 @@ 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."
+initialization step, such as entering a LUKS passphrase.
+
+When ROOT-PASSWORD is true, enter it as the root password when logging in.
+Otherwise assume that there is no password for root."
   (define special-files
     (service-value
      (fold-services (operating-system-services os)
@@ -300,7 +303,19 @@ info --version")
                marionette)
 
               ;; Now we can type.
-              (marionette-type "root\n\nid -un > logged-in\n" marionette)
+              (let ((password #$root-password))
+                (if password
+                    (begin
+                      (marionette-type "root\n" marionette)
+                      (wait-for-screen-text marionette
+                                            (lambda (text)
+                                              (string-contains text 
"Password"))
+                                            #:ocrad
+                                            #$(file-append ocrad "/bin/ocrad"))
+                      (marionette-type (string-append password "\n\n")
+                                       marionette))
+                    (marionette-type "root\n\n" marionette)))
+              (marionette-type "id -un > logged-in\n" marionette)
 
               ;; It can take a while before the shell commands are executed.
               (marionette-eval '(use-modules (rnrs io ports)) marionette)