Subject: bug#47889: [installer image] grub-install efi fails getting canonical path to /boot/efi on dos-formatted disk

From: Mathieu Othacehe <[email-masked]>
Date: Tue, 27 Apr 2021 18:48:30 +0200

Hello,

Here is a patchset solving this issue and adding a new UEFI system
test. The boot issue was quite complex. Turns out it's related to how
the OVMF firmware saves persistently the UEFI variables.

Regarding the MSDOS/UEFI patch, it is almost identical to what Florian
tested. I chose not to force GPT on UEFI if the user disk is already
MBR formatted, mostly to keep the code readable.

Thanks,

Mathieu
>From c75278d39e977488516507fb8a67c167facda926 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <[email-masked]>
Date: Tue, 27 Apr 2021 17:39:42 +0200
Subject: [PATCH 1/3] installer: Force GPT disk label when UEFI is supported.

* gnu/installer/newt/partition.scm (run-label-page): Force the GPT disk label
when UEFI is supported.
---
 gnu/installer/newt/partition.scm | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 81cf68d782..2bb9b16945 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -95,14 +95,17 @@ DEVICES list."
 
 (define (run-label-page button-text button-callback)
   "Run a page asking the user to select a partition table label."
-  (run-listbox-selection-page
-   #:info-text (G_ "Select a new partition table type. \
+  ;; Force the GPT label if UEFI is supported.
+  (if (efi-installation?)
+      "gpt"
+      (run-listbox-selection-page
+       #:info-text (G_ "Select a new partition table type. \
 Be careful, all data on the disk will be lost.")
-   #:title (G_ "Partition table")
-   #:listbox-items '("msdos" "gpt")
-   #:listbox-item->text identity
-   #:button-text button-text
-   #:button-callback-procedure button-callback))
+       #:title (G_ "Partition table")
+       #:listbox-items '("msdos" "gpt")
+       #:listbox-item->text identity
+       #:button-text button-text
+       #:button-callback-procedure button-callback)))
 
 (define (run-type-page partition)
   "Run a page asking the user to select a partition type."
-- 
2.31.1

>From b2ca61abc2f3faf918a9a4d006cb3d7cd2a71f19 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <[email-masked]>
Date: Sun, 25 Apr 2021 19:06:31 +0200
Subject: [PATCH 2/3] installer: Add MSDOS disk label support on UEFI systems.

* gnu/installer/parted.scm (esp-partition?): Remove the MSDOS check.
(auto-partition!): On MSDOS disks, check if an ESP partition is present. If
that's the case, do not remove it. Otherwise, if UEFI is supported, create
one.
---
 gnu/installer/parted.scm | 45 +++++++++++++++++-----------------------
 1 file changed, 19 insertions(+), 26 deletions(-)

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 9ef263d1f9..6d6e500d71 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -70,6 +70,7 @@
             small-freespace-partition?
             esp-partition?
             boot-partition?
+            efi-installation?
             default-esp-mount-point
 
             with-delay-device-in-use?
@@ -193,12 +194,8 @@ inferior to MAX-SIZE, #f otherwise."
 (define (esp-partition? partition)
   "Return #t if partition has the ESP flag, return #f otherwise."
   (let* ((disk (partition-disk partition))
-         (disk-type (disk-disk-type disk))
-         (has-extended? (disk-type-check-feature
-                         disk-type
-                         DISK-TYPE-FEATURE-EXTENDED)))
+         (disk-type (disk-disk-type disk)))
     (and (data-partition? partition)
-         (not has-extended?)
          (partition-is-flag-available? partition PARTITION-FLAG-ESP)
          (partition-get-flag partition PARTITION-FLAG-ESP))))
 
@@ -918,30 +915,26 @@ exists."
          ;; disk space. Otherwise, set the swap size to 5% of the disk space.
          (swap-size (min default-swap-size five-percent-disk)))
 
-    (if has-extended?
-        ;; msdos - remove everything.
-        (disk-remove-all-partitions disk)
-        ;; gpt - remove everything but esp if it exists.
-        (for-each
-         (lambda (partition)
-           (and (data-partition? partition)
-                (disk-remove-partition* disk partition)))
-         non-boot-partitions))
+    ;; Remove everything but esp if it exists.
+    (for-each
+     (lambda (partition)
+       (and (data-partition? partition)
+            (disk-remove-partition* disk partition)))
+     non-boot-partitions)
 
     (let* ((start-partition
-            (and (not has-extended?)
-                 (if (efi-installation?)
-                     (and (not esp-partition)
-                          (user-partition
-                           (fs-type 'fat32)
-                           (esp? #t)
-                           (size new-esp-size)
-                           (mount-point (default-esp-mount-point))))
+            (if (efi-installation?)
+                (and (not esp-partition)
                      (user-partition
-                      (fs-type 'ext4)
-                      (bootable? #t)
-                      (bios-grub? #t)
-                      (size bios-grub-size)))))
+                      (fs-type 'fat32)
+                      (esp? #t)
+                      (size new-esp-size)
+                      (mount-point (default-esp-mount-point))))
+                (user-partition
+                 (fs-type 'ext4)
+                 (bootable? #t)
+                 (bios-grub? #t)
+                 (size bios-grub-size))))
            (new-partitions
             (cond
              ((or (eq? scheme 'entire-root)
-- 
2.31.1

>From 7ae4219b78906f6be1764f487430680afe8ae8ee Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <[email-masked]>
Date: Tue, 27 Apr 2021 17:30:28 +0200
Subject: [PATCH 3/3] 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.
---
 gnu/installer/tests.scm |  37 +++++++++++---
 gnu/tests/install.scm   | 108 ++++++++++++++++++++++++++++++++++++----
 2 files changed, 128 insertions(+), 17 deletions(-)

diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index f318546a2f..8ccd327a7c 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -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:
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"
-- 
2.31.1