bug#26339: [PATCH 11/18] bootloader: Add device and type to bootloader-configuration record.

[Mathieu Othacehe]

* gnu/system.scm (<boot-parameters>)[device, type]: New fields.
(boot-parameters-boot-device): New exported procedure.
(boot-parameters-boot-type): Ditto.
(operating-system-grub.cfg): Add new fields.
(operating-system-parameters-file): Add new fields and replace GRUB by
bootloader in doctype.
(read-boot-parameters): Ditto.

* gnu/system/bootloader.scm (extlinux-configuration-file): Adapt matching to
  new fields.
---
 gnu/system.scm            | 29 ++++++++++++++++++++++++++++-
 gnu/system/bootloader.scm |  2 +-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 6c41fe814..9775e5be8 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -105,6 +105,8 @@
             boot-parameters?
             boot-parameters-label
             boot-parameters-root-device
+            boot-parameters-boot-device
+            boot-parameters-boot-type
             boot-parameters-store-device
             boot-parameters-store-mount-point
             boot-parameters-kernel
@@ -736,8 +738,12 @@ populate the \"old entries\" menu."
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
+       (boot-device -> (bootloader-configuration-device
+                        (operating-system-bootloader os)))
        (store-fs -> (operating-system-store-file-system os))
        (label ->    (kernel->boot-label (operating-system-kernel os)))
+       (boot-type -> (bootloader-configuration-type
+                      (operating-system-bootloader os)))
        (kernel ->   (operating-system-kernel-file os))
        (initrd      (operating-system-initrd-file os))
        (root-device -> (if (eq? 'uuid (file-system-title root-fs))
@@ -746,12 +752,14 @@ populate the \"old entries\" menu."
        (entries ->  (list (boot-parameters
                            (label label)
                            (root-device root-device)
+                           (boot-device boot-device)
 
                            ;; The device where the kernel and initrd live.
                            (store-device (grub-device store-fs))
                            (store-mount-point
                             (file-system-mount-point store-fs))
 
+                           (boot-type boot-type)
                            (kernel kernel)
                            (kernel-arguments
                             (cons* (string-append "--root=" root-device)
@@ -773,10 +781,15 @@ device in a <menu-entry>."
 
 (define (operating-system-parameters-file os)
   "Return a file that describes the boot parameters of OS.  The primary use of
-this file is the reconstruction of GRUB menu entries for old configurations."
+this file is the reconstruction of bootloader menu entries for old
+configurations."
   (mlet %store-monad ((initrd   (operating-system-initrd-file os))
                       (root ->  (operating-system-root-file-system os))
+                      (boot-device -> (bootloader-configuration-device
+                                       (operating-system-bootloader os)))
                       (store -> (operating-system-store-file-system os))
+                      (boot-type -> (bootloader-configuration-type
+                                     (operating-system-bootloader os)))
                       (label -> (kernel->boot-label
                                  (operating-system-kernel os))))
     (gexp->file "parameters"
@@ -788,6 +801,8 @@ this file is the reconstruction of GRUB menu entries for 
old configurations."
                    (kernel-arguments
                     #$(operating-system-kernel-arguments os))
                    (initrd #$initrd)
+                   (boot-device #$boot-device)
+                   (boot-type #$boot-type)
                    (store
                     (device #$(grub-device store))
                     (mount-point #$(file-system-mount-point store))))
@@ -809,6 +824,8 @@ this file is the reconstruction of GRUB menu entries for 
old configurations."
   ;; exactly to the device field of the <file-system> object representing the
   ;; OS's root file system, so it might be a device path like "/dev/sda3".
   (root-device      boot-parameters-root-device)
+  (boot-device      boot-parameters-boot-device)
+  (boot-type        boot-parameters-boot-type)
   (store-device     boot-parameters-store-device)
   (store-mount-point boot-parameters-store-mount-point)
   (kernel           boot-parameters-kernel)
@@ -827,6 +844,16 @@ this file is the reconstruction of GRUB menu entries for 
old configurations."
       (label label)
       (root-device root)
 
+      (boot-device
+       (match (assq 'boot-device rest)
+         ((_ args) args)
+         (#f       #f))) ; for compatibility reasons.
+
+      (boot-type
+       (match (assq 'boot-type rest)
+         ((_ args) args)
+         (#f       'grub))) ; for compatibility reasons.
+
       ;; In the past, we would store the directory name of the kernel instead
       ;; of the absolute file name of its image.  Detect that and correct it.
       (kernel (if (string=? linux (direct-store-path linux))
diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm
index c2b23c380..b4774792e 100644
--- a/gnu/system/bootloader.scm
+++ b/gnu/system/bootloader.scm
@@ -104,7 +104,7 @@ corresponding to old generations of the system."
 
   (define boot-parameters->gexp
     (match-lambda
-      (($ <boot-parameters> label _ _ _ kernel kernel-arguments initrd)
+      (($ <boot-parameters> label _ _ _ _ _ kernel kernel-arguments initrd)
        #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
-- 
2.12.2