@@ -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,13 +212,14 @@ reboot\n")
(gnu installer tests)
(guix combinators))))
(installation-disk-image-file-system-type "ext4")
- (target-size (* 2200 MiB)))
+ (target-size #f))
"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
the installed system. The packages specified in PACKAGES will be appended to
packages defined in installation-os."
- (mlet* %store-monad ((_ (set-grafting #f))
+ (mlet* %store-monad ((target-size -> (or target-size (* 2200 MiB)))
+ (_ (set-grafting #f))
(system (current-system))
(target (operating-system-derivation target-os))
@@ -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,7 +1052,11 @@ 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* (guided-installation-test name
+ #:key
+ (desktop? #f)
+ encrypted?
+ (target-size #f))
(define os
(operating-system
(inherit %minimal-os)
@@ -1055,26 +1073,56 @@ build (current-guix) and then store a couple of full system images.")
(supplementary-groups
'("wheel" "audio" "video"))))
%base-user-accounts))
+ (keyboard-layout (and desktop?
+ (keyboard-layout "us" "altgr-intl")))
;; 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)))))
+
+ ;; Make sure that all the packages and services that may be used by the
+ ;; graphical installer are available.
+ (packages (append
+ (if desktop?
+ (list openbox awesome i3-wm i3status
+ dmenu st ratpoison xterm)
+ '())
+ %base-packages))
+ (services
+ (if desktop?
+ (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)
+ (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)))
+ (mlet* %store-monad
+ ((image (run-install os '(this is unused)
+ #:script #f
+ #:os installation-os-for-gui-tests
+ #: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 os command name
#:initialization (and encrypted? enter-luks-passphrase)
#:root-password %root-password)))))
@@ -1087,4 +1135,12 @@ build (current-guix) and then store a couple of full system images.")
(guided-installation-test "gui-installed-os-encrypted"
#: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-size (* 9000 MiB)))
+
;;; install.scm ends here