ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

bootloader: grub: Add support for multiboot.

Browse source 
* gnu/bootloader/grub.scm (grub-configuration-file): Add support for
multiboot.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-05-26 18:09:01 +02:00 committed by Jan Nieuwenhuizen
parent 912b857ede
commit 1244491a0d
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 49 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

76
gnu/bootloader/grub.scm
View file

@ -330,36 +330,58 @@ (define* (grub-configuration-file config entries
(define all-entries
(append entries (bootloader-configuration-menu-entries config)))
(define (menu-entry->gexp entry)
(let* ((device (menu-entry-device entry))
(device-mount-point (menu-entry-device-mount-point entry))
(label (menu-entry-label entry))
(arguments (menu-entry-linux-arguments entry))
(kernel (normalize-file (menu-entry-linux entry)
device-mount-point
store-directory-prefix))
(initrd (normalize-file (menu-entry-initrd entry)
device-mount-point
store-directory-prefix)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; 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.
#~(format port "menuentry ~s {
(let ((label (menu-entry-label entry))
(linux (menu-entry-linux entry))
(device (menu-entry-device entry))
(device-mount-point (menu-entry-device-mount-point entry)))
(if linux
(let ((arguments (menu-entry-linux-arguments entry))
(linux (normalize-file linux
device-mount-point
store-directory-prefix))
(initrd (normalize-file (menu-entry-initrd entry)
device-mount-point
store-directory-prefix)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for LINUX and INITRD in case
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
;; separate partition.
;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
;; initrd paths, to allow booting from a Btrfs subvolume.
#~(format port "menuentry ~s {
~a
linux ~a ~a
initrd ~a
}~%"
#$label
#$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments))
#$initrd)))
(define sugar
(eye-candy config
(menu-entry-device (first all-entries))
(menu-entry-device-mount-point (first all-entries))
#:store-directory-prefix store-directory-prefix
#:system system
#:port #~port))
#$label
#$(grub-root-search device linux)
#$linux (string-join (list #$@arguments))
#$initrd))
(let ((kernel (menu-entry-multiboot-kernel entry))
(arguments (menu-entry-multiboot-arguments entry))
(modules (menu-entry-multiboot-modules entry))
(root-index 1)) ; XXX EFI will need root-index 2
#~(format port "
menuentry ~s {
multiboot ~a root=device:hd0s~a~a~a
}~%"
#$label
#$kernel
#$root-index (string-join (list #$@arguments) " " 'prefix)
(string-join (map string-join '#$modules)
"\n module " 'prefix))))))
(define (sugar)
(let* ((entry (first all-entries))
(device (menu-entry-device entry))
(mount-point (menu-entry-device-mount-point entry)))
(eye-candy config
device
mount-point
#:store-directory-prefix store-directory-prefix
#:system system
#:port #~port)))
(define keyboard-layout-config
(let* ((layout (bootloader-configuration-keyboard-layout config))
@ -384,7 +406,7 @@ (define builder
"# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
")
#$sugar
#$(sugar)
#$keyboard-layout-config
(format port "
set default=~a