bug#26339: [PATCH v2 07/12] 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.scm | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index ce0a4a00e..8c5721491 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -104,6 +104,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
@@ -735,8 +737,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))
@@ -745,12 +751,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 (fs->boot-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)
@@ -772,10 +780,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"
@@ -787,6 +800,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 #$(fs->boot-device store))
                     (mount-point #$(file-system-mount-point store))))
@@ -808,6 +823,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)
@@ -826,6 +843,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))
-- 
2.12.2