aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2017-05-29 14:24:20 +0200
committerMathieu Othacehe <m.othacehe@gmail.com>2017-06-08 16:29:29 +0200
commit8b22107e5d0bdeb300fb33b5a40aed2057a66b94 (patch)
treeec2df97d8be877b40e24712aefd06b4dcdcc7f65
parent45f523d9f018c262900e94b0f70f17b05118941c (diff)
downloadguix-8b22107e5d0bdeb300fb33b5a40aed2057a66b94.tar
guix-8b22107e5d0bdeb300fb33b5a40aed2057a66b94.tar.gz
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.
-rw-r--r--gnu/bootloader.scm26
-rw-r--r--gnu/bootloader/extlinux.scm3
-rw-r--r--gnu/bootloader/grub.scm77
-rw-r--r--gnu/system.scm14
4 files changed, 71 insertions, 49 deletions
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 4e77974d31..d5fcf30f05 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -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
@@ -50,6 +58,22 @@
;;;
+;;; 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.
;;;
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 67b8815d40..0a1263aed7 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -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))
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 49616b7164..f1cc3324db 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -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))))
-
- (define entry->gexp
- (match-lambda
- (($ <menu-entry> label device device-mount-point
- linux arguments initrd)
+ (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)))
;; 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 "}~%"))
#~()))))
diff --git a/gnu/system.scm b/gnu/system.scm
index 0076f2fcb1..674c6f85be 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -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.