Merge branch 'master' into core-updates

5 files changed, 390 insertions, 180 deletions

diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index 9570d6dd18..498022f6db 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -18,8 +18,12 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu build bootloader)
+  #:use-module (guix build utils)
+  #:use-module (guix utils)
   #:use-module (ice-9 binary-ports)
-  #:export (write-file-on-device))
+  #:use-module (ice-9 format)
+  #:export (write-file-on-device
+            install-efi-loader))
 
 
 ;;;
@@ -36,3 +40,53 @@
             (seek output offset SEEK_SET)
             (put-bytevector output bv))
           #:binary #t)))))
+
+
+;;;
+;;; EFI bootloader.
+;;;
+
+(define (install-efi grub grub-config esp)
+  "Write a self-contained GRUB EFI loader to the mounted ESP using GRUB-CONFIG."
+  (let* ((system %host-type)
+         ;; Hard code the output location to a well-known path recognized by
+         ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+         ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+         (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
+         (efi-directory (string-append esp "/EFI/BOOT"))
+         ;; Map grub target names to boot file names.
+         (efi-targets (cond ((string-prefix? "x86_64" system)
+                             '("x86_64-efi" . "BOOTX64.EFI"))
+                            ((string-prefix? "i686" system)
+                             '("i386-efi" . "BOOTIA32.EFI"))
+                            ((string-prefix? "armhf" system)
+                             '("arm-efi" . "BOOTARM.EFI"))
+                            ((string-prefix? "aarch64" system)
+                             '("arm64-efi" . "BOOTAA64.EFI")))))
+    ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
+    (setenv "TMPDIR" esp)
+
+    (mkdir-p efi-directory)
+    (invoke grub-mkstandalone "-O" (car efi-targets)
+            "-o" (string-append efi-directory "/"
+                                (cdr efi-targets))
+            ;; Graft the configuration file onto the image.
+            (string-append "boot/grub/grub.cfg=" grub-config))))
+
+(define (install-efi-loader grub-efi esp)
+  "Install in ESP directory the given GRUB-EFI bootloader.  Configure it to
+load the Grub bootloader located in the 'Guix_image' root partition."
+  (let ((grub-config "grub.cfg"))
+    (call-with-output-file grub-config
+      (lambda (port)
+        ;; Create a tiny configuration file telling the embedded grub where to
+        ;; load the real thing.  XXX This is quite fragile, and can prevent
+        ;; the image from booting when there's more than one volume with this
+        ;; label present.  Reproducible almost-UUIDs could reduce the risk
+        ;; (not eliminate it).
+        (format port
+                "insmod part_msdos~@
+               search --set=root --label Guix_image~@
+               configfile /boot/grub/grub.cfg~%")))
+    (install-efi grub-efi grub-config esp)
+    (delete-file grub-config)))
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index bbea4c766e..b920e8fc62 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -98,6 +98,47 @@ takes a bytevector and returns #t when it's a valid superblock."
 (define null-terminated-latin1->string
   (cut latin1->string <> zero?))
 
+(define (bytevector-utf16-length bv)
+  "Given a bytevector BV containing a NUL-terminated UTF16-encoded string,
+determine where the NUL terminator is and return its index.  If there's no
+NUL terminator, return the size of the bytevector."
+  (let ((length (bytevector-length bv)))
+    (let loop ((index 0))
+      (if (< index length)
+          (if (zero? (bytevector-u16-ref bv index 'little))
+              index
+              (loop (+ index 2)))
+          length))))
+
+(define* (bytevector->u16-list bv endianness #:optional (index 0))
+  (if (< index (bytevector-length bv))
+      (cons (bytevector-u16-ref bv index endianness)
+            (bytevector->u16-list bv endianness (+ index 2)))
+      '()))
+
+;; The initrd doesn't have iconv data, so do the conversion ourselves.
+(define (utf16->string bv endianness)
+  (list->string
+   (map integer->char
+        (reverse
+         (let loop ((remainder (bytevector->u16-list bv endianness))
+                    (result '()))
+             (match remainder
+              (() result)
+              ((a) (cons a result))
+              ((a b x ...)
+               (if (and (>= a #xD800) (< a #xDC00) ; high surrogate
+                        (>= b #xDC00) (< b #xE000)) ; low surrogate
+                   (loop x (cons (+ #x10000
+                                    (* #x400 (- a #xD800))
+                                    (- b #xDC00))
+                                 result))
+                   (loop (cons b x) (cons a result))))))))))
+
+(define (null-terminated-utf16->string bv endianness)
+  (utf16->string (sub-bytevector bv 0 (bytevector-utf16-length bv))
+                 endianness))
+
 
 ;;;
 ;;; Ext2 file systems.
@@ -377,7 +418,9 @@ if DEVICE does not contain an F2FS file system."
 (define (f2fs-superblock-volume-name sblock)
   "Return the volume name of SBLOCK as a string of at most 512 characters, or
 #f if SBLOCK has no volume name."
-  (utf16->string (sub-bytevector sblock (- (+ #x470 12) #x400) 512) %f2fs-endianness))
+  (null-terminated-utf16->string
+   (sub-bytevector sblock (- (+ #x470 12) #x400) 512)
+   %f2fs-endianness))
 
 (define (check-f2fs-file-system device)
   "Return the health of a F2FS file system on DEVICE."
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
new file mode 100644
index 0000000000..fe8e11aa1b
--- /dev/null
+++ b/gnu/build/image.scm
@@ -0,0 +1,273 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build image)
+  #:use-module (guix build store-copy)
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (guix store database)
+  #:use-module (gnu build bootloader)
+  #:use-module (gnu build install)
+  #:use-module (gnu build linux-boot)
+  #:use-module (gnu image)
+  #:use-module (gnu system uuid)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (make-partition-image
+            genimage
+            initialize-efi-partition
+            initialize-root-partition
+
+            make-iso9660-image))
+
+(define (sexp->partition sexp)
+  "Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
+<partition> record."
+  (match sexp
+    ((size file-system label uuid)
+     (partition (size size)
+                (file-system file-system)
+                (label label)
+                (uuid uuid)))))
+
+(define (size-in-kib size)
+  "Convert SIZE expressed in bytes, to kilobytes and return it as a string."
+  (number->string
+   (inexact->exact (ceiling (/ size 1024)))))
+
+(define (estimate-partition-size root)
+  "Given the ROOT directory, evalute and return its size.  As this doesn't
+take the partition metadata size into account, take a 25% margin."
+  (* 1.25 (file-size root)))
+
+(define* (make-ext4-image partition target root
+                          #:key
+                          (owner-uid 0)
+                          (owner-gid 0))
+  "Handle the creation of EXT4 partition images. See 'make-partition-image'."
+  (let ((size (partition-size partition))
+        (label (partition-label partition))
+        (uuid (partition-uuid partition))
+        (options "lazy_itable_init=1,lazy_journal_init=1"))
+    (invoke "mke2fs" "-t" "ext4" "-d" root
+            "-L" label "-U" (uuid->string uuid)
+            "-E" (format #f "root_owner=~a:~a,~a"
+                         owner-uid owner-gid options)
+            target
+            (format #f "~ak"
+                    (size-in-kib
+                     (if (eq? size 'guess)
+                         (estimate-partition-size root)
+                         size))))))
+
+(define* (make-vfat-image partition target root)
+  "Handle the creation of VFAT partition images.  See 'make-partition-image'."
+  (let ((size (partition-size partition))
+        (label (partition-label partition)))
+    (invoke "mkdosfs" "-n" label "-C" target "-F" "16" "-S" "1024"
+            (size-in-kib
+             (if (eq? size 'guess)
+                 (estimate-partition-size root)
+                 size)))
+    (for-each (lambda (file)
+                (unless (member file '("." ".."))
+                  (invoke "mcopy" "-bsp" "-i" target
+                          (string-append root "/" file)
+                          (string-append "::" file))))
+              (scandir root))))
+
+(define* (make-partition-image partition-sexp target root)
+  "Create and return the image of PARTITION-SEXP as TARGET.  Use the given
+ROOT directory to populate the image."
+  (let* ((partition (sexp->partition partition-sexp))
+         (type (partition-file-system partition)))
+    (cond
+     ((string=? type "ext4")
+      (make-ext4-image partition target root))
+     ((string=? type "vfat")
+      (make-vfat-image partition target root))
+     (else
+      (format (current-error-port)
+              "Unsupported partition type~%.")))))
+
+(define* (genimage config target)
+  "Use genimage to generate in TARGET directory, the image described in the
+given CONFIG file."
+  ;; genimage needs a 'root' directory.
+  (mkdir "root")
+  (invoke "genimage" "--config" config
+          "--outputpath" target))
+
+(define* (register-closure prefix closure
+                           #:key
+                           (deduplicate? #t) (reset-timestamps? #t)
+                           (schema (sql-schema)))
+  "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
+target store and CLOSURE is the name of a file containing a reference graph as
+produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
+true, reset timestamps on store files and, if DEDUPLICATE? is true,
+deduplicates files common to CLOSURE and the rest of PREFIX."
+  (let ((items (call-with-input-file closure read-reference-graph)))
+    (register-items items
+                    #:prefix prefix
+                    #:deduplicate? deduplicate?
+                    #:reset-timestamps? reset-timestamps?
+                    #:registration-time %epoch
+                    #:schema schema)))
+
+(define* (initialize-efi-partition root
+                                   #:key
+                                   bootloader-package
+                                   #:allow-other-keys)
+  "Install in ROOT directory, an EFI loader using BOOTLOADER-PACKAGE."
+  (install-efi-loader bootloader-package root))
+
+(define* (initialize-root-partition root
+                                    #:key
+                                    bootcfg
+                                    bootcfg-location
+                                    (deduplicate? #t)
+                                    references-graphs
+                                    (register-closures? #t)
+                                    system-directory
+                                    #:allow-other-keys)
+  "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
+install the bootloader configuration.
+
+If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store.  If
+DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
+rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
+of the directory of the 'system' derivation."
+  (populate-root-file-system system-directory root)
+  (populate-store references-graphs root)
+
+  (when register-closures?
+    (for-each (lambda (closure)
+                (register-closure root
+                                  closure
+                                  #:reset-timestamps? #t
+                                  #:deduplicate? deduplicate?))
+              references-graphs))
+
+  (when bootcfg
+    (install-boot-config bootcfg bootcfg-location root)))
+
+(define* (make-iso9660-image xorriso grub-mkrescue-environment
+                             grub bootcfg system-directory root target
+                             #:key (volume-id "Guix_image") (volume-uuid #f)
+                             register-closures? (references-graphs '())
+                             (compression? #t))
+  "Given a GRUB package, creates an iso image as TARGET, using BOOTCFG as
+GRUB configuration and OS-DRV as the stuff in it."
+  (define grub-mkrescue
+    (string-append grub "/bin/grub-mkrescue"))
+
+  (define grub-mkrescue-sed.sh
+    (string-append (getcwd) "/" "grub-mkrescue-sed.sh"))
+
+  ;; Use a modified version of grub-mkrescue-sed.sh, see below.
+  (copy-file (string-append xorriso
+                            "/bin/grub-mkrescue-sed.sh")
+             grub-mkrescue-sed.sh)
+
+  ;; Force grub-mkrescue-sed.sh to use the build directory instead of /tmp
+  ;; that is read-only inside the build container.
+  (substitute* grub-mkrescue-sed.sh
+    (("/tmp/") (string-append (getcwd) "/"))
+    (("MKRESCUE_SED_XORRISO_ARGS \\$x")
+     (format #f "MKRESCUE_SED_XORRISO_ARGS $(echo $x | sed \"s|/tmp|~a|\")"
+             (getcwd))))
+
+  ;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
+  ;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
+  ;; those files.  The epoch for FAT is Jan. 1st 1980, not 1970, so choose
+  ;; that.
+  (setenv "SOURCE_DATE_EPOCH"
+          (number->string
+           (time-second
+            (date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
+
+  ;; Our patched 'grub-mkrescue' honors this environment variable and passes
+  ;; it to 'mformat', which makes it the serial number of 'efi.img'.  This
+  ;; allows for deterministic builds.
+  (setenv "GRUB_FAT_SERIAL_NUMBER"
+          (number->string (if volume-uuid
+
+                              ;; On 32-bit systems the 2nd argument must be
+                              ;; lower than 2^32.
+                              (string-hash (iso9660-uuid->string volume-uuid)
+                                           (- (expt 2 32) 1))
+
+                              #x77777777)
+                          16))
+
+  (setenv "MKRESCUE_SED_MODE" "original")
+  (setenv "MKRESCUE_SED_XORRISO" (string-append xorriso "/bin/xorriso"))
+  (setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
+
+  (for-each (match-lambda
+              ((name . value) (setenv name value)))
+            grub-mkrescue-environment)
+
+  (apply invoke grub-mkrescue
+         (string-append "--xorriso=" grub-mkrescue-sed.sh)
+         "-o" target
+         (string-append "boot/grub/grub.cfg=" bootcfg)
+         root
+         "--"
+         ;; Set all timestamps to 1.
+         "-volume_date" "all_file_dates" "=1"
+
+         `(,@(if compression?
+                 '(;; ‘zisofs’ compression reduces the total image size by
+                   ;; ~60%.
+                   "-zisofs" "level=9:block_size=128k" ; highest compression
+                   ;; It's transparent to our Linux-Libre kernel but not to
+                   ;; GRUB.  Don't compress the kernel, initrd, and other
+                   ;; files read by grub.cfg, as well as common
+                   ;; already-compressed file names.
+                   "-find" "/" "-type" "f"
+                   ;; XXX Even after "--" above, and despite documentation
+                   ;; claiming otherwise, "-or" is stolen by grub-mkrescue
+                   ;; which then chokes on it (as ‘-o …’) and dies.  Don't use
+                   ;; "-or".
+                   "-not" "-wholename" "/boot/*"
+                   "-not" "-wholename" "/System/*"
+                   "-not" "-name" "unicode.pf2"
+                   "-not" "-name" "bzImage"
+                   "-not" "-name" "*.gz"   ; initrd & all man pages
+                   "-not" "-name" "*.png"  ; includes grub-image.png
+                   "-exec" "set_filter" "--zisofs"
+                   "--")
+                 '())
+           "-volid" ,(string-upcase volume-id)
+           ,@(if volume-uuid
+             `("-volume_date" "uuid"
+               ,(string-filter (lambda (value)
+                                 (not (char=? #\- value)))
+                               (iso9660-uuid->string
+                                volume-uuid)))
+             '()))))
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index d46b588f53..87aa5d68da 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,7 +25,6 @@
   #:export (install-boot-config
             evaluate-populate-directive
             populate-root-file-system
-            register-closure
             install-database-and-gc-roots
             populate-single-profile-directory))
 
@@ -51,9 +50,14 @@ that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
     (copy-file bootcfg pivot)
     (rename-file pivot target)))
 
-(define (evaluate-populate-directive directive target)
+(define* (evaluate-populate-directive directive target
+                                      #:key
+                                      (default-gid 0)
+                                      (default-uid 0))
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
-directory TARGET."
+directory TARGET.  DEFAULT-UID and DEFAULT-GID are the default UID and GID in
+the context of the caller.  If the directive matches those defaults then,
+'chown' won't be run."
   (let loop ((directive directive))
     (catch 'system-error
       (lambda ()
@@ -63,7 +67,12 @@ directory TARGET."
           (('directory name uid gid)
            (let ((dir (string-append target name)))
              (mkdir-p dir)
-             (chown dir uid gid)))
+             ;; If called from a context without "root" permissions, "chown"
+             ;; to root will fail.  In that case, do not try to run "chown"
+             ;; and assume that the file will be chowned elsewhere (when
+             ;; interned in the store for instance).
+             (or (and (= uid default-uid) (= gid default-gid))
+                 (chown dir uid gid))))
           (('directory name uid gid mode)
            (loop `(directory ,name ,uid ,gid))
            (chmod (string-append target name) mode))
@@ -98,9 +107,7 @@ directory TARGET."
 (define (directives store)
   "Return a list of directives to populate the root file system that will host
 STORE."
-  `(;; Note: the store's GID is fixed precisely so we can set it here rather
-    ;; than at activation time.
-    (directory ,store 0 30000 #o1775)
+  `((directory ,store 0 0 #o1775)
 
     (directory "/etc")
     (directory "/var/log")                          ; for shepherd
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index d2bf7418fd..433b5a7e8d 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -27,6 +27,7 @@
   #:use-module (guix build store-copy)
   #:use-module (guix build syscalls)
   #:use-module (guix store database)
+  #:use-module (gnu build bootloader)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
   #:use-module (gnu system uuid)
@@ -57,8 +58,7 @@
             estimated-partition-size
             root-partition-initializer
             initialize-partition-table
-            initialize-hard-disk
-            make-iso9660-image))
+            initialize-hard-disk))
 
 ;;; Commentary:
 ;;;
@@ -439,159 +439,6 @@ system that is passed to 'populate-root-file-system'."
     (mkdir-p directory)
     (symlink bootcfg (string-append directory "/bootcfg"))))
 
-(define (install-efi grub esp config-file)
-  "Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
-  (let* ((system %host-type)
-         ;; Hard code the output location to a well-known path recognized by
-         ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
-         ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
-         (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
-         (efi-directory (string-append esp "/EFI/BOOT"))
-         ;; Map grub target names to boot file names.
-         (efi-targets (cond ((string-prefix? "x86_64" system)
-                             '("x86_64-efi" . "BOOTX64.EFI"))
-                            ((string-prefix? "i686" system)
-                             '("i386-efi" . "BOOTIA32.EFI"))
-                            ((string-prefix? "armhf" system)
-                             '("arm-efi" . "BOOTARM.EFI"))
-                            ((string-prefix? "aarch64" system)
-                             '("arm64-efi" . "BOOTAA64.EFI")))))
-    ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
-    (setenv "TMPDIR" esp)
-
-    (mkdir-p efi-directory)
-    (invoke grub-mkstandalone "-O" (car efi-targets)
-            "-o" (string-append efi-directory "/"
-                                (cdr efi-targets))
-            ;; Graft the configuration file onto the image.
-            (string-append "boot/grub/grub.cfg=" config-file))))
-
-(define* (make-iso9660-image xorriso grub-mkrescue-environment
-                             grub config-file os-drv target
-                             #:key (volume-id "Guix_image") (volume-uuid #f)
-                             register-closures? (closures '()))
-  "Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
-GRUB configuration and OS-DRV as the stuff in it."
-  (define grub-mkrescue
-    (string-append grub "/bin/grub-mkrescue"))
-
-  (define grub-mkrescue-sed.sh
-    (string-append xorriso "/bin/grub-mkrescue-sed.sh"))
-
-  (define target-store
-    (string-append "/tmp/root" (%store-directory)))
-
-  (define items
-    ;; The store items to add to the image.
-    (delete-duplicates
-     (append-map (lambda (closure)
-                   (map store-info-item
-                        (call-with-input-file (string-append "/xchg/" closure)
-                          read-reference-graph)))
-                 closures)))
-
-  (populate-root-file-system os-drv "/tmp/root")
-  (mount (%store-directory) target-store "" MS_BIND)
-
-  (when register-closures?
-    (display "registering closures...\n")
-    (for-each (lambda (closure)
-                (register-closure
-                 "/tmp/root"
-                 (string-append "/xchg/" closure)
-
-                 ;; TARGET-STORE is a read-only bind-mount so we shouldn't try
-                 ;; to modify it.
-                 #:deduplicate? #f
-                 #:reset-timestamps? #f))
-              closures)
-    (register-bootcfg-root "/tmp/root" config-file))
-
-  ;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
-  ;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
-  ;; those files.  The epoch for FAT is Jan. 1st 1980, not 1970, so choose
-  ;; that.
-  (setenv "SOURCE_DATE_EPOCH"
-          (number->string
-           (time-second
-            (date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
-
-  ;; Our patched 'grub-mkrescue' honors this environment variable and passes
-  ;; it to 'mformat', which makes it the serial number of 'efi.img'.  This
-  ;; allows for deterministic builds.
-  (setenv "GRUB_FAT_SERIAL_NUMBER"
-          (number->string (if volume-uuid
-
-                              ;; On 32-bit systems the 2nd argument must be
-                              ;; lower than 2^32.
-                              (string-hash (iso9660-uuid->string volume-uuid)
-                                           (- (expt 2 32) 1))
-
-                              #x77777777)
-                          16))
-
-  (setenv "MKRESCUE_SED_MODE" "original")
-  (setenv "MKRESCUE_SED_XORRISO" (string-append xorriso
-                                                "/bin/xorriso"))
-  (setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
-  (for-each (match-lambda
-             ((name . value) (setenv name value)))
-            grub-mkrescue-environment)
-
-  (let ((pipe
-         (apply open-pipe* OPEN_WRITE
-                grub-mkrescue
-                (string-append "--xorriso=" grub-mkrescue-sed.sh)
-                "-o" target
-                (string-append "boot/grub/grub.cfg=" config-file)
-                "etc=/tmp/root/etc"
-                "var=/tmp/root/var"
-                "run=/tmp/root/run"
-                ;; /mnt is used as part of the installation
-                ;; process, as the mount point for the target
-                ;; file system, so create it.
-                "mnt=/tmp/root/mnt"
-                "-path-list" "-"
-                "--"
-
-                ;; Set all timestamps to 1.
-                "-volume_date" "all_file_dates" "=1"
-
-                ;; ‘zisofs’ compression reduces the total image size by ~60%.
-                "-zisofs" "level=9:block_size=128k" ; highest compression
-                ;; It's transparent to our Linux-Libre kernel but not to GRUB.
-                ;; Don't compress the kernel, initrd, and other files read by
-                ;; grub.cfg, as well as common already-compressed file names.
-                "-find" "/" "-type" "f"
-                ;; XXX Even after "--" above, and despite documentation claiming
-                ;; otherwise, "-or" is stolen by grub-mkrescue which then chokes
-                ;; on it (as ‘-o …’) and dies.  Don't use "-or".
-                "-not" "-wholename" "/boot/*"
-                "-not" "-wholename" "/System/*"
-                "-not" "-name" "unicode.pf2"
-                "-not" "-name" "bzImage"
-                "-not" "-name" "*.gz"   ; initrd & all man pages
-                "-not" "-name" "*.png"  ; includes grub-image.png
-                "-exec" "set_filter" "--zisofs"
-                "--"
-
-                "-volid" (string-upcase volume-id)
-                (if volume-uuid
-                    `("-volume_date" "uuid"
-                      ,(string-filter (lambda (value)
-                                        (not (char=? #\- value)))
-                                      (iso9660-uuid->string
-                                       volume-uuid)))
-                    `()))))
-    ;; Pass lines like 'gnu/store/…-x=/gnu/store/…-x' corresponding to the
-    ;; '-path-list -' option.
-    (for-each (lambda (item)
-                (format pipe "~a=~a~%"
-                        (string-drop item 1) item))
-              items)
-    (unless (zero? (close-pipe pipe))
-      (error "oh, my! grub-mkrescue failed" grub-mkrescue))))
-
 (define* (initialize-hard-disk device
                                #:key
                                bootloader-package
@@ -633,30 +480,16 @@ passing it a directory name where it is mounted."
 
     (when esp
       ;; Mount the ESP somewhere and install GRUB UEFI image.
-      (let ((mount-point (string-append target "/boot/efi"))
-            (grub-config (string-append target "/tmp/grub-standalone.cfg")))
+      (let ((mount-point (string-append target "/boot/efi")))
         (display "mounting EFI system partition...\n")
         (mkdir-p mount-point)
         (mount (partition-device esp) mount-point
                (partition-file-system esp))
 
-        ;; Create a tiny configuration file telling the embedded grub
-        ;; where to load the real thing.
-        ;; XXX This is quite fragile, and can prevent the image from booting
-        ;; when there's more than one volume with this label present.
-        ;; Reproducible almost-UUIDs could reduce the risk (not eliminate it).
-        (call-with-output-file grub-config
-          (lambda (port)
-            (format port
-                    "insmod part_msdos~@
-                    search --set=root --label Guix_image~@
-                    configfile /boot/grub/grub.cfg~%")))
-
         (display "creating EFI firmware image...")
-        (install-efi grub-efi mount-point grub-config)
+        (install-efi-loader grub-efi mount-point)
         (display "done.\n")
 
-        (delete-file grub-config)
         (umount mount-point)))
 
     ;; Register BOOTCFG as a GC root.