[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: tests: install: Add %test-gui-installed-desktop-os-encrypted.
|
From: |
guix-commits |
|
Subject: |
02/02: tests: install: Add %test-gui-installed-desktop-os-encrypted. |
|
Date: |
Thu, 26 Mar 2020 06:54:09 -0400 (EDT) |
mothacehe pushed a commit to branch master
in repository guix.
commit b03ebdbc7c028f62da2b667556e6546b42e6e96f
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Tue Mar 24 12:16:23 2020 +0100
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.
---
gnu/tests/install.scm | 154 ++++++++++++++++++++++++++++++++++++--------------
1 file changed, 113 insertions(+), 41 deletions(-)
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 8398887..b0b40f2 100644
--- a/gnu/tests/install.scm
+++ b/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