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

* gnu/tests/base.scm (run-basic-test): Add #:root-password and honor it.
This commit is contained in:
Ludovic Courtès 2020-02-21 15:07:44 +01:00
parent 2c2b1ef854
commit 91ba90c18b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
@ -55,7 +55,7 @@ (define %simple-os
(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 @@ (define* (run-basic-test os command #:optional (name "basic")
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 @@ (define (user-owned? file)
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)