diff options
Diffstat (limited to 'gnu/tests/install.scm')
| -rw-r--r-- | gnu/tests/install.scm | 108 |
1 files changed, 99 insertions, 9 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 4b8963eadd..b5263f5f0d 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -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" |