me
/
guix
Archived
1
0
Fork 0
Code

tests: Add gui-uefi-installed-os test. 

* gnu/installer/tests.scm (conclude-installation): Rename it into ...
(start-installation): ... this new procedure.
(complete-installation): New procedure.
(choose-partitioning): Add an uefi-support? argument.
* gnu/tests/install.scm (uefi-firmware): New procedure.
(run-install, qemu-command/writable-image, gui-test-program,
installation-target-os-for-gui-tests): Add an uefi-support? argument.
(%extra-packages): Add grub-efi, fatfsck/static and dosfstools.
(%test-gui-installed-os): New variable.
master
Mathieu Othacehe 2021-04-27 17:30:28 +02:00
parent af7a615c5b
commit 95b3fc12bc
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 128 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
gnu/installer/tests.scm
View File

@ -37,7 +37,8 @@
enter-host-name+passwords
choose-services
choose-partitioning
conclude-installation
start-installation
complete-installation
edit-configuration-file))
@ -281,14 +282,19 @@ instrumented for further testing."
(define* (choose-partitioning port
#:key
(encrypted? #t)
(uefi-support? #f)
(passphrase "thepassphrase")
(edit-configuration-file
edit-configuration-file))
"Converse over PORT to choose the partitioning method. When ENCRYPTED? is
true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
When UEFI-SUPPORT? is true, assume that we are running the installation tests
on an UEFI capable machine.
This conversation stops when the user partitions have been formatted, right
before the installer generates the configuration file and shows it in a dialog
box."
box. "
(converse port
((list-selection (title "Partitioning method")
(multiple-choices? #f)
@ -306,11 +312,15 @@ box."
disks))
;; The "Partition table" dialog pops up only if there's not already a
;; partition table.
;; partition table and if the system does not support UEFI.
((list-selection (title "Partition table")
(multiple-choices? #f)
(items _))
;; When UEFI is supported, the partition is forced to GPT by the
;; installer.
(not uefi-support?)
"gpt")
((list-selection (title "Partition scheme")
(multiple-choices? #f)
(items (,one-partition _ ...)))
@ -338,10 +348,10 @@ box."
;; UUIDs before it generates the configuration file.
(values))))
(define (conclude-installation port)
"Conclude the installation by checking over PORT that we get the generated
(define (start-installation port)
"Start the installation by checking over PORT that we get the generated
configuration file, accepting it and starting the installation, and then
receiving the final messages once the 'guix system init' process has
receiving the pause message once the 'guix system init' process has
completed."
;; Assume the previous message received was 'starting-final-step'; here we
;; send the reply to that message, which lets the installer continue.
@ -355,8 +365,19 @@ completed."
(file ,configuration-file))
(edit-configuration-file configuration-file))
((pause) ;"Press Enter to continue."
#t)
((installation-complete) ;congratulations!
(values))))
(define (complete-installation port)
"Complete the installation by replying to the installer pause message and
waiting for the installation-complete message."
;; Assume the previous message received was 'pause'; here we send the reply
;; to that message, which lets the installer continue.
(write #t port)
(newline port)
(force-output port)
(converse port
((installation-complete)
(values))))
;;; Local Variables:

108
gnu/tests/install.scm
View File

@ -36,8 +36,10 @@
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages commencement) ;for 'guile-final'
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages disk)
#:use-module (gnu packages emacs)
#:use-module (gnu packages emacs-xyz)
#:use-module (gnu packages firmware)
#:use-module (gnu packages linux)
#:use-module (gnu packages ocr)
#:use-module (gnu packages openbox)
@ -73,6 +75,7 @@
%test-lvm-separate-home-os
%test-gui-installed-os
%test-gui-uefi-installed-os
%test-gui-installed-os-encrypted
%test-gui-installed-desktop-os-encrypted))
@ -206,6 +209,15 @@ guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n")
(define (uefi-firmware system)
"Return the appropriate QEMU OVMF UEFI firmware for the given SYSTEM."
(cond
((string-prefix? "x86_64" system)
(file-append ovmf "/share/firmware/ovmf_x64.bin"))
((string-prefix? "i686" system)
(file-append ovmf "/share/firmware/ovmf_ia32.bin"))
(else #f)))
(define* (run-install target-os target-os-source
#:key
(script %simple-installation-script)
@ -224,6 +236,7 @@ reboot\n")
#:imported-modules '((gnu services herd)
(gnu installer tests)
(guix combinators))))
(uefi-support? #f)
(installation-image-type 'efi-raw)
(install-size 'guess)
(target-size (* 2200 MiB)))
@ -235,6 +248,8 @@ packages defined in installation-os."
(mlet* %store-monad ((_ (set-grafting #f))
(system (current-system))
(uefi-firmware -> (and uefi-support?
(uefi-firmware system)))
;; Since the installation system has no network access,
;; we cheat a little bit by adding TARGET to its GC
;; roots. This way, we know 'guix system init' will
@ -273,6 +288,9 @@ packages defined in installation-os."
`(,(which #$(qemu-command system))
"-no-reboot"
"-m" "1200"
,@(if #$uefi-firmware
'("-bios" #$uefi-firmware)
'())
#$@(cond
((eq? 'efi-raw installation-image-type)
#~("-drive"
@ -322,10 +340,15 @@ packages defined in installation-os."
(gexp->derivation "installation" install
#:substitutable? #f))) ;too big
(define* (qemu-command/writable-image image #:key (memory-size 256))
(define* (qemu-command/writable-image image
#:key
(uefi-support? #f)
(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 has access to MEMORY-SIZE MiB of RAM."
(mlet %store-monad ((system (current-system)))
(mlet* %store-monad ((system (current-system))
(uefi-firmware -> (and uefi-support?
(uefi-firmware system))))
(return #~(let ((image #$image))
;; First we need a writable copy of the image.
(format #t "creating writable image from '~a'...~%" image)
@ -343,6 +366,9 @@ IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM."
,@(if (file-exists? "/dev/kvm")
'("-enable-kvm")
'())
,@(if #$uefi-firmware
'("-bios" #$uefi-firmware)
'())
"-no-reboot" "-m" #$(number->string memory-size)
"-drive" "file=disk.img,if=virtio")))))
@ -1400,7 +1426,9 @@ build (current-guix) and then store a couple of full system images.")
(define* (gui-test-program marionette
#:key
(desktop? #f)
(encrypted? #f))
(encrypted? #f)
(uefi-support? #f)
(system (%current-system)))
#~(let ()
(define (screenshot file)
(marionette-control (string-append "screendump " file)
@ -1466,7 +1494,8 @@ build (current-guix) and then store a couple of full system images.")
(marionette-eval* '(choose-partitioning installer-socket
#:encrypted? #$encrypted?
#:passphrase #$%luks-passphrase)
#:passphrase #$%luks-passphrase
#:uefi-support? #$uefi-support?)
#$marionette)
(screenshot "installer-run.ppm")
@ -1480,9 +1509,43 @@ build (current-guix) and then store a couple of full system images.")
"/dev/vda2")
#$marionette))
(marionette-eval* '(conclude-installation installer-socket)
(marionette-eval* '(start-installation installer-socket)
#$marionette)
;; XXX: The grub-install process uses efibootmgr to add an UEFI Guix
;; boot entry. The corresponding UEFI variable is stored in RAM, and
;; possibly saved persistently on QEMU reboot in a NvVars file, see:
;; https://lists.gnu.org/archive/html/qemu-discuss/2018-04/msg00045.html.
;;
;; As we are running QEMU with the no-reboot flag, this variable is
;; never saved persistently, QEMU fails to boot the installed system and
;; an UEFI shell is displayed instead.
;;
;; To make the installed UEFI system bootable, register Grub as the
;; default UEFI boot entry, in the same way as if grub-install was
;; invoked with the --removable option.
(when #$uefi-support?
(marionette-eval*
'(begin
(use-modules (ice-9 match))
(let ((targets (cond
((string-prefix? "x86_64" #$system)
'("grubx64.efi" "BOOTX64.EFI"))
((string-prefix? "i686" #$system)
'("grubia32.efi" "BOOTIA32.EFI"))
(else #f))))
(match targets
((src dest)
(rename-file "/mnt/boot/efi/EFI/Guix"
"/mnt/boot/efi/EFI/BOOT")
(rename-file
(string-append "/mnt/boot/efi/EFI/BOOT/" src)
(string-append "/mnt/boot/efi/EFI/BOOT/" dest)))
(_ #f))))
#$marionette))
(marionette-eval* '(complete-installation installer-socket)
#$marionette)
(sync)
#t))
@ -1490,7 +1553,7 @@ build (current-guix) and then store a couple of full system images.")
;; Packages needed when installing with an encrypted root.
(list isc-dhcp
lvm2-static cryptsetup-static e2fsck/static
loadkeys-static))
loadkeys-static grub-efi fatfsck/static dosfstools))
(define installation-os-for-gui-tests
;; Operating system that contains all of %EXTRA-PACKAGES, needed for the
@ -1509,9 +1572,22 @@ build (current-guix) and then store a couple of full system images.")
(guix combinators))))
(define* (installation-target-os-for-gui-tests
#:key (encrypted? #f))
#:key
(encrypted? #f)
(uefi-support? #f))
(operating-system
(inherit %minimal-os-on-vda)
(file-systems `(,(file-system
(device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
,@(if uefi-support?
(list (file-system
(device (uuid "1234-ABCD" 'fat))
(mount-point "/boot/efi")
(type "vfat")))
'())
,@%base-file-systems))
(users (append (list (user-account
(name "alice")
(comment "Bob's sister")
@ -1569,6 +1645,7 @@ build (current-guix) and then store a couple of full system images.")
#:key
(desktop? #f)
(encrypted? #f)
(uefi-support? #f)
target-os
(install-size 'guess)
(target-size (* 2200 MiB)))
@ -1581,6 +1658,7 @@ build (current-guix) and then store a couple of full system images.")
((image (run-install target-os '(this is unused)
#:script #f
#:os installation-os-for-gui-tests
#:uefi-support? uefi-support?
#:install-size install-size
#:target-size target-size
#:installation-image-type
@ -1590,8 +1668,11 @@ build (current-guix) and then store a couple of full system images.")
(gui-test-program
marionette
#:desktop? desktop?
#:encrypted? encrypted?))))
(command (qemu-command/writable-image image #:memory-size 512)))
#:encrypted? encrypted?
#:uefi-support? uefi-support?))))
(command (qemu-command/writable-image image
#:uefi-support? uefi-support?
#:memory-size 512)))
(run-basic-test target-os command name
#:initialization (and encrypted? enter-luks-passphrase)
#:root-password %root-password
@ -1602,6 +1683,15 @@ build (current-guix) and then store a couple of full system images.")
"gui-installed-os"
#:target-os (installation-target-os-for-gui-tests)))
;; Test the UEFI installation of Guix System using the graphical installer.
(define %test-gui-uefi-installed-os
(guided-installation-test
"gui-uefi-installed-os"
#:uefi-support? #t
#:target-os (installation-target-os-for-gui-tests
#:uefi-support? #t)
#:target-size (* 3200 MiB)))
(define %test-gui-installed-os-encrypted
(guided-installation-test
"gui-installed-os-encrypted"