diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/base.scm | 23 | ||||
| -rw-r--r-- | gnu/tests/docker.scm | 4 | ||||
| -rw-r--r-- | gnu/tests/install.scm | 204 | ||||
| -rw-r--r-- | gnu/tests/mail.scm | 96 | ||||
| -rw-r--r-- | gnu/tests/monitoring.scm | 7 |
5 files changed, 277 insertions, 57 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index a891711844..37b83dc7ec 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 <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* (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) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 10882b9d1f..5ab33e1104 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> -;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -206,7 +206,7 @@ inside %DOCKER-OS." ;; load' must be able to store the whole image into memory, hence the ;; huge memory requirements. We should avoid the volatile-root setup ;; instead. - (memory-size 3000) + (memory-size 3500) (port-forwardings '()))) (define test diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 335efbd468..9ecc45cc04 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -26,10 +26,14 @@ #:use-module (gnu system install) #:use-module (gnu system vm) #:use-module ((gnu build vm) #:select (qemu-command)) + #:use-module (gnu packages admin) #:use-module (gnu packages bootloaders) + #:use-module (gnu packages cryptsetup) + #:use-module (gnu packages linux) #:use-module (gnu packages ocr) #:use-module (gnu packages package-management) #:use-module (gnu packages virtualization) + #:use-module (gnu services networking) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix packages) @@ -44,7 +48,10 @@ %test-raid-root-os %test-encrypted-root-os %test-btrfs-root-os - %test-jfs-root-os)) + %test-jfs-root-os + + %test-gui-installed-os + %test-gui-installed-os-encrypted)) ;;; Commentary: ;;; @@ -179,6 +186,7 @@ reboot\n") (define* (run-install target-os target-os-source #:key (script %simple-installation-script) + (gui-test #f) (packages '()) (os (marionette-operating-system (operating-system @@ -191,6 +199,7 @@ reboot\n") packages)) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) + (gnu installer tests) (guix combinators)))) (installation-disk-image-file-system-type "ext4") (target-size (* 2200 MiB))) @@ -256,13 +265,21 @@ packages defined in installation-os." (start 'term-tty1)) marionette) - (marionette-eval '(call-with-output-file "/etc/target-config.scm" - (lambda (port) - (write '#$target-os-source port))) - marionette) - - (exit (marionette-eval '(zero? (system #$script)) - marionette))))) + (when #$(->bool script) + (marionette-eval '(call-with-output-file "/etc/target-config.scm" + (lambda (port) + (write '#$target-os-source port))) + marionette) + (exit (marionette-eval '(zero? (system #$script)) + marionette))) + + (when #$(->bool gui-test) + (wait-for-unix-socket "/var/guix/installer-socket" + marionette) + (format #t "installer socket ready~%") + (force-output) + (exit #$(and gui-test + (gui-test #~marionette))))))) (gexp->derivation "installation" install))) @@ -890,4 +907,175 @@ build (current-guix) and then store a couple of full system images.") (command (qemu-command/writable-image image))) (run-basic-test %jfs-root-os command "jfs-root-os"))))) + +;;; +;;; Installation through the graphical interface. +;;; + +(define %syslog-conf + ;; Syslog configuration that dumps to /dev/console, so we can see the + ;; installer's messages during the test. + (computed-file "syslog.conf" + #~(begin + (copy-file #$%default-syslog.conf #$output) + (chmod #$output #o644) + (let ((port (open-file #$output "a"))) + (display "\n*.info /dev/console\n" port) + #t)))) + +(define (operating-system-with-console-syslog os) + "Return OS with a syslog service that writes to /dev/console." + (operating-system + (inherit os) + (services (modify-services (operating-system-user-services os) + (syslog-service-type config + => + (syslog-configuration + (inherit config) + (config-file %syslog-conf))))))) + +(define %root-password "foo") + +(define* (gui-test-program marionette #:key (encrypted? #f)) + #~(let () + (define (screenshot file) + (marionette-control (string-append "screendump " file) + #$marionette)) + + (setvbuf (current-output-port) 'none) + (setvbuf (current-error-port) 'none) + + (marionette-eval '(use-modules (gnu installer tests)) + #$marionette) + + ;; Arrange so that 'converse' prints debugging output to the console. + (marionette-eval '(let ((console (open-output-file "/dev/console"))) + (setvbuf console 'none) + (conversation-log-port console)) + #$marionette) + + ;; Tell the installer to not wait for the Connman "online" status. + (marionette-eval '(call-with-output-file "/tmp/installer-assume-online" + (const #t)) + #$marionette) + + ;; Run 'guix system init' with '--no-grafts', to cope with the lack of + ;; network access. + (marionette-eval '(call-with-output-file + "/tmp/installer-system-init-options" + (lambda (port) + (write '("--no-grafts" "--no-substitutes") + port))) + #$marionette) + + (marionette-eval '(define installer-socket + (open-installer-socket)) + #$marionette) + (screenshot "installer-start.ppm") + + (marionette-eval '(choose-locale+keyboard installer-socket) + #$marionette) + (screenshot "installer-locale.ppm") + + ;; Choose the host name that the "basic" test expects. + (marionette-eval '(enter-host-name+passwords installer-socket + #:host-name "liberigilo" + #:root-password + #$%root-password + #:users + '(("alice" "pass1") + ("bob" "pass2"))) + #$marionette) + (screenshot "installer-services.ppm") + + (marionette-eval '(choose-services installer-socket + #:desktop-environments '() + #:choose-network-service? + (const #f)) + #$marionette) + (screenshot "installer-partitioning.ppm") + + (marionette-eval '(choose-partitioning installer-socket + #:encrypted? #$encrypted? + #:passphrase #$%luks-passphrase) + #$marionette) + (screenshot "installer-run.ppm") + + (marionette-eval '(conclude-installation installer-socket) + #$marionette) + + (sync) + #t)) + +(define %extra-packages + ;; Packages needed when installing with an encrypted root. + (list isc-dhcp + lvm2-static cryptsetup-static e2fsck/static + loadkeys-static)) + +(define installation-os-for-gui-tests + ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the + ;; target OS, as well as syslog output redirected to the console so we can + ;; see what the installer is up to. + (marionette-operating-system + (operating-system + (inherit (operating-system-with-console-syslog + (operating-system-add-packages + (operating-system-with-current-guix + installation-os) + %extra-packages))) + (kernel-arguments '("console=ttyS0"))) + #:imported-modules '((gnu services herd) + (gnu installer tests) + (guix combinators)))) + +(define* (guided-installation-test name #:key encrypted?) + (define os + (operating-system + (inherit %minimal-os) + (users (append (list (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + (supplementary-groups + '("wheel" "audio" "video"))) + (user-account + (name "bob") + (comment "Alice's brother") + (group "users") + (supplementary-groups + '("wheel" "audio" "video")))) + %base-user-accounts)) + ;; The installer does not create a swap device in guided mode with + ;; encryption support. + (swap-devices (if encrypted? '() '("/dev/vdb2"))) + (services (cons (service dhcp-client-service-type) + (operating-system-user-services %minimal-os))))) + + (system-test + (name name) + (description + "Install an OS using the graphical installer and test it.") + (value + (mlet* %store-monad ((image (run-install os '(this is unused) + #:script #f + #:os installation-os-for-gui-tests + #:gui-test + (lambda (marionette) + (gui-test-program + marionette + #:encrypted? encrypted?)))) + (command (qemu-command/writable-image image))) + (run-basic-test os command name + #:initialization (and encrypted? enter-luks-passphrase) + #:root-password %root-password))))) + +(define %test-gui-installed-os + (guided-installation-test "gui-installed-os" + #:encrypted? #f)) + +(define %test-gui-installed-os-encrypted + (guided-installation-test "gui-installed-os-encrypted" + #:encrypted? #t)) + ;;; install.scm ends here diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index 023f59df10..298918b3a7 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au> -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> @@ -26,8 +26,11 @@ #:use-module (gnu tests) #:use-module (gnu packages mail) #:use-module (gnu system) + #:use-module (gnu system accounts) + #:use-module (gnu system shadow) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services base) #:use-module (gnu services getmail) #:use-module (gnu services mail) #:use-module (gnu services networking) @@ -404,43 +407,55 @@ Subject: Hello Nice to meet you!") (value (run-dovecot-test)))) (define %getmail-os - (simple-operating-system - (service dhcp-client-service-type) - (service dovecot-service-type - (dovecot-configuration - (disable-plaintext-auth? #f) - (ssl? "no") - (auth-mechanisms '("anonymous" "plain")) - (auth-anonymous-username "alice") - (mail-location - (string-append "maildir:~/Maildir" - ":INBOX=~/Maildir/INBOX" - ":LAYOUT=fs")))) - (service getmail-service-type - (list - (getmail-configuration - (name 'test) - (user "alice") - (directory "/var/lib/getmail/alice") - (idle '("TESTBOX")) - (rcfile - (getmail-configuration-file - (retriever - (getmail-retriever-configuration - (type "SimpleIMAPRetriever") - (server "localhost") - (username "alice") - (port 143) - (extra-parameters - '((password . "testpass") - (mailboxes . ("TESTBOX")))))) - (destination - (getmail-destination-configuration - (type "Maildir") - (path "/home/alice/TestMaildir/"))) - (options - (getmail-options-configuration - (read-all #f)))))))))) + (operating-system + (inherit (simple-operating-system)) + + ;; Set a password for the user account; the test needs it. + (users (cons (user-account + (name "alice") + (password (crypt "testpass" "$6$abc")) + (comment "Bob's sister") + (group "users") + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + + (services (cons* (service dhcp-client-service-type) + (service dovecot-service-type + (dovecot-configuration + (disable-plaintext-auth? #f) + (ssl? "no") + (auth-mechanisms '("anonymous" "plain")) + (auth-anonymous-username "alice") + (mail-location + (string-append "maildir:~/Maildir" + ":INBOX=~/Maildir/INBOX" + ":LAYOUT=fs")))) + (service getmail-service-type + (list + (getmail-configuration + (name 'test) + (user "alice") + (directory "/var/lib/getmail/alice") + (idle '("TESTBOX")) + (rcfile + (getmail-configuration-file + (retriever + (getmail-retriever-configuration + (type "SimpleIMAPRetriever") + (server "localhost") + (username "alice") + (port 143) + (extra-parameters + '((password . "testpass") + (mailboxes . ("TESTBOX")))))) + (destination + (getmail-destination-configuration + (type "Maildir") + (path "/home/alice/TestMaildir/"))) + (options + (getmail-options-configuration + (read-all #f)))))))) + %base-services)))) (define (run-getmail-test) "Return a test of an OS running Getmail service." @@ -483,11 +498,6 @@ Subject: Hello Nice to meet you!") (start-service 'dovecot)) marionette)) - (test-assert "set password for alice" - (marionette-eval - '(system "echo -e \"testpass\ntestpass\" | passwd alice") - marionette)) - ;; Wait for getmail to be up and running. (test-assert "getmail-test running" (marionette-eval diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index 14d989d79a..732fbc54d7 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -194,6 +194,13 @@ cat ~a | sudo -u zabbix psql zabbix; (start-service 'postgres)) marionette)) + ;; Add /run/setuid-programs to $PATH so that the scripts passed to + ;; 'system' can find 'sudo'. + (marionette-eval + '(setenv "PATH" + "/run/setuid-programs:/run/current-system/profile/bin") + marionette) + (test-eq "postgres create zabbix user" 0 (marionette-eval '(begin (system #$%psql-user-create-zabbix)) |