From a28cfee841e9c5ab179291d3065f1486fd065e7e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 28 Aug 2019 23:27:20 +0200
Subject: system: Add 'bootloader-menu-entries' field to <boot-parameters>.

This allows us to keep track of the extra menu entries specified in the
OS configuration.

* gnu/system.scm (<boot-parameters>)[bootloader-menu-entries]: New field.
(read-boot-parameters): Initialize it.
(operating-system-boot-parameters): Likewise.
(operating-system-boot-parameters-file): Serialize it.
* gnu/bootloader.scm (menu-entry->sexp, sexp->menu-entry): New
procedures.
---
 gnu/bootloader.scm | 34 ++++++++++++++++++++++++++++++++++
 gnu/system.scm     | 15 +++++++++++++++
 2 files changed, 49 insertions(+)

(limited to 'gnu')

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 909036042f..01bdd4acaa 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@ (define-module (gnu bootloader)
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:export (menu-entry
             menu-entry?
             menu-entry-label
@@ -32,6 +34,9 @@ (define-module (gnu bootloader)
             menu-entry-initrd
             menu-entry-device-mount-point
 
+            menu-entry->sexp
+            sexp->menu-entry
+
             bootloader
             bootloader?
             bootloader-name
@@ -76,6 +81,35 @@ (define-record-type* <menu-entry>
                    (default '()))          ; list of string-valued gexps
   (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp
 
+(define (menu-entry->sexp entry)
+  "Return ENTRY serialized as an sexp."
+  (match entry
+    (($ <menu-entry> label device mount-point linux linux-arguments initrd)
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,device)
+                  (device-mount-point ,mount-point)
+                  (linux ,linux)
+                  (linux-arguments ,linux-arguments)
+                  (initrd ,initrd)))))
+
+(define (sexp->menu-entry sexp)
+  "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
+record."
+  (match sexp
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('linux linux) ('linux-arguments linux-arguments)
+                  ('initrd initrd) _ ...)
+     (menu-entry
+      (label label)
+      (device device)
+      (device-mount-point mount-point)
+      (linux linux)
+      (linux-arguments linux-arguments)
+      (initrd initrd)))))
+
 
 ;;;
 ;;; Bootloader record.
diff --git a/gnu/system.scm b/gnu/system.scm
index 01be1243fe..c860c22433 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -116,6 +116,7 @@ (define-module (gnu system)
             boot-parameters-label
             boot-parameters-root-device
             boot-parameters-bootloader-name
+            boot-parameters-bootloader-menu-entries
             boot-parameters-store-device
             boot-parameters-store-mount-point
             boot-parameters-kernel
@@ -251,6 +252,8 @@ (define-record-type* <boot-parameters>
   ;; OS's root file system, so it might be a device path like "/dev/sda3".
   (root-device      boot-parameters-root-device)
   (bootloader-name  boot-parameters-bootloader-name)
+  (bootloader-menu-entries                        ;list of <menu-entry>
+   boot-parameters-bootloader-menu-entries)
   (store-device     boot-parameters-store-device)
   (store-mount-point boot-parameters-store-mount-point)
   (kernel           boot-parameters-kernel)
@@ -297,6 +300,11 @@ (define device-sexp->device
          ((_ args) args)
          (#f       'grub))) ; for compatibility reasons.
 
+      (bootloader-menu-entries
+       (match (assq 'bootloader-menu-entries rest)
+         ((_ entries) (map sexp->menu-entry entries))
+         (#f          '())))
+
       ;; 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))
@@ -1005,6 +1013,8 @@ (define* (operating-system-boot-parameters os root-device
           (operating-system-user-kernel-arguments os)))
      (initrd initrd)
      (bootloader-name bootloader-name)
+     (bootloader-menu-entries
+      (bootloader-configuration-menu-entries (operating-system-bootloader os)))
      (store-device (ensure-not-/dev (file-system-device store)))
      (store-mount-point (file-system-mount-point store)))))
 
@@ -1046,6 +1056,11 @@ (define* (operating-system-boot-parameters-file os
                      #$(boot-parameters-kernel-arguments params))
                     (initrd #$(boot-parameters-initrd params))
                     (bootloader-name #$(boot-parameters-bootloader-name params))
+                    (bootloader-menu-entries
+                     #$(map menu-entry->sexp
+                            (or (and=> (operating-system-bootloader os)
+                                       bootloader-configuration-menu-entries)
+                                '())))
                     (store
                      (device
                       #$(device->sexp (boot-parameters-store-device params)))
-- 
cgit v1.2.3