bootloader: Use menu-entry to define custom bootloader entries.
* gnu/bootloader.scm (<menu-entry>): New variable. Export associated getters, This record is extracted from grub module. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Use menu-entry->boot-parameters to convert menu-entry records to boot-parameters. * gnu/bootloader/grub.scm (<menu-entry>): Remove. (boot-parameters->menu-entry): Remove. (grub-configuration-file): Use boot-parameters to create configuration entries. * gnu/system.scm (menu-entry->boot-parameters): New exported procedure.
This commit is contained in:
Mathieu Othacehe
parent
45f523d9f0
commit
8b22107e5d
@ -23,7 +23,15 @@
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix ui)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (bootloader
|
||||
#:export (menu-entry
|
||||
menu-entry?
|
||||
menu-entry-label
|
||||
menu-entry-device
|
||||
menu-entry-linux
|
||||
menu-entry-linux-arguments
|
||||
menu-entry-initrd
|
||||
|
||||
bootloader
|
||||
bootloader?
|
||||
bootloader-name
|
||||
bootloader-package
|
||||
@ -48,6 +56,22 @@
|
||||
%bootloaders
|
||||
lookup-bootloader-by-name))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Menu-entry record.
|
||||
;;;
|
||||
|
||||
(define-record-type* <menu-entry>
|
||||
menu-entry make-menu-entry
|
||||
menu-entry?
|
||||
(label menu-entry-label)
|
||||
(device menu-entry-device ; file system uuid, label, or #f
|
||||
(default #f))
|
||||
(linux menu-entry-linux)
|
||||
(linux-arguments menu-entry-linux-arguments
|
||||
(default '())) ; list of string-valued gexps
|
||||
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
|
||||
|
||||
|
||||
;;;
|
||||
;;; Bootloader record.
|
||||
|
||||
@ -37,7 +37,8 @@
|
||||
corresponding to old generations of the system."
|
||||
|
||||
(define all-entries
|
||||
(append entries (bootloader-configuration-menu-entries config)))
|
||||
(append entries (map menu-entry->boot-parameters
|
||||
(bootloader-configuration-menu-entries config))))
|
||||
|
||||
(define (boot-parameters->gexp params)
|
||||
(let ((label (boot-parameters-label params))
|
||||
|
||||
@ -66,12 +66,15 @@
|
||||
(define (strip-mount-point mount-point file)
|
||||
"Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
|
||||
denoting a file name."
|
||||
(if (string=? mount-point "/")
|
||||
file
|
||||
#~(let ((file #$file))
|
||||
(if (string-prefix? #$mount-point file)
|
||||
(substring #$file #$(string-length mount-point))
|
||||
file))))
|
||||
(match mount-point
|
||||
((? string? mount-point)
|
||||
(if (string=? mount-point "/")
|
||||
file
|
||||
#~(let ((file #$file))
|
||||
(if (string-prefix? #$mount-point file)
|
||||
(substring #$file #$(string-length mount-point))
|
||||
file))))
|
||||
(#f file)))
|
||||
|
||||
(define-record-type* <grub-image>
|
||||
grub-image make-grub-image
|
||||
@ -103,19 +106,6 @@ denoting a file name."
|
||||
(color-highlight '((fg . yellow) (bg . black)))
|
||||
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030
|
||||
|
||||
(define-record-type* <menu-entry>
|
||||
menu-entry make-menu-entry
|
||||
menu-entry?
|
||||
(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 "/"))
|
||||
(linux menu-entry-linux)
|
||||
(linux-arguments menu-entry-linux-arguments
|
||||
(default '())) ; list of string-valued gexps
|
||||
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
|
||||
|
||||
|
||||
;;;
|
||||
;;; Background image & themes.
|
||||
@ -312,16 +302,6 @@ code."
|
||||
(#f
|
||||
#~(format #f "search --file --set ~a" #$file)))))
|
||||
|
||||
(define (boot-parameters->menu-entry conf)
|
||||
"Convert a <boot-parameters> instance to a corresponding <menu-entry>."
|
||||
(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))))
|
||||
|
||||
(define* (grub-configuration-file config entries
|
||||
#:key
|
||||
(system (%current-system))
|
||||
@ -331,33 +311,36 @@ 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
|
||||
(map boot-parameters->menu-entry
|
||||
(append entries
|
||||
(bootloader-configuration-menu-entries config))))
|
||||
(append entries (map menu-entry->boot-parameters
|
||||
(bootloader-configuration-menu-entries config))))
|
||||
|
||||
(define entry->gexp
|
||||
(match-lambda
|
||||
(($ <menu-entry> label device device-mount-point
|
||||
linux arguments initrd)
|
||||
(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)))
|
||||
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
|
||||
;; Use the right file names for LINUX and INITRD in case
|
||||
;; Use the right file names for KERNEL and INITRD in case
|
||||
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
|
||||
;; separate partition.
|
||||
(let ((linux (strip-mount-point device-mount-point linux))
|
||||
(initrd (strip-mount-point device-mount-point initrd)))
|
||||
(let ((kernel (strip-mount-point device-mount-point kernel))
|
||||
(initrd (strip-mount-point device-mount-point initrd)))
|
||||
#~(format port "menuentry ~s {
|
||||
~a
|
||||
linux ~a ~a
|
||||
initrd ~a
|
||||
}~%"
|
||||
#$label
|
||||
#$(grub-root-search device linux)
|
||||
#$linux (string-join (list #$@arguments))
|
||||
#$initrd)))))
|
||||
#$(grub-root-search device kernel)
|
||||
#$kernel (string-join (list #$@arguments))
|
||||
#$initrd))))
|
||||
|
||||
(mlet %store-monad ((sugar (eye-candy config
|
||||
(menu-entry-device (first all-entries))
|
||||
(menu-entry-device-mount-point
|
||||
(boot-parameters-store-device
|
||||
(first all-entries))
|
||||
(boot-parameters-store-mount-point
|
||||
(first all-entries))
|
||||
#:system system
|
||||
#:port #~port)))
|
||||
@ -374,12 +357,12 @@ set default=~a
|
||||
set timeout=~a~%"
|
||||
#$(bootloader-configuration-default-entry config)
|
||||
#$(bootloader-configuration-timeout config))
|
||||
#$@(map entry->gexp all-entries)
|
||||
#$@(map boot-parameters->gexp all-entries)
|
||||
|
||||
#$@(if (pair? old-entries)
|
||||
#~((format port "
|
||||
submenu \"GNU system, old configurations...\" {~%")
|
||||
#$@(map entry->gexp (map boot-parameters->menu-entry old-entries))
|
||||
#$@(map boot-parameters->gexp old-entries)
|
||||
(format port "}~%"))
|
||||
#~()))))
|
||||
|
||||
|
||||
@ -112,6 +112,7 @@
|
||||
boot-parameters-initrd
|
||||
read-boot-parameters
|
||||
read-boot-parameters-file
|
||||
menu-entry->boot-parameters
|
||||
|
||||
local-host-aliases
|
||||
%setuid-programs
|
||||
@ -299,6 +300,19 @@ The object has its kernel-arguments extended in order to make it bootable."
|
||||
system
|
||||
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)
|
||||
(boot-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))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Services.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user