01/21: gnu: bootloader: Support multiple targets.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 2ca982ff41270288913ad6b7d5d9e1cad87b06d9
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Fri Aug 6 16:33:02 2021 -0400

    gnu: bootloader: Support multiple targets.
    
    Fixes <https://issues.guix.gnu.org/40997>.
    
    * gnu/bootloader.scm (<bootloader-configuration>): New 'targets' field.
    (%bootloader-configuration-target): New procedure.
    (bootloader-configuration-target): Add deprecation warning.
    (bootloader-configuration-targets): New procedure.
    * guix/scripts/system.scm (install): Access targets via
    bootloader-configuration-targets.
    (perform-action)[bootloader-target]: Remove unused argument and update doc.
    Access targets via bootloader-configuration-targets and fix indentation.
    (process-action): Access targets via bootloader-configuration-targets.
    Do not provide the unused BOOTLOADER-TARGET argument when applying
    `perform-action'.
    * guix/scripts/system/reconfigure.scm (install-bootloader-program): Rename
    DEVICE argument to DEVICES.  Adjust doc and comment.  Apply `installer' and
    `disk-installer' for every DEVICES.
    (install-bootloader): Access targets via bootloader-configuration-targets 
and
    rename variable from DEVICE to DEVICES.
    * gnu/tests/install.scm: Adjust accordingly.
    * tests/guix-system.sh: Likewise.
    * gnu/tests/reconfigure.scm (run-install-bootloader-test): Adjust the 
DEVICES
    argument so that it is a list.
    * doc/guix.texi: Update doc.
---
 doc/guix.texi                       | 91 +++++++++++++++++++------------------
 gnu/bootloader.scm                  | 22 ++++++++-
 gnu/tests/install.scm               | 26 +++++------
 gnu/tests/reconfigure.scm           |  2 +-
 guix/scripts/system.scm             | 20 ++++----
 guix/scripts/system/reconfigure.scm | 22 +++++----
 tests/guix-system.sh                |  6 +--
 7 files changed, 108 insertions(+), 81 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2b8448c..6620f88 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2569,14 +2569,15 @@ in particular:
 
 @itemize
 @item
-Make sure the @code{bootloader-configuration} form refers to the target
-you want to install GRUB on.  It should mention @code{grub-bootloader} if
-you are installing GRUB in the legacy way, or @code{grub-efi-bootloader}
-for newer UEFI systems.  For legacy systems, the @code{target} field
-names a device, like @code{/dev/sda}; for UEFI systems it names a path
-to a mounted EFI partition, like @code{/boot/efi}; do make sure the path is
-currently mounted and a @code{file-system} entry is specified in your
-configuration.
+Make sure the @code{bootloader-configuration} form refers to the targets
+you want to install GRUB on.  It should mention @code{grub-bootloader}
+if you are installing GRUB in the legacy way, or
+@code{grub-efi-bootloader} for newer UEFI systems.  For legacy systems,
+the @code{targets} field contain the names of the devices, like
+@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
+EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
+are currently mounted and a @code{file-system} entry is specified in
+your configuration.
 
 @item
 Be sure that your file system labels match the value of their respective
@@ -13543,7 +13544,7 @@ the @code{bootloader} field should contain something 
along these lines:
 @lisp
 (bootloader-configuration
   (bootloader grub-efi-bootloader)
-  (target "/boot/efi"))
+  (targets '("/boot/efi")))
 @end lisp
 
 @xref{Bootloader Configuration}, for more information on the available
@@ -14758,7 +14759,7 @@ configuration would look like:
   (keyboard-layout (keyboard-layout "tr"))  ;for the console
   (bootloader (bootloader-configuration
                 (bootloader grub-efi-bootloader)
-                (target "/boot/efi")
+                (targets '("/boot/efi"))
                 (keyboard-layout keyboard-layout))) ;for GRUB
   (services (cons (set-xorg-configuration
                     (xorg-configuration             ;for Xorg
@@ -33188,11 +33189,11 @@ in ``legacy'' BIOS mode.
 through TFTP@.  In combination with an NFS root file system this allows you to
 build a diskless Guix system.
 
-The installation of the @code{grub-efi-netboot-bootloader} generates the 
content
-of the TFTP root directory at @code{target}
-(@pxref{Bootloader Configuration, @code{target}}), to be served by a TFTP 
server.
- You may want to mount your TFTP server directory onto @code{target} to move 
the
-required files to the TFTP server automatically.
+The installation of the @code{grub-efi-netboot-bootloader} generates the
+content of the TFTP root directory at @code{targets} (@pxref{Bootloader
+Configuration, @code{targets}}), to be served by a TFTP server.  You may
+want to mount your TFTP server directories onto the @code{targets} to
+move the required files to the TFTP server automatically.
 
 If you plan to use an NFS root file system as well (actually if you mount the
 store from an NFS share), then the TFTP server needs to serve the file
@@ -33203,22 +33204,25 @@ files from the store will be accessed by GRUB through 
TFTP with their normal
 store path, for example as
 @file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
 
-Two symlinks are created to make this possible.  The first symlink is
-@code{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg},
-where @code{target} may be @file{/boot}.  In this case the link is not leaving
-the served TFTP root directory, but otherwise it does.  The second link is
-@code{target}@file{/gnu/store} and points to @file{../gnu/store}.  This link
-is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting the 
root
-file system for your Guix system, and additionally a TFTP server exporting your
-@code{target} directory—usually @file{/boot}—from that same root file system 
for
-your Guix system.  In this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader 
installer,
-which then takes care to make necessary files from the store accessible through
-TFTP, for example by copying them into the TFTP root directory at 
@code{target}.
+Two symlinks are created to make this possible.  For each target in the
+@code{targets} field, the first symlink is
+@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
+@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
+@file{/boot}.  In this case the link is not leaving the served TFTP root
+directory, but otherwise it does.  The second link is
+@samp{target}@file{/gnu/store} and points to @file{../gnu/store}.  This
+link is leaving the served TFTP root directory.
+
+The assumption behind all this is that you have an NFS server exporting
+the root file system for your Guix system, and additionally a TFTP
+server exporting your @code{targets} directories—usually a single
+@file{/boot}—from that same root file system for your Guix system.  In
+this constellation the symlinks will work.
+
+For other constellations you will have to program your own bootloader
+installer, which then takes care to make necessary files from the store
+accessible through TFTP, for example by copying them into the TFTP root
+directory to your @code{targets}.
 
 It is important to note that symlinks pointing outside the TFTP root directory
 may need to be allowed in the configuration of your TFTP server.  Further the
@@ -33230,18 +33234,19 @@ NFS servers, you also need a properly configured DHCP 
server to make the booting
 over netboot possible.  For all this we can currently only recommend you to 
look
 for instructions about @acronym{PXE, Preboot eXecution Environment}.
 
-@item @code{target}
-This is a string denoting the target onto which to install the
+@item @code{targets}
+This is a list of strings denoting the targets onto which to install the
 bootloader.
 
-The interpretation depends on the bootloader in question.  For
-@code{grub-bootloader}, for example, it should be a device name understood by
-the bootloader @command{installer} command, such as @code{/dev/sda} or
-@code{(hd0)} (@pxref{Invoking grub-install,,, grub, GNU GRUB Manual}).  For
-@code{grub-efi-bootloader}, it should be the mount point of the EFI file
-system, usually @file{/boot/efi}.  For @code{grub-efi-netboot-bootloader},
-@code{target} should be the mount point corresponding to the TFTP root
-directory of your TFTP server.
+The interpretation of targets depends on the bootloader in question.
+For @code{grub-bootloader}, for example, they should be device names
+understood by the bootloader @command{installer} command, such as
+@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
+GNU GRUB Manual}).  For @code{grub-efi-bootloader}, they should be mount
+points of the EFI file system, usually @file{/boot/efi}.  For
+@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
+points corresponding to TFTP root directories served by your TFTP
+server.
 
 @item @code{menu-entries} (default: @code{()})
 A possibly empty list of @code{menu-entry} objects (see below), denoting
@@ -33657,7 +33662,7 @@ files, packages, and so on.  It also creates other 
essential files
 needed for the system to operate correctly---e.g., the @file{/etc},
 @file{/var}, and @file{/run} directories, and the @file{/bin/sh} file.
 
-This command also installs bootloader on the target specified in
+This command also installs bootloader on the targets specified in
 @file{my-os-config}, unless the @option{--no-bootloader} option was
 passed.
 
@@ -34053,7 +34058,7 @@ evaluates to.  As an example, @var{file} might contain 
a definition like this:
    (timezone "Etc/UTC")
    (bootloader (bootloader-configuration
                 (bootloader grub-bootloader)
-                (target "/dev/vda")
+                (targets '("/dev/vda"))
                 (terminal-outputs '(console))))
    (file-systems (cons (file-system
                         (mount-point "/")
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 6d7352d..98807a4 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -55,7 +55,8 @@
             bootloader-configuration
             bootloader-configuration?
             bootloader-configuration-bootloader
-            bootloader-configuration-target
+            bootloader-configuration-target ;deprecated
+            bootloader-configuration-targets
             bootloader-configuration-menu-entries
             bootloader-configuration-default-entry
             bootloader-configuration-timeout
@@ -183,7 +184,9 @@ record."
   bootloader-configuration make-bootloader-configuration
   bootloader-configuration?
   (bootloader         bootloader-configuration-bootloader) ;<bootloader>
-  (target             bootloader-configuration-target      ;string
+  (targets            %bootloader-configuration-targets    ;list of strings
+                      (default #f))
+  (target             %bootloader-configuration-target ;deprecated
                       (default #f))
   (menu-entries       bootloader-configuration-menu-entries ;list of 
<menu-entry>
                       (default '()))
@@ -204,6 +207,21 @@ record."
   (serial-speed       bootloader-configuration-serial-speed ;integer | #f
                       (default #f)))
 
+;;; Deprecated.
+(define (bootloader-configuration-target config)
+  (warning (G_ "the 'target' field is deprecated, please use 'targets' \
+instead~%"))
+  (%bootloader-configuration-target config))
+
+(define (bootloader-configuration-targets config)
+  (or (%bootloader-configuration-targets config)
+      ;; TODO: Remove after the deprecated 'target' field is removed.
+      (list (bootloader-configuration-target 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)))
+
 
 ;;;
 ;;; Bootloaders.
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 8060436..d7fafd2 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -97,7 +97,7 @@
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
@@ -135,7 +135,7 @@
 
     (bootloader (bootloader-configuration
                  (bootloader extlinux-bootloader-gpt)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
@@ -418,7 +418,7 @@ per %test-installed-os, this test is expensive in terms of 
CPU and storage.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vda")))
+                 (targets (list "/dev/vda"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
@@ -549,7 +549,7 @@ partition.  In particular, home directories must be 
correctly created (see
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons* (file-system
                            (device (file-system-label "root-fs"))
@@ -626,7 +626,7 @@ where /gnu lives on a separate partition.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
 
     ;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -842,7 +842,7 @@ build (current-guix) and then store a couple of full system 
images.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
 
     (mapped-devices (list (mapped-device
@@ -929,7 +929,7 @@ reboot\n")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
 
     (mapped-devices (list (mapped-device
                            (source
@@ -1029,7 +1029,7 @@ store a couple of full system images.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
@@ -1103,7 +1103,7 @@ build (current-guix) and then store a couple of full 
system images.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
 
     (file-systems (cons (file-system
@@ -1171,7 +1171,7 @@ RAID-0 (stripe) root partition.")
     (locale "en_US.UTF-8")
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons* (file-system
                            (device (file-system-label "btrfs-pool"))
@@ -1264,7 +1264,7 @@ build (current-guix) and then store a couple of full 
system images.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
@@ -1337,7 +1337,7 @@ build (current-guix) and then store a couple of full 
system images.")
 
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
-                 (target "/dev/vdb")))
+                 (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
                           (device (file-system-label "my-root"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index 52beeef..001b5d1 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -261,7 +261,7 @@ bootloader's configuration file."
      ;; would attempt to write directly to the virtual disk if the
      ;; installation script were run.
      (test
-      (install-bootloader-program #f #f #f bootcfg bootcfg-file #f "/")))))
+      (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
 
 
 (define %test-switch-to-system
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40401d7..83bbefd 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -253,7 +253,7 @@ the ownership of '~a' may be incorrect!~%")
                               #:target target)
           (return
            (info (G_ "bootloader successfully installed on '~a'~%")
-                 (bootloader-configuration-target bootloader))))))))
+                 (bootloader-configuration-targets bootloader))))))))
 
 
 ;;;
@@ -768,14 +768,13 @@ and TARGET arguments."
                          skip-safety-checks?
                          install-bootloader?
                          dry-run? derivations-only?
-                         use-substitutes? bootloader-target target
+                         use-substitutes? target
                          full-boot?
                          container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for IMAGE.  INSTALL-BOOTLOADER? specifies whether to install
-bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
-target root directory.
+bootloader; TARGET is the target root directory.
 
 FULL-BOOT? is used for the 'vm' action; it determines whether to
 boot directly to the kernel or to the bootloader.  CONTAINER-SHARED-NETWORK?
@@ -856,13 +855,13 @@ static checks."
                                      #:target (or target "/"))
                  (return
                   (info (G_ "bootloader successfully installed on '~a'~%")
-                        (bootloader-configuration-target bootloader))))
+                        (bootloader-configuration-targets bootloader))))
                (with-shepherd-error-handling
-                 (upgrade-shepherd-services local-eval os)
-                 (return (format #t (G_ "\
+                (upgrade-shepherd-services local-eval os)
+                (return (format #t (G_ "\
 To complete the upgrade, run 'herd restart SERVICE' to stop,
 upgrade, and restart each service that was not automatically restarted.\n")))
-                 (return (format #t (G_ "\
+                (return (format #t (G_ "\
 Run 'herd status' to view the list of services on your system.\n"))))))
             ((init)
              (newline)
@@ -1218,9 +1217,9 @@ resulting from command-line parsing."
          (target-file (match args
                         ((first second) second)
                         (_ #f)))
-         (bootloader-target
+         (bootloader-targets
                       (and bootloader?
-                           (bootloader-configuration-target
+                           (bootloader-configuration-targets
                             (operating-system-bootloader os)))))
 
     (define (graph-backend)
@@ -1269,7 +1268,6 @@ resulting from command-line parsing."
                                                       opts)
                                #:install-bootloader? bootloader?
                                #:target target-file
-                               #:bootloader-target bootloader-target
                                #:gc-root (assoc-ref opts 'gc-root)))))
           #:target target
           #:system system)))
diff --git a/guix/scripts/system/reconfigure.scm 
b/guix/scripts/system/reconfigure.scm
index 49da6ec..bf23fb0 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -207,10 +207,10 @@ services as defined by OS."
 
 (define (install-bootloader-program installer disk-installer
                                     bootloader-package bootcfg
-                                    bootcfg-file device target)
+                                    bootcfg-file devices target)
   "Return an executable store item that, upon being evaluated, will install
-BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device,
-at TARGET, a mount point, and subsequently run INSTALLER from
+BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
+devices, at TARGET, a mount point, and subsequently run INSTALLER from
 BOOTLOADER-PACKAGE."
   (program-file
    "install-bootloader.scm"
@@ -254,11 +254,17 @@ BOOTLOADER-PACKAGE."
                    ;; The bootloader might not support installation on a
                    ;; mounted directory using the BOOTLOADER-INSTALLER
                    ;; procedure. In that case, fallback to installing the
-                   ;; bootloader directly on DEVICE using the
+                   ;; bootloader directly on DEVICES using the
                    ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
                    (if #$installer
-                       (#$installer #$bootloader-package #$device #$target)
-                       (#$disk-installer #$bootloader-package 0 #$device)))
+                       (for-each (lambda (device)
+                                   (#$installer #$bootloader-package device
+                                                #$target))
+                                 '#$devices)
+                       (for-each (lambda (device)
+                                   (#$disk-installer #$bootloader-package
+                                                     0 device))
+                                 '#$devices)))
                  (lambda args
                    (delete-file new-gc-root)
                    (match args
@@ -284,7 +290,7 @@ additional configurations specified by MENU-ENTRIES can be 
selected."
          (disk-installer (and run-installer?
                               (bootloader-disk-image-installer bootloader)))
          (package (bootloader-package bootloader))
-         (device (bootloader-configuration-target configuration))
+         (devices (bootloader-configuration-targets configuration))
          (bootcfg-file (bootloader-configuration-file bootloader)))
     (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
               (primitive-load #$(install-bootloader-program installer
@@ -292,7 +298,7 @@ additional configurations specified by MENU-ENTRIES can be 
selected."
                                                             package
                                                             bootcfg
                                                             bootcfg-file
-                                                            device
+                                                            devices
                                                             target))))))
 
 
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 7e992e7..6aab1f3 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -115,7 +115,7 @@ cat > "$tmpfile" <<EOF
   (timezone "Europe/Paris")                           ; 6
   (locale "en_US.UTF-8")                              ; 7
 
-  (bootloader (GRUB-config (target "/dev/sdX")))      ; 9
+  (bootloader (GRUB-config (targets (list "/dev/sdX"))))        ; 9
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")
@@ -168,7 +168,7 @@ OS_BASE='
 
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
-               (target "/dev/sdX")))
+               (targets (list "/dev/sdX"))))
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")
@@ -241,7 +241,7 @@ make_user_config ()
 
   (bootloader (bootloader-configuration
                 (bootloader grub-bootloader)
-                (target "/dev/sdX")))
+                (targets (list "/dev/sdX"))))
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")