me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
* 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.
This commit is contained in:
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
gnu
installer
tests.scm
tests
install.scm

35
gnu/installer/tests.scm
View file

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

108
gnu/tests/install.scm
View file

@ -36,8 +36,10 @@
#:use-module (gnu packages bootloaders) #:use-module (gnu packages bootloaders)
#:use-module (gnu packages commencement) ;for 'guile-final' #:use-module (gnu packages commencement) ;for 'guile-final'
#:use-module (gnu packages cryptsetup) #:use-module (gnu packages cryptsetup)
#:use-module (gnu packages disk)
#:use-module (gnu packages emacs) #:use-module (gnu packages emacs)
#:use-module (gnu packages emacs-xyz) #:use-module (gnu packages emacs-xyz)
#:use-module (gnu packages firmware)
#: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 openbox)
@ -73,6 +75,7 @@
%test-lvm-separate-home-os %test-lvm-separate-home-os
%test-gui-installed-os %test-gui-installed-os
%test-gui-uefi-installed-os
%test-gui-installed-os-encrypted %test-gui-installed-os-encrypted
%test-gui-installed-desktop-os-encrypted)) %test-gui-installed-desktop-os-encrypted))
@ -206,6 +209,15 @@ guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync sync
reboot\n") 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 (define* (run-install target-os target-os-source
#:key #:key
(script %simple-installation-script) (script %simple-installation-script)
@ -224,6 +236,7 @@ reboot\n")
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(gnu installer tests) (gnu installer tests)
(guix combinators)))) (guix combinators))))
(uefi-support? #f)
(installation-image-type 'efi-raw) (installation-image-type 'efi-raw)
(install-size 'guess) (install-size 'guess)
(target-size (* 2200 MiB))) (target-size (* 2200 MiB)))
@ -235,6 +248,8 @@ packages defined in installation-os."
(mlet* %store-monad ((_ (set-grafting #f)) (mlet* %store-monad ((_ (set-grafting #f))
(system (current-system)) (system (current-system))
(uefi-firmware -> (and uefi-support?
(uefi-firmware system)))
;; Since the installation system has no network access, ;; Since the installation system has no network access,
;; we cheat a little bit by adding TARGET to its GC ;; we cheat a little bit by adding TARGET to its GC
;; roots. This way, we know 'guix system init' will ;; roots. This way, we know 'guix system init' will
@ -273,6 +288,9 @@ packages defined in installation-os."
`(,(which #$(qemu-command system)) `(,(which #$(qemu-command system))
"-no-reboot" "-no-reboot"
"-m" "1200" "-m" "1200"
,@(if #$uefi-firmware
'("-bios" #$uefi-firmware)
'())
#$@(cond #$@(cond
((eq? 'efi-raw installation-image-type) ((eq? 'efi-raw installation-image-type)
#~("-drive" #~("-drive"
@ -322,10 +340,15 @@ packages defined in installation-os."
(gexp->derivation "installation" install (gexp->derivation "installation" install
#:substitutable? #f))) ;too big #: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 "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." 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)) (return #~(let ((image #$image))
;; First we need a writable copy of the image. ;; First we need a writable copy of the image.
(format #t "creating writable image from '~a'...~%" 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") ,@(if (file-exists? "/dev/kvm")
'("-enable-kvm") '("-enable-kvm")
'()) '())
,@(if #$uefi-firmware
'("-bios" #$uefi-firmware)
'())
"-no-reboot" "-m" #$(number->string memory-size) "-no-reboot" "-m" #$(number->string memory-size)
"-drive" "file=disk.img,if=virtio"))))) "-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 (define* (gui-test-program marionette
#:key #:key
(desktop? #f) (desktop? #f)
(encrypted? #f)) (encrypted? #f)
(uefi-support? #f)
(system (%current-system)))
#~(let () #~(let ()
(define (screenshot file) (define (screenshot file)
(marionette-control (string-append "screendump " 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 (marionette-eval* '(choose-partitioning installer-socket
#:encrypted? #$encrypted? #:encrypted? #$encrypted?
#:passphrase #$%luks-passphrase) #:passphrase #$%luks-passphrase
#:uefi-support? #$uefi-support?)
#$marionette) #$marionette)
(screenshot "installer-run.ppm") (screenshot "installer-run.ppm")
@ -1480,9 +1509,43 @@ build (current-guix) and then store a couple of full system images.")
"/dev/vda2") "/dev/vda2")
#$marionette)) #$marionette))
(marionette-eval* '(conclude-installation installer-socket) (marionette-eval* '(start-installation installer-socket)
#$marionette) #$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) (sync)
#t)) #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. ;; Packages needed when installing with an encrypted root.
(list isc-dhcp (list isc-dhcp
lvm2-static cryptsetup-static e2fsck/static lvm2-static cryptsetup-static e2fsck/static
loadkeys-static)) loadkeys-static grub-efi fatfsck/static dosfstools))
(define installation-os-for-gui-tests (define installation-os-for-gui-tests
;; Operating system that contains all of %EXTRA-PACKAGES, needed for the ;; 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)))) (guix combinators))))
(define* (installation-target-os-for-gui-tests (define* (installation-target-os-for-gui-tests
#:key (encrypted? #f)) #:key
(encrypted? #f)
(uefi-support? #f))
(operating-system (operating-system
(inherit %minimal-os-on-vda) (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 (users (append (list (user-account
(name "alice") (name "alice")
(comment "Bob's sister") (comment "Bob's sister")
@ -1569,6 +1645,7 @@ build (current-guix) and then store a couple of full system images.")
#:key #:key
(desktop? #f) (desktop? #f)
(encrypted? #f) (encrypted? #f)
(uefi-support? #f)
target-os target-os
(install-size 'guess) (install-size 'guess)
(target-size (* 2200 MiB))) (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) ((image (run-install target-os '(this is unused)
#:script #f #:script #f
#:os installation-os-for-gui-tests #:os installation-os-for-gui-tests
#:uefi-support? uefi-support?
#:install-size install-size #:install-size install-size
#:target-size target-size #:target-size target-size
#:installation-image-type #:installation-image-type
@ -1590,8 +1668,11 @@ build (current-guix) and then store a couple of full system images.")
(gui-test-program (gui-test-program
marionette marionette
#:desktop? desktop? #:desktop? desktop?
#:encrypted? encrypted?)))) #:encrypted? encrypted?
(command (qemu-command/writable-image image #:memory-size 512))) #:uefi-support? uefi-support?))))
(command (qemu-command/writable-image image
#:uefi-support? uefi-support?
#:memory-size 512)))
(run-basic-test target-os command name (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
@ -1602,6 +1683,15 @@ build (current-guix) and then store a couple of full system images.")
"gui-installed-os" "gui-installed-os"
#:target-os (installation-target-os-for-gui-tests))) #: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 (define %test-gui-installed-os-encrypted
(guided-installation-test (guided-installation-test
"gui-installed-os-encrypted" "gui-installed-os-encrypted"