ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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
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 @@ (define-module (gnu installer tests)
enter-host-name+passwords
choose-services
choose-partitioning
conclude-installation
start-installation
complete-installation
edit-configuration-file))
@ -281,14 +282,19 @@ (define (edit exp)
(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 @@ (define* (choose-partitioning port
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 @@ (define* (choose-partitioning port
;; 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 @@ (define (conclude-installation port)
(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 @@ (define-module (gnu tests install)
#: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 @@ (define-module (gnu tests install)
%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 @@ (define %extlinux-gpt-installation-script
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 @@ (define* (run-install target-os target-os-source
#: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 @@ (define* (run-install target-os target-os-source
(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 @@ (define marionette
`(,(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 @@ (define marionette
(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 @@ (define* (qemu-command/writable-image image #:key (memory-size 256))
,@(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 @@ (define %root-password "foo")
(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 @@ (define-syntax-rule (marionette-eval* exp marionette)
(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 @@ (define-syntax-rule (marionette-eval* exp marionette)
"/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 @@ (define %extra-packages
;; 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 @@ (define installation-os-for-gui-tests
(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 @@ (define* (guided-installation-test name
#:key
(desktop? #f)
(encrypted? #f)
(uefi-support? #f)
target-os
(install-size 'guess)
(target-size (* 2200 MiB)))
@ -1581,6 +1658,7 @@ (define* (guided-installation-test name
((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 @@ (define* (guided-installation-test name
(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 @@ (define %test-gui-installed-os
"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"