01/01: bootloader: Use <menu-entry> for the bootloader side.

[Danny Milosavljevic]

dannym pushed a commit to branch master
in repository guix.

commit 1975c754f487eb4933724ca3b116442d21ef8dd9
Author: Danny Milosavljevic <address@hidden>
Date:   Thu Jun 29 12:42:59 2017 +0200

    bootloader: Use <menu-entry> for the bootloader side.
    
    * gnu/bootloader.scm (menu-entry-device-mount-point): New variable.  Export 
it.
    (<menu-entry>: New field "device".
    * gnu/bootloader/grub.scm (grub-confgiuration-file): Handle <menu-entry>
    entries.
    * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Handle
    <menu-entry> entries.
    * gnu/system.scm (menu->entry->boot-parameters): Delete variable.
    (boot-parameters->menu-entry): New variable.  Export it.
    (operating-system-bootcfg): Make OLD-ENTRIES a list of <menu-entry>.
    * guix/script/system.scm (reinstall-bootloader): Fix bootcfg usage.
    (perform-action): Fix bootcfg usage.
---
 gnu/bootloader.scm          |  3 +++
 gnu/bootloader/extlinux.scm | 19 +++++++++----------
 gnu/bootloader/grub.scm     | 27 ++++++++++++---------------
 gnu/system.scm              | 29 ++++++++++++++---------------
 guix/scripts/system.scm     | 13 +++++++------
 5 files changed, 45 insertions(+), 46 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index d5fcf30..e080b04 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -30,6 +30,7 @@
             menu-entry-linux
             menu-entry-linux-arguments
             menu-entry-initrd
+            menu-entry-device-mount-point
 
             bootloader
             bootloader?
@@ -67,6 +68,8 @@
   (label           menu-entry-label)
   (device          menu-entry-device       ; file system uuid, label, or #f
                    (default #f))
+  (device-mount-point menu-entry-device-mount-point
+                   (default #f))
   (linux           menu-entry-linux)
   (linux-arguments menu-entry-linux-arguments
                    (default '()))          ; list of string-valued gexps
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 219b058..e5fdeb5 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -38,14 +38,13 @@
 corresponding to old generations of the system."
 
   (define all-entries
-    (append entries (map menu-entry->boot-parameters
-                         (bootloader-configuration-menu-entries config))))
-
-  (define (boot-parameters->gexp params)
-    (let ((label (boot-parameters-label params))
-          (kernel (boot-parameters-kernel params))
-          (kernel-arguments (boot-parameters-kernel-arguments params))
-          (initrd (boot-parameters-initrd params)))
+    (append entries (bootloader-configuration-menu-entries config)))
+
+  (define (menu-entry->gexp entry)
+    (let ((label (menu-entry-label entry))
+          (kernel (menu-entry-linux entry))
+          (kernel-arguments (menu-entry-linux-arguments entry))
+          (initrd (menu-entry-initrd entry)))
       #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
@@ -69,11 +68,11 @@ TIMEOUT ~a~%"
                     (if (> timeout 0) 1 0)
                     ;; timeout is expressed in 1/10s of seconds.
                     (* 10 timeout))
-            #$@(map boot-parameters->gexp all-entries)
+            #$@(map menu-entry->gexp all-entries)
 
             #$@(if (pair? old-entries)
                    #~((format port "~%")
-                      #$@(map boot-parameters->gexp old-entries)
+                      #$@(map menu-entry->gexp old-entries)
                       (format port "~%"))
                    #~())))))
 
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 880491c..3a3456c 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -316,16 +316,14 @@ code."
 STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
 entries corresponding to old generations of the system."
   (define all-entries
-    (append entries (map menu-entry->boot-parameters
-                         (bootloader-configuration-menu-entries config))))
-
-  (define (boot-parameters->gexp params)
-    (let ((device (boot-parameters-store-device params))
-          (device-mount-point (boot-parameters-store-mount-point params))
-          (label (boot-parameters-label params))
-          (kernel (boot-parameters-kernel params))
-          (arguments (boot-parameters-kernel-arguments params))
-          (initrd (boot-parameters-initrd params)))
+    (append entries (bootloader-configuration-menu-entries config)))
+  (define (menu-entry->gexp entry)
+    (let ((device (menu-entry-device entry))
+          (device-mount-point (menu-entry-device-mount-point entry))
+          (label (menu-entry-label entry))
+          (kernel (menu-entry-linux entry))
+          (arguments (menu-entry-linux-arguments entry))
+          (initrd (menu-entry-initrd entry)))
       ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
       ;; Use the right file names for KERNEL and INITRD in case
       ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
@@ -341,11 +339,10 @@ entries corresponding to old generations of the system."
                   #$(grub-root-search device kernel)
                   #$kernel (string-join (list address@hidden))
                   #$initrd))))
-
   (mlet %store-monad ((sugar (eye-candy config
-                                        (boot-parameters-store-device
+                                        (menu-entry-device
                                          (first all-entries))
-                                        (boot-parameters-store-mount-point
+                                        (menu-entry-device-mount-point
                                          (first all-entries))
                                         #:system system
                                         #:port #~port)))
@@ -362,12 +359,12 @@ set default=~a
 set timeout=~a~%"
                     #$(bootloader-configuration-default-entry config)
                     #$(bootloader-configuration-timeout config))
-            #$@(map boot-parameters->gexp all-entries)
+            #$@(map menu-entry->gexp all-entries)
 
             #$@(if (pair? old-entries)
                    #~((format port "
 submenu \"GNU system, old configurations...\" {~%")
-                      #$@(map boot-parameters->gexp old-entries)
+                      #$@(map menu-entry->gexp old-entries)
                       (format port "}~%"))
                    #~()))))
 
diff --git a/gnu/system.scm b/gnu/system.scm
index 746c511..fdb5be2 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -112,7 +112,7 @@
             boot-parameters-initrd
             read-boot-parameters
             read-boot-parameters-file
-            menu-entry->boot-parameters
+            boot-parameters->menu-entry
 
             local-host-aliases
             %setuid-programs
@@ -301,17 +301,15 @@ The object has its kernel-arguments extended in order to 
make it bootable."
                                                      root-device)))
       #f)))
 
-(define (menu-entry->boot-parameters menu-entry)
-  "Convert a <menu-entry> instance to a corresponding <boot-parameters>."
-  (boot-parameters
-   (label (menu-entry-label menu-entry))
-   (root-device #f)
-   (bootloader-name 'custom)
-   (store-device #f)
-   (store-mount-point #f)
-   (kernel (menu-entry-linux menu-entry))
-   (kernel-arguments (menu-entry-linux-arguments menu-entry))
-   (initrd (menu-entry-initrd menu-entry))))
+(define (boot-parameters->menu-entry conf)
+  (menu-entry
+   (label (boot-parameters-label conf))
+   (device (boot-parameters-store-device conf))
+   (device-mount-point (boot-parameters-store-mount-point conf))
+   (linux (boot-parameters-kernel conf))
+   (linux-arguments (boot-parameters-kernel-arguments conf))
+   (initrd (boot-parameters-initrd conf))))
+
 
 
 ;;;
@@ -866,15 +864,16 @@ listed in OS.  The C library expects to find it under
   (store-file-system (operating-system-file-systems os)))
 
 (define* (operating-system-bootcfg os #:optional (old-entries '()))
-  "Return the bootloader configuration file for OS.  Use OLD-ENTRIES to
-populate the \"old entries\" menu."
+  "Return the bootloader configuration file for OS.  Use OLD-ENTRIES
+(which is a list of <menu-entry>) to populate the \"old entries\" menu."
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
        (root-device -> (if (eq? 'uuid (file-system-title root-fs))
                            (uuid->string (file-system-device root-fs))
                            (file-system-device root-fs)))
-       (entry (operating-system-boot-parameters os system root-device))
+       (params (operating-system-boot-parameters os system root-device))
+       (entry -> (boot-parameters->menu-entry params))
        (bootloader-conf -> (operating-system-bootloader os)))
     ((bootloader-configuration-file-generator
       (bootloader-configuration-bootloader bootloader-conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0fcb6a9..5a2811e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -431,8 +431,6 @@ generation as its default entry.  STORE is an open 
connection to the store."
   "Re-install bootloader for existing system profile generation NUMBER.
 STORE is an open connection to the store."
   (let* ((generation (generation-file-name %system-profile number))
-         (params (unless-file-not-found
-                  (read-boot-parameters-file generation)))
          ;; Detect the bootloader used in %system-profile.
          (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
 
@@ -442,10 +440,12 @@ STORE is an open connection to the store."
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (entries (profile-boot-parameters %system-profile (list number)))
+         (params (profile-boot-parameters %system-profile (list number)))
          (old-generations (delv number (generation-numbers %system-profile)))
-         (old-entries (profile-boot-parameters
-                       %system-profile old-generations)))
+         (old-params (profile-boot-parameters
+                       %system-profile old-generations))
+         (entries (map boot-parameters->menu-entry params))
+         (old-entries (map boot-parameters->menu-entry old-params)))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg ((bootloader-configuration-file-generator bootloader)
@@ -657,7 +657,8 @@ output when building a system derivation, such as a disk 
image."
                       os
                       (if (eq? 'init action)
                           '()
-                          (profile-boot-parameters)))))
+                          (map boot-parameters->menu-entry
+                               (profile-boot-parameters))))))
        (bootcfg-file -> (bootloader-configuration-file bootloader))
        (bootloader-installer
         (let ((installer (bootloader-installer bootloader))