me
/
guix
Archived
1
0
Fork 0

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.
master
Mathieu Othacehe 2017-05-29 14:24:20 +02:00
parent 45f523d9f0
commit 8b22107e5d
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
4 changed files with 70 additions and 48 deletions

View File

@ -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.

View File

@ -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))

View File

@ -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 "}~%"))
#~()))))

View File

@ -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.