X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/6c1a317e29c45e85e3a0e050612cdefe470b100c..e80d1c1992fb60c492520d61f3a3d1fef65cfdf2:/gnu/tests/install.scm diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 22e4181ab1..9ecc45cc04 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,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) @@ -37,15 +42,20 @@ #:use-module (guix utils) #:export (%test-installed-os %test-installed-extlinux-os + %test-iso-image-installer %test-separate-store-os %test-separate-home-os %test-raid-root-os - %test-encrypted-os - %test-btrfs-root-os)) + %test-encrypted-root-os + %test-btrfs-root-os + %test-jfs-root-os + + %test-gui-installed-os + %test-gui-installed-os-encrypted)) ;;; Commentary: ;;; -;;; Test the installation of GuixSD using the documented approach at the +;;; Test the installation of Guix using the documented approach at the ;;; command line. ;;; ;;; Code: @@ -59,11 +69,12 @@ (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) @@ -71,12 +82,12 @@ (name "alice") (comment "Bob's sister") (group "users") - (supplementary-groups '("wheel" "audio" "video")) - (home-directory "/home/alice")) + (supplementary-groups '("wheel" "audio" "video"))) %base-user-accounts)) (services (cons (service marionette-service-type (marionette-configuration (imported-modules '((gnu services herd) + (guix build utils) (guix combinators))))) %base-services)))) @@ -98,11 +109,10 @@ (bootloader (bootloader-configuration (bootloader extlinux-bootloader-gpt) - (device "/dev/vdb"))) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) @@ -122,13 +132,6 @@ (inherit config) (guix (current-guix)))))))) -(define (operating-system-with-gc-roots os roots) - "Return a variant of OS where ROOTS are registered as GC roots." - (operating-system - (inherit os) - (services (cons (service gc-root-service-type roots) - (operating-system-user-services os))))) - (define MiB (expt 2 20)) @@ -143,7 +146,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts guix build isc-dhcp parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 1G \\ + mkpart primary ext2 3M 1.4G \\ set 1 boot on \\ set 1 bios_grub on mkfs.ext4 -L my-root /dev/vdb2 @@ -168,7 +171,7 @@ guix --version export GUIX_BUILD_OPTIONS=--no-grafts guix build isc-dhcp parted --script /dev/vdb mklabel gpt \\ - mkpart ext2 1M 1G \\ + mkpart ext2 1M 1.4G \\ set 1 legacy_boot on mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1 mount /dev/vdb1 /mnt @@ -183,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 @@ -195,9 +199,11 @@ reboot\n") packages)) (kernel-arguments '("console=ttyS0"))) #:imported-modules '((gnu services herd) + (gnu installer tests) (guix combinators)))) - (target-size (* 1200 MiB))) - "Run SCRIPT (a shell script following the GuixSD installation procedure) in + (installation-disk-image-file-system-type "ext4") + (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 the installed system. The packages specified in PACKAGES will be appended to packages defined in installation-os." @@ -213,7 +219,9 @@ packages defined in installation-os." (image (system-disk-image (operating-system-with-gc-roots os (list target)) - #:disk-image-size (* 1500 MiB)))) + #:disk-image-size 'guess + #:file-system-type + installation-disk-image-file-system-type))) (define install (with-imported-modules '((guix build utils) (gnu build marionette)) @@ -229,16 +237,25 @@ packages defined in installation-os." (define marionette (make-marionette - (cons (which #$(qemu-command system)) - (cons* "-no-reboot" "-m" "800" - "-drive" - (string-append "file=" #$image - ",if=virtio,readonly") - "-drive" - (string-append "file=" #$output ",if=virtio") - (if (file-exists? "/dev/kvm") - '("-enable-kvm") - '()))))) + `(,(which #$(qemu-command system)) + "-no-reboot" + "-m" "800" + #$@(cond + ((string=? "ext4" installation-disk-image-file-system-type) + #~("-drive" + ,(string-append "file=" #$image + ",if=virtio,readonly"))) + ((string=? "iso9660" installation-disk-image-file-system-type) + #~("-cdrom" #$image)) + (else + (error + "unsupported installation-disk-image-file-system-type:" + installation-disk-image-file-system-type))) + "-drive" + ,(string-append "file=" #$output ",if=virtio") + ,@(if (file-exists? "/dev/kvm") + '("-enable-kvm") + '())))) (pk 'uname (marionette-eval '(uname) marionette)) @@ -248,19 +265,27 @@ 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))) (define* (qemu-command/writable-image image #:key (memory-size 256)) "Return as a monadic value the command to run QEMU on a writable copy of -IMAGE, a disk image. The QEMU VM is has access to MEMORY-SIZE MiB of RAM." +IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." (mlet %store-monad ((system (current-system))) (return #~(let ((image #$image)) ;; First we need a writable copy of the image. @@ -313,6 +338,81 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.") "installed-extlinux-os"))))) +;;; +;;; Installation through an ISO image. +;;; + +(define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "liberigilo") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vda"))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + (services (cons (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix combinators))))) + %base-services)))) + +(define %simple-installation-script-for-/dev/vda + ;; Shell script of a simple installation. + "\ +. /etc/profile +set -e -x +guix --version + +export GUIX_BUILD_OPTIONS=--no-grafts +guix build isc-dhcp +parted --script /dev/vda mklabel gpt \\ + mkpart primary ext2 1M 3M \\ + mkpart primary ext2 3M 1.4G \\ + set 1 boot on \\ + set 1 bios_grub on +mkfs.ext4 -L my-root /dev/vda2 +mount /dev/vda2 /mnt +df -h /mnt +herd start cow-store /mnt +mkdir /mnt/etc +cp /etc/target-config.scm /mnt/etc/config.scm +guix system init /mnt/etc/config.scm /mnt --no-substitutes +sync +reboot\n") + +(define %test-iso-image-installer + (system-test + (name "iso-image-installer") + (description + "") + (value + (mlet* %store-monad ((image (run-install + %minimal-os-on-vda + %minimal-os-on-vda-source + #:script + %simple-installation-script-for-/dev/vda + #:installation-disk-image-file-system-type + "iso9660")) + (command (qemu-command/writable-image image))) + (run-basic-test %minimal-os-on-vda command name))))) + + ;;; ;;; Separate /home. ;;; @@ -326,28 +426,25 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.") (timezone "Europe/Paris") (locale "en_US.utf8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) (file-system (device "none") - (title 'device) - (type "tmpfs") (mount-point "/home") (type "tmpfs")) %base-file-systems)) (users (cons* (user-account (name "alice") - (group "users") - (home-directory "/home/alice")) + (group "users")) (user-account (name "charlie") - (group "users") - (home-directory "/home/charlie")) + (group "users")) %base-user-accounts)) (services (cons (service marionette-service-type (marionette-configuration @@ -384,16 +481,16 @@ partition. In particular, home directories must be correctly created (see (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) (file-systems (cons* (file-system - (device "root-fs") - (title 'label) + (device (file-system-label "root-fs")) (mount-point "/") (type "ext4")) (file-system - (device "store-fs") - (title 'label) + (device (file-system-label "store-fs")) (mount-point "/gnu") (type "ext4")) %base-file-systems)) @@ -415,8 +512,8 @@ export GUIX_BUILD_OPTIONS=--no-grafts guix build isc-dhcp parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 100M \\ - mkpart primary ext2 100M 1G \\ + mkpart primary ext2 3M 400M \\ + mkpart primary ext2 400M 2.1G \\ set 1 boot on \\ set 1 bios_grub on mkfs.ext4 -L root-fs /dev/vdb2 @@ -425,6 +522,7 @@ mount /dev/vdb2 /mnt mkdir /mnt/gnu mount /dev/vdb3 /mnt/gnu df -h /mnt +df -h /mnt/gnu herd start cow-store /mnt mkdir /mnt/etc cp /etc/target-config.scm /mnt/etc/config.scm @@ -460,20 +558,20 @@ where /gnu lives on a separate partition.") (timezone "Europe/Paris") (locale "en_US.utf8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) - (initrd (lambda (file-systems . rest) - ;; Add a kernel module for RAID-0 (aka. "stripe"). - (apply base-initrd file-systems - #:extra-modules '("raid0") - rest))) + + ;; Add a kernel module for RAID-1 (aka. "mirror"). + (initrd-modules (cons "raid1" %base-initrd-modules)) + (mapped-devices (list (mapped-device (source (list "/dev/vda2" "/dev/vda3")) (target "/dev/md0") (type raid-device-mapping)))) (file-systems (cons (file-system - (device "root-fs") - (title 'label) + (device (file-system-label "root-fs")) (mount-point "/") (type "ext4") (dependencies mapped-devices)) @@ -497,11 +595,11 @@ guix --version export GUIX_BUILD_OPTIONS=--no-grafts parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 600M \\ - mkpart primary ext2 600M 1200M \\ + mkpart primary ext2 3M 1.4G \\ + mkpart primary ext2 1.4G 2.8G \\ set 1 boot on \\ set 1 bios_grub on -mdadm --create /dev/md0 --verbose --level=stripe --raid-devices=2 \\ +yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\ /dev/vdb2 /dev/vdb3 mkfs.ext4 -L root-fs /dev/md0 mount /dev/md0 /mnt @@ -524,7 +622,7 @@ by 'mdadm'.") %raid-root-os-source #:script %raid-root-installation-script - #:target-size (* 1300 MiB))) + #:target-size (* 2800 MiB))) (command (qemu-command/writable-image image))) (run-basic-test %raid-root-os `(,@command) "raid-root-os"))))) @@ -543,7 +641,9 @@ by 'mdadm'.") (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt ;; detection logic in 'enter-luks-passphrase'. @@ -554,14 +654,12 @@ by 'mdadm'.") (type luks-device-mapping)))) (file-systems (cons (file-system (device "/dev/mapper/the-root-device") - (title 'device) (mount-point "/") (type "ext4")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") - (home-directory "/home/charlie") (supplementary-groups '("wheel" "audio" "video"))) %base-user-accounts)) (services (cons (service marionette-service-type @@ -570,9 +668,13 @@ by 'mdadm'.") (guix combinators))))) %base-services)))) +(define %luks-passphrase + ;; LUKS encryption passphrase used in tests. + "thepassphrase") + (define %encrypted-root-installation-script ;; Shell script of a simple installation. - "\ + (string-append "\ . /etc/profile set -e -x guix --version @@ -581,12 +683,12 @@ export GUIX_BUILD_OPTIONS=--no-grafts ls -l /run/current-system/gc-roots parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 1G \\ + mkpart primary ext2 3M 1.4G \\ set 1 boot on \\ set 1 bios_grub on -echo -n thepassphrase | \\ +echo -n " %luks-passphrase " | \\ cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 - -echo -n thepassphrase | \\ +echo -n " %luks-passphrase " | \\ cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device mkfs.ext4 -L my-root /dev/mapper/the-root-device mount LABEL=my-root /mnt @@ -596,7 +698,7 @@ cp /etc/target-config.scm /mnt/etc/config.scm guix system build /mnt/etc/config.scm guix system init /mnt/etc/config.scm /mnt --no-substitutes sync -reboot\n") +reboot\n")) (define (enter-luks-passphrase marionette) "Return a gexp to be inserted in the basic system test running on MARIONETTE @@ -617,7 +719,8 @@ to enter the LUKS passphrase." ;; when the passphrase should be entered. (wait-for-screen-text #$marionette passphrase-prompt? #:ocrad #$ocrad) - (marionette-type "thepassphrase\n" #$marionette) + (marionette-type #$(string-append %luks-passphrase "\n") + #$marionette) ;; Now wait until we leave the boot screen. This is necessary so ;; we can then be sure we match the "Enter passphrase" prompt from @@ -633,14 +736,15 @@ to enter the LUKS passphrase." (wait-for-screen-text #$marionette passphrase-prompt? #:ocrad #$ocrad #:timeout 60) - (marionette-type "thepassphrase\n" #$marionette) + (marionette-type #$(string-append %luks-passphrase "\n") + #$marionette) ;; Take a screenshot for debugging purposes. (marionette-control (string-append "screendump " #$output "/post-initrd-passphrase.ppm") #$marionette)))))) -(define %test-encrypted-os +(define %test-encrypted-root-os (system-test (name "encrypted-root-os") (description @@ -670,18 +774,18 @@ build (current-guix) and then store a couple of full system images.") (timezone "Europe/Paris") (locale "en_US.UTF-8") - (bootloader (grub-configuration (device "/dev/vdb"))) + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) (kernel-arguments '("console=ttyS0")) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "btrfs")) %base-file-systems)) (users (cons (user-account (name "charlie") (group "users") - (home-directory "/home/charlie") (supplementary-groups '("wheel" "audio" "video"))) %base-user-accounts)) (services (cons (service marionette-service-type @@ -701,7 +805,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts ls -l /run/current-system/gc-roots parted --script /dev/vdb mklabel gpt \\ mkpart primary ext2 1M 3M \\ - mkpart primary ext2 3M 1G \\ + mkpart primary ext2 3M 2G \\ set 1 boot on \\ set 1 bios_grub on mkfs.btrfs -L my-root /dev/vdb2 @@ -730,4 +834,248 @@ build (current-guix) and then store a couple of full system images.") (command (qemu-command/writable-image image))) (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) + +;;; +;;; JFS root file system. +;;; + +(define-os-with-source (%jfs-root-os %jfs-root-os-source) + ;; The OS we want to install. + (use-modules (gnu) (gnu tests) (srfi srfi-1)) + + (operating-system + (host-name "liberigilo") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vdb"))) + (kernel-arguments '("console=ttyS0")) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "jfs")) + %base-file-systems)) + (users (cons (user-account + (name "charlie") + (group "users") + (supplementary-groups '("wheel" "audio" "video"))) + %base-user-accounts)) + (services (cons (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix combinators))))) + %base-services)))) + +(define %jfs-root-installation-script + ;; Shell script of a simple installation. + "\ +. /etc/profile +set -e -x +guix --version + +export GUIX_BUILD_OPTIONS=--no-grafts +ls -l /run/current-system/gc-roots +parted --script /dev/vdb mklabel gpt \\ + mkpart primary ext2 1M 3M \\ + mkpart primary ext2 3M 2G \\ + set 1 boot on \\ + set 1 bios_grub on +jfs_mkfs -L my-root -q /dev/vdb2 +mount /dev/vdb2 /mnt +herd start cow-store /mnt +mkdir /mnt/etc +cp /etc/target-config.scm /mnt/etc/config.scm +guix system build /mnt/etc/config.scm +guix system init /mnt/etc/config.scm /mnt --no-substitutes +sync +reboot\n") + +(define %test-jfs-root-os + (system-test + (name "jfs-root-os") + (description + "Test basic functionality of an OS installed like one would do by hand. +This test is expensive in terms of CPU and storage usage since we need to +build (current-guix) and then store a couple of full system images.") + (value + (mlet* %store-monad ((image (run-install %jfs-root-os + %jfs-root-os-source + #:script + %jfs-root-installation-script)) + (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