guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

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.
wip-gexp-hygiene
Mathieu Othacehe 5 years ago
parent
45f523d9f0
commit
8b22107e5d
No known key found for this signature in database GPG Key ID: 8354763531769CA6
4 changed files with 71 additions and 49 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 26
      gnu/bootloader.scm
  2. 3
      gnu/bootloader/extlinux.scm
  3. 77
      gnu/bootloader/grub.scm
  4. 14
      gnu/system.scm

26
gnu/bootloader.scm
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.

3
gnu/bootloader/extlinux.scm
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))

77
gnu/bootloader/grub.scm
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))))
(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 "}~%"))
#~()))))

14
gnu/system.scm
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.

Write Preview
Loading…
Cancel
Save