me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Mathieu Othacehe 2020-03-24 12:16:23 +01:00
parent 7a1a10dbd4
commit b03ebdbc7c
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 112 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
gnu/tests/install.scm
View File

@ -32,15 +32,23 @@
#:use-module (gnu packages cryptsetup) #:use-module (gnu packages cryptsetup)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages ocr) #:use-module (gnu packages ocr)
#:use-module (gnu packages openbox)
#:use-module (gnu packages package-management) #: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 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 networking)
#:use-module (gnu services xorg)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (srfi srfi-1)
#:export (%test-installed-os #:export (%test-installed-os
%test-installed-extlinux-os %test-installed-extlinux-os
%test-iso-image-installer %test-iso-image-installer
@ -52,7 +60,8 @@
%test-jfs-root-os %test-jfs-root-os
%test-gui-installed-os %test-gui-installed-os
%test-gui-installed-os-encrypted)) %test-gui-installed-os-encrypted
%test-gui-installed-desktop-os-encrypted))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -203,6 +212,7 @@ reboot\n")
(gnu installer tests) (gnu installer tests)
(guix combinators)))) (guix combinators))))
(installation-disk-image-file-system-type "ext4") (installation-disk-image-file-system-type "ext4")
(install-size 'guess)
(target-size (* 2200 MiB))) (target-size (* 2200 MiB)))
"Run SCRIPT (a shell script following the system installation procedure) in "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 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 (image (system-disk-image
(operating-system-with-gc-roots (operating-system-with-gc-roots
os (list target)) os (list target))
#:disk-image-size 'guess #:disk-image-size install-size
#:file-system-type #:file-system-type
installation-disk-image-file-system-type))) installation-disk-image-file-system-type)))
(define install (define install
@ -941,7 +951,10 @@ build (current-guix) and then store a couple of full system images.")
(define %root-password "foo") (define %root-password "foo")
(define* (gui-test-program marionette #:key (encrypted? #f)) (define* (gui-test-program marionette
#:key
(desktop? #f)
(encrypted? #f))
#~(let () #~(let ()
(define (screenshot file) (define (screenshot file)
(marionette-control (string-append "screendump " 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") (screenshot "installer-services.ppm")
(marionette-eval* '(choose-services installer-socket (marionette-eval* '(choose-services installer-socket
#:desktop-environments '() #:choose-desktop-environment?
(const #$desktop?)
#:choose-network-service? #:choose-network-service?
(const #f)) (const #f))
#$marionette) #$marionette)
@ -1038,53 +1052,111 @@ build (current-guix) and then store a couple of full system images.")
(gnu installer tests) (gnu installer tests)
(guix combinators)))) (guix combinators))))
(define* (guided-installation-test name #:key encrypted?) (define* (installation-target-os-for-gui-tests
(define os #:key (encrypted? #f))
(operating-system (operating-system
(inherit %minimal-os) (inherit %minimal-os)
(users (append (list (user-account (users (append (list (user-account
(name "alice") (name "alice")
(comment "Bob's sister") (comment "Bob's sister")
(group "users") (group "users")
(supplementary-groups (supplementary-groups
'("wheel" "audio" "video"))) '("wheel" "audio" "video")))
(user-account (user-account
(name "bob") (name "bob")
(comment "Alice's brother") (comment "Alice's brother")
(group "users") (group "users")
(supplementary-groups (supplementary-groups
'("wheel" "audio" "video")))) '("wheel" "audio" "video"))))
%base-user-accounts)) %base-user-accounts))
;; The installer does not create a swap device in guided mode with ;; The installer does not create a swap device in guided mode with
;; encryption support. ;; encryption support.
(swap-devices (if encrypted? '() '("/dev/vdb2"))) (swap-devices (if encrypted? '() '("/dev/vdb2")))
(services (cons (service dhcp-client-service-type) (services (cons (service dhcp-client-service-type)
(operating-system-user-services %minimal-os))))) (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 (system-test
(name name) (name name)
(description (description
"Install an OS using the graphical installer and test it.") "Install an OS using the graphical installer and test it.")
(value (value
(mlet* %store-monad ((image (run-install os '(this is unused) (mlet* %store-monad
#:script #f ((image (run-install target-os '(this is unused)
#:os installation-os-for-gui-tests #:script #f
#:gui-test #:os installation-os-for-gui-tests
(lambda (marionette) #:install-size install-size
(gui-test-program #:target-size target-size
marionette #:gui-test
#:encrypted? encrypted?)))) (lambda (marionette)
(command (qemu-command/writable-image image))) (gui-test-program
(run-basic-test os command name marionette
#:desktop? desktop?
#:encrypted? encrypted?))))
(command (qemu-command/writable-image image)))
(run-basic-test target-os command name
#:initialization (and encrypted? enter-luks-passphrase) #:initialization (and encrypted? enter-luks-passphrase)
#:root-password %root-password))))) #:root-password %root-password)))))
(define %test-gui-installed-os (define %test-gui-installed-os
(guided-installation-test "gui-installed-os" (guided-installation-test
#:encrypted? #f)) "gui-installed-os"
#:target-os (installation-target-os-for-gui-tests)))
(define %test-gui-installed-os-encrypted (define %test-gui-installed-os-encrypted
(guided-installation-test "gui-installed-os-encrypted" (guided-installation-test
#:encrypted? #t)) "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 ;;; install.scm ends here