[bug#72457] [PATCH v6 02/12] gnu: bootloader: grub: Rewrite entirely.

[Herman Rimm via Guix-patches via <guix-patches@gnu.org>]

From: Lilah Tascheter <lilah@lunabee.space>

* gnu/bootloader.scm (bootloader-configuration)[terminal-outputs,
terminal-inputs]: Don't assume grub.
[%bootloader-configuration-targets]: Rename to the below.
(bootloader-configuration-targets): Delete procedure.
* gnu/bootloader/grub.scm (normalize-file, bootloader-theme, image->png,
grub-background-image, grub-locale-directory, eye-candy,
keyboard-layout-file, grub-setup-io, grub-root-search,
make-grub-configuration, grub-configuration-file,
grub-efi-configuration-file, install-grub, install-grub-disk-image,
install-grub-efi, install-grub-efi-removable, install-grub-efi32,
make-grub-efi-netboot-installer, make-grub-efi-netboot-bootloader):
Remove procedures.
(grub-cfg, grub-mkrescue-bootloader): Remove variables.
(grub-efi-removable-bootloader, grub-efi32-bootloader,
grub-efi-netboot-bootloader, grub-efi-netboot-removable-bootloader):
Deprecate variables.
(grub-configuration): Remove macro.
(sanitize, search/target, search/menu-entry, when-list, grub-theme-png,
core.cfg->core.img, core.cfg, core.img, menu-entry->gexp, make-grub.cfg,
grub.cfg, grub.dir, install-grub.dir, install-grub-bios,
install-grub-efi, deprecated-installer): Add procedures.
(%grub-default-targets, %netboot-targets): Add variables.
(keyboard-layout-file): Return computed file.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* doc/guix.texi (system Configuration)[Bootloader Configuration]: Update
terminal-outputs and terminal-inputs to not be GRUB-specific.

Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739
---
 doc/guix.texi                |   23 +-
 gnu/bootloader.scm           |   14 +-
 gnu/bootloader/grub.scm      | 1332 ++++++++++++++--------------------
 gnu/packages/bootloaders.scm |   86 ---
 4 files changed, 550 insertions(+), 905 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 477d017202..a70b89957a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42592,19 +42592,20 @@ Bootloader Configuration
 is provided, some bootloaders might use a default theme, that's true
 for GRUB.
 
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
 The output terminals used for the bootloader boot menu, as a list of
-symbols.  GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}.  This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols.  When @var{#f}, the default is used.  For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}.  This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @code{#f})
 The input terminals used for the bootloader boot menu, as a list of
-symbols.  For GRUB, the default is the native platform terminal as
-determined at run-time.  GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols, or @code{#f} to use the default.  For GRUB, this is the native
+platform terminal as determined at run-time.  GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
 @code{usb_keyboard}.  This field corresponds to the GRUB variable
 @code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
 manual}).
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 522dd2fa7d..0a06c736c6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -495,7 +495,7 @@ (define-record-type* <bootloader-configuration>
   bootloader-configuration?
   (bootloader
    bootloader-configuration-bootloader)   ;<bootloader>
-  (targets               %bootloader-configuration-targets
+  (targets               bootloader-configuration-targets
                          (default #f))     ;list of strings
   (menu-entries          bootloader-configuration-menu-entries
                          (default '()))   ;list of <menu-entry>
@@ -512,9 +512,9 @@ (define-record-type* <bootloader-configuration>
   (theme                 bootloader-configuration-theme
                          (default #f))    ;bootloader-specific theme
   (terminal-outputs      bootloader-configuration-terminal-outputs
-                         (default '(gfxterm)))   ;list of symbols
+                         (default #f))    ;list of symbols | #f (default outs)
   (terminal-inputs       bootloader-configuration-terminal-inputs
-                         (default '()))   ;list of symbols
+                         (default #f))    ;list of symbols | #f (default ins)
   (serial-unit           bootloader-configuration-serial-unit
                          (default #f))    ;integer | #f
   (serial-speed          bootloader-configuration-serial-speed
@@ -524,14 +524,6 @@ (define-record-type* <bootloader-configuration>
   (extra-initrd          bootloader-configuration-extra-initrd
                          (default #f)))   ;string | #f
 
-
-(define (bootloader-configuration-targets config)
-  (or (%bootloader-configuration-targets config)
-      ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
-      ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
-      ;; hence the default value of '(#f) rather than '().
-      (list #f)))
-
 \f
 ;;;
 ;;; Bootloader installation paths.
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..6e71f30f0d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,8 @@
 ;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,24 +29,26 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader grub)
-  #:use-module (guix build union)
-  #:use-module (guix records)
-  #:use-module (guix store)
-  #:use-module (guix utils)
-  #:use-module (guix gexp)
   #:use-module (gnu artwork)
   #:use-module (gnu bootloader)
-  #:use-module (gnu system uuid)
-  #:use-module (gnu system file-systems)
-  #:use-module (gnu system keyboard)
-  #:use-module (gnu system locale)
   #:use-module (gnu packages bootloaders)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
   #:autoload   (gnu packages xorg) (xkeyboard-config)
+  #:use-module (gnu system boot)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system keyboard)
+  #:use-module (gnu system locale)
+  #:use-module (gnu system uuid)
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (guix utils)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-35)
   #:export (grub-theme
             grub-theme?
             grub-theme-image
@@ -53,54 +57,93 @@ (define-module (gnu bootloader grub)
             grub-theme-color-highlight
             grub-theme-gfxmode
 
-            install-grub-efi-removable
-            make-grub-efi-netboot-installer
-
+            grub.dir ; for (gnu build image) iso9660 images
             grub-bootloader
+            grub-minimal-bootloader
             grub-efi-bootloader
+            ;; deprecated
             grub-efi-removable-bootloader
             grub-efi32-bootloader
             grub-efi-netboot-bootloader
-            grub-efi-netboot-removable-bootloader
-            grub-mkrescue-bootloader
-            grub-minimal-bootloader
-
-            grub-configuration))
+            grub-efi-netboot-removable-bootloader))
 
-;;; Commentary:
+\f
 ;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
 ;;;
-;;; Code:
-
-(define* (normalize-file file mount-point store-directory-prefix)
-  "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
-
-  (define (strip-mount-point mount-point file)
-    (if mount-point
-        (if (string=? mount-point "/")
-            file
-            #~(let ((file #$file))
-                (if (string-prefix? #$mount-point file)
-                    (substring #$file #$(string-length mount-point))
-                    file)))
-        file))
-
-  (define (prepend-store-directory-prefix store-directory-prefix file)
-    (if store-directory-prefix
-        #~(string-append #$store-directory-prefix #$file)
-        file))
-
-  (prepend-store-directory-prefix store-directory-prefix
-                                  (strip-mount-point mount-point file)))
 
+(define (sanitize str)
+  "In-G-exp procedure to sanitize a value for use in a GRUB script."
+  #~(let ((glycerin (lambda (l r)
+                      (if (pair? l) (append l r) (cons l r))))
+          ;; In lieu of escaped-string from (guix read-print).
+          (isopropyl (lambda (c)
+                       (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+      (use-modules (srfi srfi-1))
+      (list->string (fold-right glycerin '()
+                                (map isopropyl (string->list #$str))))))
+
+(define* (search/target type targets var #:optional (port #f))
+  "Returns a gexp of a GRUB search command for target TYPE, storing the
+result in VAR.  Optionally outputs to the gexp PORT instead of returning
+a string."
+  (define (form name val)
+    #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+  (with-targets targets
+    ((type => (path :devpath) (device :device) (fs :fs)
+              (label :label) (uuid :uuid))
+     (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+           (uuid (form "fs_uuid" (uuid->string uuid)))
+           (label (form "fs_label" label))
+           (else (form "file" (sanitize path)))))))
+
+(define* (search/menu-entry device file var #:optional (port #f))
+  "Return the GRUB 'search' command to look for DEVICE, which contains
+FILE, a gexp.  The result is a gexp that can be inserted in the
+grub.cfg-generation code to set the variable VAR.  This procedure is
+able to handle DEVICEs unmounted at evaltime."
+  (match device
+    ;; Preferably refer to DEVICE by its UUID or label.  This is more
+    ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+    ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+     #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+    ((? file-system-label? label)
+     #~(format #$port "search.fs_label \"~a\" ~a~%"
+               #$(sanitize (file-system-label->string label)) #$var))
+    ((? (lambda (device)
+          (and (string? device) (string-contains device ":/"))) nfs-uri)
+     ;; If the device is an NFS share, then we assume that the expected
+     ;; file on that device (e.g. the GRUB background image or the kernel)
+     ;; has to be loaded over the network.  Otherwise we would need an
+     ;; additional device information for some local disk to look for that
+     ;; file, which we do not have.
+     ;;
+     ;; TFTP is preferred to HTTP because it is used more widely and
+     ;; specified in standards more widely--especially BOOTP/DHCPv4
+     ;; defines a TFTP server for DHCP option 66, but not HTTP.
+     ;;
+     ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+     ;; which can contain a HTTP or TFTP URL.
+     ;;
+     ;; Note: It is assumed that the file paths are of a similar
+     ;; setup on both the TFTP server and the NFS server (it is
+     ;; not possible to search for files on TFTP).
+     ;;
+     ;; TODO: Allow HTTP.
+     #~(format #$port "set ~a=tftp~%" #$var))
+    ((or #f (? string?))
+     #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+(define (when-list . xs) (filter identity xs))
 
+\f
+;;;
+;;; Theming.
+;;;
 
 (define-record-type* <grub-theme>
   ;; Default theme contributed by Felipe López.
-  grub-theme make-grub-theme
-  grub-theme?
+  grub-theme make-grub-theme grub-theme?
   (image           grub-theme-image
                    (default (file-append %artwork-repository
                                          "/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,800 +156,495 @@ (define-record-type* <grub-theme>
   (gfxmode         grub-theme-gfxmode
                    (default '("auto"))))          ;list of string
 
+(define (grub-theme-png theme)
+  "Return the GRUB background image defined in THEME.  If the suffix of
+the image file is \".svg\", then it is converted into a PNG file with
+the resolution provided in CONFIG.  Returns #f if no file is provided."
+  (match-record theme <grub-theme> (image resolution)
+    (match resolution
+      (((? number? width) . (? number? height))
+       (computed-file "grub-image.png"
+         (with-imported-modules '((gnu build svg) (guix build utils))
+           (with-extensions (list guile-rsvg guile-cairo)
+             #~(begin (use-modules (gnu build svg) (guix build utils))
+                      (if (png-file? #$image) (copy-file #$image #$output)
+                        (svg->png #$image #$output
+                                  #:width #$width
+                                  #:height #$height)))))))
+      (_ image))))
+
+\f
+;;;
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img,
+;;; which then sets the root and prefix variables, allowing grub to load
+;;; its main config and modules, and then enter normal mode.  On i386-pc
+;;; systems a boot.img is flashed which loads the core.img from the MBR
+;;; gap, but on efi systems the core.img is just a PE executable, able
+;;; to be booted directly.  We set up a minimal core.img capable of
+;;; finding the user-configured 'install target to load its config from
+;;; there.
+;;;
+
+(define (core.cfg targets store-crypto-devices)
+  "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+  (define (crypto-device->cryptomount dev)
+    (and (uuid? dev) ; ignore non-uuids - warning given by os
+         #~(format port "cryptomount -u ~a~%"
+                   ;; cryptomount only accepts UUID without the hyphen.
+                   #$(string-delete #\- (uuid->string dev)))))
+
+  (and=>
+    (with-targets targets
+      (('install => (path :devpath))
+       #~(call-with-output-file #$output
+           (lambda (port)
+             #$@(filter ->bool
+                  (map crypto-device->cryptomount store-crypto-devices))
+             #$(search/target 'install targets "root" #~port)
+             (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+    (cut computed-file "core.cfg" <>)))
+
+;; XXX: Would a FORMAT symbol instead of string be better?
+(define (core.cfg->core.img grub format bootloader-config
+                            store-crypto-devices cfg fs)
+  "Return a G-exp for a GRUB core image configured with CFG, built for
+FORMAT and the file system FS."
+  (let* ((tftp? (or (string=? fs "tftp") (string=? fs "nfs")))
+         (bios? (string-prefix? format "pc"))
+         (efi? (string=? format "efi"))
+         (32? (bootloader-configuration-32bit? bootloader-config))
+         (grub-format
+           (cond ((string-prefix? "pc" format) "i386")
+                 ((target-x86-32?) "i386")
+                 ((target-x86-64?) (if 32? "i386" "x86_64"))
+                 ((target-arm32?) "arm")
+                 ((target-aarch64?) (if 32? "arm" "arm64"))
+                 ((target-powerpc?) "powerpc")
+                 ((target-riscv64?) "riscv64")
+                 (else (raise (formatted-message
+                                (G_ "unrecognized target arch '~a'!")
+                                (or (%current-target-system)
+                                    (%current-system)))))))
+         (format (string-append grub-format "-" format
+                                (if (and bios? tftp?) "-pxe" ""))))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils) (ice-9 textual-ports)
+                       (srfi srfi-1))
+          (apply invoke #$(file-append grub "/bin/grub-mkimage")
+            "--output" #$output
+            "--config" #$cfg
+            "--prefix" "none" ; we override this in cfg
+            ;; bios pxe uses pxeboot instead of diskboot - diff format
+            "--format" #$format
+            "--compression" "auto"
+            ;; modules
+            "minicmd"
+            (append
+              ;; disk drivers
+              '#$(if bios? '("biosdisk") '())
+              ;; partmaps
+              ;; TODO: detect which to use.
+              '#$(if tftp? '() '("part_msdos" "part_gpt"))
+              ;; file systems
+              '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+                       ((member fs '("vfat" "fat32")) '("fat"))
+                       ((and tftp? efi?) '("efinet"))
+                       ((and tftp? bios?) '("pxe"))
+                       (else (list fs)))
+              ;; store crypto devs
+              '#$(if (any uuid? store-crypto-devices)
+                   '("luks" "luks2" "cryptomount") '())
+              ;; search module that cfg uses
+              (call-with-input-file #$cfg
+                (lambda (port)
+                   (let* ((str (get-string-all port))
+                          (use (lambda (s) (string-contains str s))))
+                     (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+                           ((use "search.fs_label") '("search_label"))
+                           ((use "search.file") '("search_fs_file"))
+                           (else '())))))))))))
+
+;; XXX: Do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+                               #:allow-other-keys)
+  "The core image for GRUB, built for FORMAT."
+  (let* ((targets (bootloader-configuration-targets bootloader-config))
+         (cfg (core.cfg targets store-crypto-devices)))
+    (and=>
+      (and cfg
+           (with-targets targets
+             (('install => (fs :fs))
+              (core.cfg->core.img grub format bootloader-config
+                                  store-crypto-devices cfg fs))))
+      (cut computed-file "core.img" <>
+           #:options '(#:local-build? #t #:substitutable? #f)))))
+
 \f
 ;;;
-;;; Background image & themes.
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
 ;;;
 
-(define (bootloader-theme config)
-  "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
-  (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
-  "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
-  (computed-file "grub-image.png"
-                 (with-imported-modules '((gnu build svg))
-                   (with-extensions (list guile-rsvg guile-cairo)
-                     #~(if (string-suffix? ".svg" #+image)
-                           (begin
-                             (use-modules (gnu build svg))
-                             (svg->png #+image #$output
-                                       #:width #$width
-                                       #:height #$height))
-                           (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
-  "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
-  (let* ((theme (bootloader-theme config))
-         (image (grub-theme-image theme)))
-    (and image
-         (match (grub-theme-resolution theme)
-           (((? number? width) . (? number? height))
-            (image->png image #:width width #:height height))
-           (_ #f)))))
-
-(define (grub-locale-directory grub)
-  "Generate a directory with the locales from GRUB."
-  (define builder
-    #~(begin
-        (use-modules (ice-9 ftw))
-        (let ((locale (string-append #$grub "/share/locale"))
-              (out    #$output))
-          (mkdir out)
-          (chdir out)
-          (for-each (lambda (lang)
-                      (let ((file (string-append locale "/" lang
-                                                 "/LC_MESSAGES/grub.mo"))
-                            (dest (string-append lang ".mo")))
-                        (when (file-exists? file)
-                          (copy-file file dest))))
-                    (scandir locale)))))
-  (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
-                    #:key store-directory-prefix port)
-  "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for.  STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
-  (define (setup-gfxterm config)
-    (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
-        #~(format #f "
+;; TODO: use define-configuration.
+(define (menu-entry->gexp entry extra-initrd port)
+  (match-menu-entry
+    entry
+    (label device linux linux-arguments initrd multiboot-kernel
+     multiboot-arguments multiboot-modules chain-loader)
+    (let ((normalize-file
+            (compose sanitize (cut normalize-file entry <>))))
+      #~(begin
+          (format #$port "menuentry ~s {~%  " #$label)
+          #$(search/menu-entry
+              device (or linux multiboot-kernel chain-loader) "boot" port)
+          #$@(cond
+               (linux
+                 (list #~(format
+                           #$port "  linux \"($boot)~a\" ~a~%"
+                           #$(normalize-file linux)
+                           ;; GRUB passes rest of the line _verbatim_.
+                           (string-join (list #$@linux-arguments)))
+                       #~(format #$port "  initrd ~a \"($boot)~a\"~%"
+                                 (if #$extra-initrd
+                                     (string-append "($boot)\""
+                                                    (normalize-file
+                                                      #$extra-initrd)
+                                                    "\"")
+                                     "")
+                                 #$(normalize-file initrd))))
+               ;; Previously, this provided a (wrong) root= argument.
+               ;; Just don't bother anymore; better less info than
+               ;; wrong info.
+               (multiboot-kernel
+                 (cons
+                   #~(format #$port "  multiboot \"($boot)~a\" ~a~%"
+                             #$(normalize-file multiboot-kernel)
+                             (string-join (list #$@multiboot-arguments)))
+                   (map (lambda (mod)
+                          #~(format port "  module \"($boot)~a\"~%"
+                                    #$(normalize-file mod)))
+                        multiboot-modules)))
+               (chain-loader
+                 (list #~(format #$port "  chainloader \"~a\"~%"
+                                 #$(normalize-file chain-loader)))))
+          (format #$port "}~%")))))
+
+;; TODO: use define-configuration.
+(define (make-grub.cfg bootloader-config locale install menu-entries
+                       old-entries terms->str outputs inputs theme)
+  (define (colors->str c)
+    (format #f "~a/~a" (assoc-ref c 'fg) (assoc-ref c 'bg)))
+
+  (match-bootloader-configuration
+    bootloader-config
+    ;; XXX: Separate these fields into another record?
+    (default-entry timeout serial-unit serial-speed)
+    #~(call-with-output-file #$output
+        (lambda (port)
+          ;; preamble
+          (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+          #$@(when-list
+        ;; menu settings
+               (and default-entry
+                    #~(format port "set default=~a~%" #$default-entry))
+               (and timeout
+                    #~(format port "set timeout=~a~%" #$timeout))
+        ;; gfxterm setup
+               (and (memq 'gfxterm outputs)
+                    #~(format
+                        port "\
 if loadfont unicode; then
   set gfxmode=~a
   insmod all_video
   insmod gfxterm
 fi~%"
-                  #$(string-join
-                     (grub-theme-gfxmode (bootloader-theme config))
-                     ";"))
-        ""))
-
-  (define (theme-colors type)
-    (let* ((theme  (bootloader-theme config))
-           (colors (type theme)))
-      (string-append (symbol->string (assoc-ref colors 'fg)) "/"
-                     (symbol->string (assoc-ref colors 'bg)))))
-
-  (define image
-    (normalize-file (grub-background-image config)
-                    store-mount-point
-                    store-directory-prefix))
-
-  (and image
-       #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+                        #$(string-join (grub-theme-gfxmode theme) ";")))
+        ;; io
+               (and (or serial-unit serial-speed)
+                     #~(format
+                         port "serial --unit=~a --speed=~a~%"
+                         ;; Documented defaults are unit 0 at 9600 baud.
+                         #$(number->string (or serial-unit 0))
+                         #$(number->string (or serial-speed 9600))))
+               (and (pair? outputs)
+                    #~(format port "terminal_output ~a~%"
+                              #$(terms->str outputs)))
+               (and (pair? inputs)
+                    #~(format port "terminal_input ~a~%"
+                              #$(terms->str inputs)))
+        ;; locale
+               (and locale
+                    #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%"
+                              #$(sanitize install)
+                              #$(locale-definition-source
+                                  (locale-name->definition locale))))
+        ;; keyboard layout
+               (and (bootloader-configuration-keyboard-layout
+                      bootloader-config)
+                    #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\""
+                              #$(sanitize install)))
+        ;; theme
+               (match-record theme <grub-theme>
+                 (image color-normal color-highlight)
+                 (and image
+                      #~(format port "\
 insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
   set color_normal=~a
   set color_highlight=~a
 else
   set menu_color_normal=cyan/blue
   set menu_color_highlight=white/blue
-fi~%"
-                 #$(grub-root-search store-device image)
-                 #$(setup-gfxterm config)
-                 #$(grub-setup-io config)
-
-                 #$image
-                 #$(theme-colors grub-theme-color-normal)
-                 #$(theme-colors grub-theme-color-highlight))))
-
-\f
-;;;
-;;; Configuration file.
-;;;
-
-(define* (keyboard-layout-file layout
-                               #:key
-                               (grub grub))
-  "Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
-and return a file in the format for GRUB keymaps.  LAYOUT must be present in
-the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
-  (define builder
+fi~%"                           #$(sanitize install)
+                                #$(colors->str color-normal)
+                                #$(colors->str color-highlight)))))
+        ;; menu entries
+        #$@menu-entries
+        #$@(if (pair? old-entries)
+               (append (list #~(format
+                                 port "submenu ~s {~%"
+                                 "GNU system, old configurations..."))
+                       old-entries
+                       (list #~(format port "}~%")))
+               '())
+        (format port "\
+if [ \"${grub_platform}\" == efi ]; then
+  menuentry \"Firmware setup\" {
+    fwsetup
+  }
+fi~%")))))
+
+(define* (grub.cfg #:key bootloader-config
+                         current-boot-alternative
+                         old-boot-alternatives
+                         locale
+                         store-directory-prefix
+                   #:allow-other-keys)
+  "Returns a valid GRUB config given installer inputs.  Keymap and theme
+image are taken from BOOTLOADER-CONFIG, LOCALE is provided explicitly."
+  (match-bootloader-configuration
+    bootloader-config
+    ;; Can't match keyboard-layout here, because it's bound to its struct.
+    (menu-entries targets extra-initrd theme terminal-outputs
+     terminal-inputs)
+    (define (entries->gexp entries)
+      (map (cut menu-entry->gexp <> extra-initrd #~port)
+           entries))
+
+    (let* ((current-entry (boot-alternative->menu-entry
+                            current-boot-alternative))
+           (entries (entries->gexp (cons current-entry menu-entries)))
+           (old-entries (entries->gexp (map boot-alternative->menu-entry
+                                            old-boot-alternatives)))
+           (terms->str (compose string-join (cut map symbol->string <>)))
+           ;; Use the values provided, or the defaults otherwise.
+           (outputs (or terminal-outputs '(gfxterm)))
+           (inputs (or terminal-inputs '()))
+           (theme (or theme (grub-theme))))
+      (and=>
+        (with-targets targets
+          (('install => (install :devpath))
+           (make-grub.cfg bootloader-config locale install entries
+                          old-entries terms->str outputs inputs theme)))
+        (cut computed-file "grub.cfg" <>
+             ;; Since this file is rather unique, there's no point in
+             ;; trying to substitute it.
+             #:options '(#:local-build? #t #:substitutable? #f))))))
+
+(define (keyboard-layout-file layout grub)
+  "Process the X keyboard layout description LAYOUT, a <keyboard-layout>
+record, and return a file in the format for GRUB keymaps.  LAYOUT must be
+present in the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
+  (computed-file
+    (string-append "grub-keymap."
+                   (string-map (match-lambda (#\, #\-) (chr chr))
+                               (keyboard-layout-name layout)))
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
-
           ;; 'grub-kbdcomp' passes all its arguments but '-o' to 'ckbcomp'
           ;; (from the 'console-setup' package).
           (invoke #+(file-append grub "/bin/grub-mklayout")
                   "-i" #+(keyboard-layout->console-keymap layout)
-                  "-o" #$output))))
-
-  (computed-file (string-append "grub-keymap."
-                                (string-map (match-lambda
-                                              (#\, #\-)
-                                              (chr chr))
-                                            (keyboard-layout-name layout)))
-                 builder))
-
-(define (grub-setup-io config)
-  "Return GRUB commands to configure the input / output interfaces.  The result
-is a string that can be inserted in grub.cfg."
-  (let* ((symbols->string (lambda (list)
-                           (string-join (map symbol->string list) " ")))
-         (outputs (bootloader-configuration-terminal-outputs config))
-         (inputs (bootloader-configuration-terminal-inputs config))
-         (unit (bootloader-configuration-serial-unit config))
-         (speed (bootloader-configuration-serial-speed config))
-
-         ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
-         ;; as documented in GRUB manual section "Simple Configuration
-         ;; Handling".
-         (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
-                          gfxterm vga_text mda_text morse spkmodem))
-         (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
-                         at_keyboard usb_keyboard))
-
-         (io (string-append
-              ;; UNIT and SPEED are arguments to the same GRUB command
-              ;; ("serial"), so we process them together.
-              (if (or unit speed)
-                  (string-append
-                   "serial"
-                   (if unit
-                       ;; COM ports 1 through 4
-                       (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
-                           (string-append " --unit=" (number->string unit))
-                           #f)
-                       "")
-                   (if speed
-                       (if (exact-integer? speed)
-                           (string-append " --speed=" (number->string speed))
-                           #f)
-                       "")
-                   "\n")
-                  "")
-              (if (null? inputs)
-                  ""
-                  (string-append
-                   "terminal_input "
-                   (symbols->string
-                    (map
-                     (lambda (input)
-                       (if (memq input valid-inputs) input #f)) inputs))
-                   "\n"))
-              "terminal_output "
-              (symbols->string
-               (map
-                (lambda (output)
-                  (if (memq output valid-outputs) output #f)) outputs)))))
-    (format #f "~a" io)))
-
-(define (grub-root-search device file)
-  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
-code."
-  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
-  ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
-  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
-  (if (and (string? file) (not (string-prefix? "/" file)))
-      ""
-      (match device
-        ;; Preferably refer to DEVICE by its UUID or label.  This is more
-        ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
-        ((? uuid? uuid)
-         (format #f "search --fs-uuid --set ~a"
-                 (uuid->string device)))
-        ((? file-system-label? label)
-         (format #f "search --label --set ~a"
-                 (file-system-label->string label)))
-        ((? (lambda (device)
-              (and (string? device) (string-contains device ":/"))) nfs-uri)
-         ;; If the device is an NFS share, then we assume that the expected
-         ;; file on that device (e.g. the GRUB background image or the kernel)
-         ;; has to be loaded over the network.  Otherwise we would need an
-         ;; additional device information for some local disk to look for that
-         ;; file, which we do not have.
-         ;;
-         ;; We explicitly set "root=(tftp)" here even though if grub.cfg
-         ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
-         ;; automatically anyway.  The reason is if you have a system that
-         ;; used to be on NFS but now is local, root would be set to local
-         ;; disk.  If you then selected an older system generation that is
-         ;; supposed to boot from network in the Grub boot menu, Grub still
-         ;; wouldn't load those files from network otherwise.
-         ;;
-         ;; TFTP is preferred to HTTP because it is used more widely and
-         ;; specified in standards more widely--especially BOOTP/DHCPv4
-         ;; defines a TFTP server for DHCP option 66, but not HTTP.
-         ;;
-         ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
-         ;; which can contain a HTTP or TFTP URL.
-         ;;
-         ;; Note: It is assumed that the file paths are of a similar
-         ;; setup on both the TFTP server and the NFS server (it is
-         ;; not possible to search for files on TFTP).
-         ;;
-         ;; TODO: Allow HTTP.
-         "set root=(tftp)")
-        ((or #f (? string?))
-         #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
-                                  #:key
-                                  (locale #f)
-                                  (system (%current-system))
-                                  (old-entries '())
-                                  (store-crypto-devices '())
-                                  store-directory-prefix)
-  "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
-  (define all-entries
-    (append entries (bootloader-configuration-menu-entries config)))
-  (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
-          (linux (menu-entry-linux entry))
-          (device (menu-entry-device entry))
-          (device-mount-point (menu-entry-device-mount-point entry))
-          (multiboot-kernel (menu-entry-multiboot-kernel entry))
-          (chain-loader (menu-entry-chain-loader entry)))
-      (cond
-       (linux
-        (let ((arguments (menu-entry-linux-arguments entry))
-              (linux (normalize-file linux
-                                     device-mount-point
-                                     store-directory-prefix))
-              (initrd (normalize-file (menu-entry-initrd entry)
-                                      device-mount-point
-                                      store-directory-prefix))
-              (extra-initrd (bootloader-configuration-extra-initrd config)))
-          ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-          ;; Use the right file names for LINUX and INITRD in case
-          ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-          ;; separate partition.
-
-          ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
-          ;; initrd paths, to allow booting from a Btrfs subvolume.
-          #~(format port "menuentry ~s {
-  ~a
-  linux ~a ~a
-  initrd ~a ~a
-}~%"
-                    #$label
-                    #$(grub-root-search device linux)
-                    #$linux (string-join (list #$@arguments))
-                    (or #$extra-initrd "")
-                    #$initrd)))
-       (multiboot-kernel
-        (let* ((kernel (menu-entry-multiboot-kernel entry))
-               (arguments (menu-entry-multiboot-arguments entry))
-               ;; Choose between device names as understood by Mach's built-in
-               ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
-               ;; in the "noide" case).
-               (disk (if (member "noide" arguments) "w" "h"))
-               (modules (menu-entry-multiboot-modules entry))
-               (root-index 1))          ; XXX EFI will need root-index 2
-          #~(format port "
-menuentry ~s {
-  multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
-                    #$label
-                    #$kernel
-                    #$root-index
-                    #$disk
-                    (string-join (list #$@arguments) " " 'prefix)
-                    (string-join (map string-join '#$modules)
-                                 "\n  module " 'prefix))))
-       (chain-loader
-        #~(format port "
-menuentry ~s {
-  ~a
-  chainloader ~a
-}~%"
-                  #$label
-                  #$(grub-root-search device chain-loader)
-                  #$chain-loader)))))
-
-  (define (crypto-devices)
-    (define (crypto-device->cryptomount dev)
-      (if (uuid? dev)
-          #~(format port "cryptomount -u ~a~%"
-                    ;; cryptomount only accepts UUID without the hypen.
-                    #$(string-delete #\- (uuid->string dev)))
-          ;; Other type of devices aren't implemented.
-          #~()))
-    (let ((devices (map crypto-device->cryptomount store-crypto-devices))
-          (modules #~(format port "insmod luks~%insmod luks2~%")))
-      (if (null? devices)
-          devices
-          (cons modules devices))))
-
-  (define (sugar)
-    (let* ((entry (first all-entries))
-           (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry)))
-      (eye-candy config
-                 device
-                 mount-point
-                 #:store-directory-prefix store-directory-prefix
-                 #:port #~port)))
-
-  (define locale-config
-    (let* ((entry (first all-entries))
-           (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry)))
-      #~(let ((locale #$(and locale
-                             (locale-definition-source
-                              (locale-name->definition locale))))
-              (locales #$(and locale
-                              (normalize-file (grub-locale-directory grub)
-                                              mount-point
-                                              store-directory-prefix))))
-          (when locale
-            (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
-                    ;; Skip the search if there is an image, as it has already
-                    ;; been performed by eye-candy and traversing the store is
-                    ;; an expensive operation.
-                    #$(if (grub-theme-image (bootloader-theme config))
-                          "# "
-                          "")
-                    locales
-                    locales
-                    locale)))))
-
-  (define keyboard-layout-config
-    (let* ((layout (bootloader-configuration-keyboard-layout config))
-           (keymap* (and layout
-                         (keyboard-layout-file layout #:grub grub)))
-           (entry (first all-entries))
-           (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry))
-           (keymap (and keymap*
-                        (normalize-file keymap* mount-point
-                                        store-directory-prefix))))
-      #~(when #$keymap
-          (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
-  (define builder
-    #~(call-with-output-file #$output
-        (lambda (port)
-          (format port
-                  "# This file was generated from your Guix configuration.  Any changes
-# will be lost upon reconfiguration.
-")
-          #$@(crypto-devices)
-          #$(sugar)
-          #$locale-config
-          #$keyboard-layout-config
-          (format port "
-set default=~a
-set timeout=~a~%"
-                  #$(bootloader-configuration-default-entry config)
-                  #$(bootloader-configuration-timeout config))
-          #$@(map menu-entry->gexp all-entries)
-
-          #$@(if (pair? old-entries)
-                 #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
-                    #$@(map menu-entry->gexp old-entries)
-                    (format port "}~%"))
-                 #~())
-          (format port "
-if [ \"${grub_platform}\" == efi ]; then
-  menuentry \"Firmware setup\" {
-    fwsetup
-  }
-fi~%"))))
-
-  ;; Since this file is rather unique, there's no point in trying to
-  ;; substitute it.
-  (computed-file "grub.cfg" builder
-                 #:options '(#:local-build? #t
-                             #:substitutable? #f)))
-
-(define (grub-configuration-file config . args)
-  (let* ((bootloader (bootloader-configuration-bootloader config))
-         (grub (bootloader-package bootloader)))
-    (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
-  (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
+                  "-o" #$output)))))
+
+(define* (grub.dir grub #:key bootloader-config locale
+                        #:allow-other-keys . args)
+  "Everything that should go in GRUB's prefix.  Includes fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+  (let* ((theme (or (bootloader-configuration-theme bootloader-config)
+                    (grub-theme)))
+         (keyboard-layout (bootloader-configuration-keyboard-layout
+                            bootloader-config))
+         (lang (and=> locale (compose locale-definition-source
+                                      locale-name->definition)))
+         (lc-mesg (and lang (file-append grub "/share/locale" lang
+                                         "/LC_MESSAGES/grub.mo"))))
+    (computed-file "grub.dir"
+      (with-imported-modules '((guix build utils))
+        #~(begin
+            (use-modules (guix build utils))
+            (mkdir-p #$output)
+            (chdir #$output)
+            ;; grub files
+            (copy-recursively #$(file-append grub "/lib/grub/") #$output
+                              #:copy-file symlink)
+            (mkdir "fonts")
+            (symlink #$(file-append grub "/share/grub/unicode.pf2")
+                     "fonts/unicode.pf2")
+            ;; config file
+            (symlink #$(apply grub.cfg args) "grub.cfg")
+            ;; locales
+            ;; XXX: Warn if missing?
+            (when (and=> #$lc-mesg file-exists?)
+              (mkdir "locales")
+              (symlink #$lc-mesg
+                       (string-append "locales/" #$lang ".mo")))
+            ;; keymap
+            #$@(when-list
+                 (and keyboard-layout
+                      #~(symlink #$(keyboard-layout-file keyboard-layout
+                                                         grub)
+                                 "keymap"))
+            ;; image
+                 (and (grub-theme-image theme)
+                      #~(copy-file #$(grub-theme-png theme)
+                                   "image.png")))))
+      #:options '(#:local-build? #t #:substitutable? #f))))
 
 \f
-
 ;;;
-;;; Install procedures.
+;;; Installers.
 ;;;
 
-(define install-grub
-  #~(lambda (bootloader device mount-point)
-      (let ((grub (string-append bootloader "/sbin/grub-install"))
-            (install-dir (string-append mount-point "/boot")))
-        ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
-        ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
-        (if device
-            (begin
-              ;; Tell 'grub-install' that there might be a LUKS-encrypted
-              ;; /boot or root partition.
-              (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
-              ;; Hide potentially confusing messages from the user, such as
-              ;; "Installing for i386-pc platform."
-              (invoke/quiet grub "--no-floppy" "--target=i386-pc"
-                            "--boot-directory" install-dir
-                            device))
-            ;; When creating a disk-image, only install a font and GRUB modules.
-            (let* ((fonts (string-append install-dir "/grub/fonts")))
-              (mkdir-p fonts)
-              (copy-file (string-append bootloader "/share/grub/unicode.pf2")
-                         (string-append fonts "/unicode.pf2"))
-              (copy-recursively (string-append bootloader "/lib/")
-                                install-dir))))))
-
-(define install-grub-disk-image
-  #~(lambda (bootloader root-index image)
-      ;; Install GRUB on the given IMAGE. The root partition index is
-      ;; ROOT-INDEX.
-      (let ((grub-mkimage
-             (string-append bootloader "/bin/grub-mkimage"))
-            (modules '("biosdisk" "part_msdos" "fat" "ext2"))
-            (grub-bios-setup
-             (string-append bootloader "/sbin/grub-bios-setup"))
-            (root-device (format #f "hd0,msdos~a" root-index))
-            (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
-            (device-map "device.map"))
-
-        ;; Create a minimal, standalone GRUB image that will be written
-        ;; directly in the MBR-GAP (space between the end of the MBR and the
-        ;; first partition).
-        (apply invoke grub-mkimage
-               "-O" "i386-pc"
-               "-o" "core.img"
-               "-p" (format #f "(~a)/boot/grub" root-device)
-               modules)
-
-        ;; Create a device mapping file.
-        (call-with-output-file device-map
-          (lambda (port)
-            (format port "(hd0) ~a~%" image)))
-
-        ;; Copy the default boot.img, that will be written on the MBR sector
-        ;; by GRUB-BIOS-SETUP.
-        (copy-file boot-img "boot.img")
-
-        ;; Install both the "boot.img" and the "core.img" files on the given
-        ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
-        ;; written in the MBR-GAP. GRUB configuration and missing modules will
-        ;; be read from ROOT-DEVICE.
-        (invoke grub-bios-setup
-                "-m" device-map
-                "-r" root-device
-                "-d" "."
-                image))))
-
-(define install-grub-efi
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
-      ;; NOTE: efi-dir comes from target list of booloader configuration
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--removable"
-                        ;; "--no-nvram"
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-			(cond ((target-x86?) "--target=i386-efi")
-                              ((target-arm?) "--target=arm-efi"))
-                        "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
-  "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary.  Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP).  In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments.  Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
-              (targets '(\"/boot/efi\"))
-              …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP.  Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created.  The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP.  Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory.  This all may need to be considered
-for security aspects.  It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks.  In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file.  A
-symlink to the store is not needed in this case."
-  (with-imported-modules '((guix build union))
-    #~(lambda (bootloader target mount-point)
-        ;; In context of a disk image creation TARGET will be #f and an
-        ;; installer is expected to do necessary installations on MOUNT-POINT,
-        ;; which will become the root file system.  If TARGET is #f, this
-        ;; installer has nothing to do, as it only cares about the EFI System
-        ;; Partition (ESP).
-        (when target
-          (use-modules ((guix build union) #:select (symlink-relative))
-                       (ice-9 popen)
-                       (ice-9 rdelim))
-          (let* ((mount-point/target (string-append mount-point target "/"))
-                 ;; When installing Guix, it is common to mount TARGET below
-                 ;; MOUNT-POINT rather than the root directory.
-                 (bootloader-target (if (file-exists? mount-point/target)
-                                        mount-point/target
-                                        target))
-                 (store (string-append mount-point (%store-prefix)))
-                 (store-link (string-append bootloader-target (%store-prefix)))
-                 (grub-cfg (string-append mount-point #$grub-cfg))
-                 (grub-cfg-link (string-append bootloader-target
-                                               #$subdir "/"
-                                               (basename grub-cfg))))
-            ;; Copy the bootloader into the bootloader-target directory.
-            ;; Should we beforehand recursively delete any existing file?
-            (copy-recursively bootloader bootloader-target
-                              #:follow-symlinks? #t
-                              #:log (%make-void-port "w"))
-            ;; For TFTP we need to install additional relative symlinks.
-            ;; If we install on an EFI System Partition (ESP) or some other FAT
-            ;; file-system, then symlinks cannot be created and are not needed.
-            ;; Therefore we ignore exceptions when trying.
-            ;; Prepare the symlink to the grub.cfg.
-            (mkdir-p (dirname grub-cfg-link))
-            (false-if-exception (delete-file grub-cfg-link))
-            (if (unspecified?
-                 (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
-                ;; Symlinks are supported.
-                (begin
-                  ;; Prepare the symlink to the store.
-                  (mkdir-p (dirname store-link))
-                  (false-if-exception (delete-file store-link))
-                  (symlink-relative store store-link))
-                ;; Creating symlinks does not seem to be supported.  Probably
-                ;; an ESP is used.  Add a script to search and load the actual
-                ;; grub.cfg.
-                (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
-                       (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
-                                         grub-cfg))
-                       (search-root
-                        (match (read-line port)
-                          ((? eof-object?)
-                           ;; There is no UUID available. As a fallback search
-                           ;; everywhere for the grub.cfg.
-                           (string-append "search --file --set " #$grub-cfg))
-                          (fs-uuid
-                           ;; The UUID to load the grub.cfg from is known.
-                           (string-append "search --fs-uuid --set " fs-uuid))))
-                       (load-grub-cfg (string-append "configfile " #$grub-cfg)))
-                  (close-pipe port)
-                  (with-output-to-file grub-cfg-link
-                    (lambda ()
-                      (display (string-join (list search-root
-                                                  load-grub-cfg)
-                                            "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+                                #:allow-other-keys . args)
+  (with-targets (bootloader-configuration-targets bootloader-config)
+    (('install => (path :path))
+     #~(copy-recursively #$(apply grub.dir grub args) #$path
+                         #:log (%make-void-port "w")
+                         #:follow-symlinks? #t
+                         #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+  "Returns an installer for the bios-bootable grub package GRUB."
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (gbegin (apply install-grub.dir grub args)
+      (with-targets (bootloader-configuration-targets bootloader-config)
+        (('disk => (device :device))
+         #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+                   "--directory" "/" ; can't be blank
+                   "--device-map" "" ; no dev map - need to specify
+                   "--boot-image"
+                   #$(file-append grub "/lib/grub/i386-pc/boot.img")
+                   "--core-image" #$(apply core.img grub "pc" args)
+                   "--root-device" #$(string-append "hostdisk/" device)
+                   #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config
+                           #:allow-other-keys . args)
+  "Installs GRUB into the system's UEFI bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+  (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+         (grub (if 32? grub-efi32 grub-efi))
+         (core (apply core.img grub "efi" args))
+         (copy #~(lambda (dest) (copy-file #$core dest))))
+    (gbegin (apply install-grub.dir grub args)
+      (install-efi bootloader-config
+                   #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
 
 \f
-
 ;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
 ;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed.  Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+  (list (bootloader-target
+          (type 'install)
+          (offset 'root)
+          (path "boot"))))
 
 (define grub-bootloader
   (bootloader
-   (name 'grub)
-   (package grub)
-   (installer install-grub)
-   (disk-image-installer install-grub-disk-image)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-configuration-file)))
+    (name 'grub)
+    (default-targets %grub-default-targets)
+    (installer (install-grub-bios grub))))
 
 (define grub-minimal-bootloader
   (bootloader
-   (inherit grub-bootloader)
-   (package grub-minimal)))
+    (name 'grub)
+    (default-targets %grub-default-targets)
+    (installer (install-grub-bios grub-minimal))))
 
 (define grub-efi-bootloader
   (bootloader
-   (name 'grub-efi)
-   (package grub-efi)
-   (installer install-grub-efi)
-   (disk-image-installer #f)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
-  (bootloader
-   (inherit grub-efi-bootloader)
-   (name 'grub-efi-removable-bootloader)
-   (installer install-grub-efi-removable)))
+    (name 'grub-efi)
+    (default-targets (list (bootloader-target
+                             (type 'vendir)
+                             (offset 'esp)
+                             (path "EFI/Guix"))
+                           (bootloader-target
+                             (type 'install)
+                             (offset 'esp)
+                             (path "grub"))))
+    (installer install-grub-efi)))
+
+\f
+;;;
+;;; Deprecated!  Use the bootloader-config flags instead.  Or, in the
+;;; case of netboot, set your 'install (or parent thereof) target fs to
+;;; be "tftp" or "nfs".
+;;;
 
-(define grub-efi32-bootloader
+(define (deprecated-installer installer removable? 32?)
+  "INSTALLER with overrides for its bootloader-config argument."
+  (lambda args
+    (apply installer (substitute-keyword-arguments args
+                       ((#:bootloader-config conf)
+                        (bootloader-configuration
+                          (inherit conf)
+                          (efi-removable? removable?)
+                          (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
   (bootloader
-   (inherit grub-efi-bootloader)
-   (installer install-grub-efi32)
-   (name 'grub-efi32)
-   (package grub-efi32)))
+    (inherit grub-efi-bootloader)
+    (installer (deprecated-installer install-grub-efi #t #f))))
 
-(define (make-grub-efi-netboot-bootloader name subdir)
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
   (bootloader
-   (name name)
-   (package (make-grub-efi-netboot (symbol->string name) subdir))
-   (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
-   (disk-image-installer #f)
-   (configuration-file grub-cfg)
-   (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
-  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
-                                    "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
-  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
-                                    "efi/boot"))
-
-(define grub-mkrescue-bootloader
+    (inherit grub-efi-bootloader)
+    (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+  (list (bootloader-target
+          (type 'install)
+          (offset 'root)
+          (path "boot")
+          (file-system "tftp"))
+        (bootloader-target
+          (type 'vendir)
+          (offset 'esp)
+          (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+                   grub-efi-bootloader
   (bootloader
-   (inherit grub-efi-bootloader)
-   (package grub-hybrid)))
+    (inherit grub-efi-bootloader)
+    (default-targets %netboot-targets)))
 
-\f
-;;;
-;;; Compatibility macros.
-;;;
-
-(define-syntax grub-configuration
-  (syntax-rules (grub)
-                ((_ (grub package) fields ...)
-                 (if (eq? package grub)
-                     (bootloader-configuration
-                      (bootloader grub-bootloader)
-                      fields ...)
-                   (bootloader-configuration
-                    (bootloader grub-efi-bootloader)
-                    fields ...)))
-                ((_ fields ...)
-                 (bootloader-configuration
-                  (bootloader grub-bootloader)
-                  fields ...))))
-
-;;; grub.scm ends here
+(define-deprecated grub-efi-netboot-removable-bootloader
+                   grub-efi-bootloader
+  (bootloader
+    (inherit grub-efi-bootloader)
+    (default-targets %netboot-targets)
+    (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 2a12a38f1a..00b502aaee 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
                                                         basename))))
                             (scandir input-dir)))))))))))
 
-(define-public (make-grub-efi-netboot name subdir)
-  "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media.  Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
-  (package
-    (name name)
-    (version (package-version grub-efi))
-    ;; Source is not needed, but it cannot be omitted.
-    (source #f)
-    (build-system trivial-build-system)
-    (arguments
-     (let* ((system (string-split (nix-system->gnu-triplet
-                                   (or (%current-target-system)
-                                       (%current-system)))
-                                  #\-))
-            (arch (first system))
-            (boot-efi
-             (match system
-               ;; These are the supportend systems and the names defined by
-               ;; the UEFI standard for removable media.
-               (("i686" _ ...)        "/bootia32.efi")
-               (("x86_64" _ ...)      "/bootx64.efi")
-               (("arm" _ ...)         "/bootarm.efi")
-               (("aarch64" _ ...)     "/bootaa64.efi")
-               (("riscv" _ ...)       "/bootriscv32.efi")
-               (("riscv64" _ ...)     "/bootriscv64.efi")
-               ;; Other systems are not supported, although defined.
-               ;; (("riscv128" _ ...) "/bootriscv128.efi")
-               ;; (("ia64" _ ...)     "/bootia64.efi")
-               ((_ ...)               #f)))
-            (core-efi (string-append
-                       ;; This is the arch dependent file name of GRUB, e.g.
-                       ;; i368-efi/core.efi or arm64-efi/core.efi.
-                       (match arch
-                         ("i686"    "i386")
-                         ("aarch64" "arm64")
-                         ("riscv"   "riscv32")
-                         (_         arch))
-                       "-efi/core.efi")))
-       (list
-        #:modules '((guix build utils))
-        #:builder
-        #~(begin
-            (use-modules (guix build utils))
-            (let* ((bootloader #$(this-package-input "grub-efi"))
-                   (net-dir #$output)
-                   (sub-dir (string-append net-dir "/" #$subdir "/"))
-                   (boot-efi (string-append sub-dir #$boot-efi))
-                   (core-efi (string-append sub-dir #$core-efi)))
-              ;; Install GRUB, which refers to the grub.cfg, with support for
-              ;; encrypted partitions,
-              (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-              (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
-                            (string-append "--net-directory=" net-dir)
-                            (string-append "--subdir=" #$subdir)
-                            ;; These modules must be pre-loaded to allow booting
-                            ;; from an ESP or a similar partition with a FAT
-                            ;; file system.
-                            (string-append "--modules=part_msdos part_gpt fat"))
-              ;; Move GRUB's core.efi to the removable media name.
-              (false-if-exception (delete-file boot-efi))
-              (rename-file core-efi boot-efi))))))
-    (inputs (list grub-efi))
-    (synopsis (package-synopsis grub-efi))
-    (description (package-description grub-efi))
-    (home-page (package-home-page grub-efi))
-    (license (package-license grub-efi))))
-
 (define-public syslinux
   (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
     (package
-- 
2.45.2