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.
This commit is contained in:
Ludovic Courtès 2019-08-28 23:27:20 +02:00
parent 546a709f20
commit a28cfee841
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 49 additions and 0 deletions

View File

@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch> ;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,6 +24,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:export (menu-entry #:export (menu-entry
menu-entry? menu-entry?
menu-entry-label menu-entry-label
@ -32,6 +34,9 @@
menu-entry-initrd menu-entry-initrd
menu-entry-device-mount-point menu-entry-device-mount-point
menu-entry->sexp
sexp->menu-entry
bootloader bootloader
bootloader? bootloader?
bootloader-name bootloader-name
@ -76,6 +81,35 @@
(default '())) ; list of string-valued gexps (default '())) ; list of string-valued gexps
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp (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. ;;; Bootloader record.

View File

@ -116,6 +116,7 @@
boot-parameters-label boot-parameters-label
boot-parameters-root-device boot-parameters-root-device
boot-parameters-bootloader-name boot-parameters-bootloader-name
boot-parameters-bootloader-menu-entries
boot-parameters-store-device boot-parameters-store-device
boot-parameters-store-mount-point boot-parameters-store-mount-point
boot-parameters-kernel boot-parameters-kernel
@ -251,6 +252,8 @@ directly by the user."
;; OS's root file system, so it might be a device path like "/dev/sda3". ;; OS's root file system, so it might be a device path like "/dev/sda3".
(root-device boot-parameters-root-device) (root-device boot-parameters-root-device)
(bootloader-name boot-parameters-bootloader-name) (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-device boot-parameters-store-device)
(store-mount-point boot-parameters-store-mount-point) (store-mount-point boot-parameters-store-mount-point)
(kernel boot-parameters-kernel) (kernel boot-parameters-kernel)
@ -297,6 +300,11 @@ file system labels."
((_ args) args) ((_ args) args)
(#f 'grub))) ; for compatibility reasons. (#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 ;; 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. ;; of the absolute file name of its image. Detect that and correct it.
(kernel (if (string=? linux (direct-store-path linux)) (kernel (if (string=? linux (direct-store-path linux))
@ -1005,6 +1013,8 @@ such as '--root' and '--load' to <boot-parameters>."
(operating-system-user-kernel-arguments os))) (operating-system-user-kernel-arguments os)))
(initrd initrd) (initrd initrd)
(bootloader-name bootloader-name) (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-device (ensure-not-/dev (file-system-device store)))
(store-mount-point (file-system-mount-point store))))) (store-mount-point (file-system-mount-point store)))))
@ -1046,6 +1056,11 @@ being stored into the \"parameters\" file)."
#$(boot-parameters-kernel-arguments params)) #$(boot-parameters-kernel-arguments params))
(initrd #$(boot-parameters-initrd params)) (initrd #$(boot-parameters-initrd params))
(bootloader-name #$(boot-parameters-bootloader-name 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 (store
(device (device
#$(device->sexp (boot-parameters-store-device params))) #$(device->sexp (boot-parameters-store-device params)))