Browse Source

tests: install: Add %test-gui-installed-desktop-os-encrypted.

* gnu/tests/install.scm (gui-test-program): Add a desktop? argument, and pass it to choose-services,
(installation-target-os-for-gui-tests): new procedure,
(installation-target-desktop-os-for-gui-tests): new procedure,
(guided-installation-test): add target-os and desktop? arguments. Use
target-os instead of the previous os variable. Pass desktop? argument to
gui-test-program.
(%test-gui-installed-os): Adapt accordingly,
(%test-gui-installed-os-encrypted): ditto,
(%test-gui-installed-desktop-os-encrypted): new exported variable.
version-1.1.0
Mathieu Othacehe 2 years ago
parent
commit
b03ebdbc7c
No known key found for this signature in database GPG Key ID: 8354763531769CA6
  1. 154
      gnu/tests/install.scm

154
gnu/tests/install.scm

@ -32,15 +32,23 @@
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages linux)
#:use-module (gnu packages ocr)
#:use-module (gnu packages openbox)
#:use-module (gnu packages package-management)
#:use-module (gnu packages ratpoison)
#:use-module (gnu packages suckless)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages wm)
#:use-module (gnu packages xorg)
#:use-module (gnu services desktop)
#:use-module (gnu services networking)
#:use-module (gnu services xorg)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:export (%test-installed-os
%test-installed-extlinux-os
%test-iso-image-installer
@ -52,7 +60,8 @@
%test-jfs-root-os
%test-gui-installed-os
%test-gui-installed-os-encrypted))
%test-gui-installed-os-encrypted
%test-gui-installed-desktop-os-encrypted))
;;; Commentary:
;;;
@ -203,6 +212,7 @@ reboot\n")
(gnu installer tests)
(guix combinators))))
(installation-disk-image-file-system-type "ext4")
(install-size 'guess)
(target-size (* 2200 MiB)))
"Run SCRIPT (a shell script following the system installation procedure) in
OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing
@ -220,7 +230,7 @@ packages defined in installation-os."
(image (system-disk-image
(operating-system-with-gc-roots
os (list target))
#:disk-image-size 'guess
#:disk-image-size install-size
#:file-system-type
installation-disk-image-file-system-type)))
(define install
@ -941,7 +951,10 @@ build (current-guix) and then store a couple of full system images.")
(define %root-password "foo")
(define* (gui-test-program marionette #:key (encrypted? #f))
(define* (gui-test-program marionette
#:key
(desktop? #f)
(encrypted? #f))
#~(let ()
(define (screenshot file)
(marionette-control (string-append "screendump " file)
@ -998,7 +1011,8 @@ build (current-guix) and then store a couple of full system images.")
(screenshot "installer-services.ppm")
(marionette-eval* '(choose-services installer-socket
#:desktop-environments '()
#:choose-desktop-environment?
(const #$desktop?)
#:choose-network-service?
(const #f))
#$marionette)
@ -1038,53 +1052,111 @@ build (current-guix) and then store a couple of full system images.")
(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)))))
(define* (installation-target-os-for-gui-tests
#:key (encrypted? #f))
(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)))))
(define* (installation-target-desktop-os-for-gui-tests
#:key (encrypted? #f))
(operating-system
(inherit (installation-target-os-for-gui-tests
#:encrypted? encrypted?))
(keyboard-layout (keyboard-layout "us" "altgr-intl"))
;; Make sure that all the packages and services that may be used by the
;; graphical installer are available.
(packages (append
(list openbox awesome i3-wm i3status
dmenu st ratpoison xterm)
%base-packages))
(services
(append
(list (service gnome-desktop-service-type)
(service xfce-desktop-service-type)
(service mate-desktop-service-type)
(service enlightenment-desktop-service-type)
(set-xorg-configuration
(xorg-configuration
(keyboard-layout keyboard-layout)))
(service marionette-service-type
(marionette-configuration
(imported-modules '((gnu services herd)
(guix build utils)
(guix combinators))))))
%desktop-services))))
(define* (guided-installation-test name
#:key
(desktop? #f)
(encrypted? #f)
target-os
(install-size 'guess)
(target-size (* 2200 MiB)))
(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
(mlet* %store-monad
((image (run-install target-os '(this is unused)
#:script #f
#:os installation-os-for-gui-tests
#:install-size install-size
#:target-size target-size
#:gui-test
(lambda (marionette)
(gui-test-program
marionette
#:desktop? desktop?
#:encrypted? encrypted?))))
(command (qemu-command/writable-image image)))
(run-basic-test target-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))
(guided-installation-test
"gui-installed-os"
#:target-os (installation-target-os-for-gui-tests)))
(define %test-gui-installed-os-encrypted
(guided-installation-test "gui-installed-os-encrypted"
#:encrypted? #t))
(guided-installation-test
"gui-installed-os-encrypted"
#:encrypted? #t
#:target-os (installation-target-os-for-gui-tests
#:encrypted? #t)))
;; Building a desktop image is very time and space consuming. Install all
;; desktop environments in a single test to reduce the overhead.
(define %test-gui-installed-desktop-os-encrypted
(guided-installation-test "gui-installed-desktop-os-encrypted"
#:desktop? #t
#:encrypted? #t
#:target-os
(installation-target-desktop-os-for-gui-tests
#:encrypted? #t)
;; XXX: The disk-image size guess is too low. Use
;; a constant value until this is fixed.
#:install-size (* 8000 MiB)
#:target-size (* 9000 MiB)))
;;; install.scm ends here
Loading…
Cancel
Save