amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: bootloader: grub: Add support for chain-loader.

Browse source 
* gnu/bootloader/grub.scm (grub-configuration-file): Add support for
chain-loader.

Signed-off-by: Julien Lepiller <julien@lepiller.eu>
This commit is contained in:
tiantian 2022-09-05 01:25:40 +08:00 • committed by Julien Lepiller
parent 52d780ea2b
commit 1fc20e4c86
No known key found for this signature in database
GPG key ID: 53D457B2D636EE82
1 changed files with 42 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

71
gnu/bootloader/grub.scm
View file

@ -374,44 +374,57 @@ when booting a root file system on a Btrfs subvolume."
(let ((label (menu-entry-label entry)) (let ((label (menu-entry-label entry))
(linux (menu-entry-linux entry)) (linux (menu-entry-linux entry))
(device (menu-entry-device entry)) (device (menu-entry-device entry))
(device-mount-point (menu-entry-device-mount-point entry))) (device-mount-point (menu-entry-device-mount-point entry))
(if linux (multiboot-kernel (menu-entry-multiboot-kernel entry))
(let ((arguments (menu-entry-linux-arguments entry)) (chain-loader (menu-entry-chain-loader entry)))
(linux (normalize-file linux (cond
device-mount-point (linux
store-directory-prefix)) (let ((arguments (menu-entry-linux-arguments entry))
(initrd (normalize-file (menu-entry-initrd entry) (linux (normalize-file linux
device-mount-point device-mount-point
store-directory-prefix))) store-directory-prefix))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. (initrd (normalize-file (menu-entry-initrd entry)
;; Use the right file names for LINUX and INITRD in case device-mount-point
;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a store-directory-prefix)))
;; separate partition. ;; 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 ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
;; initrd paths, to allow booting from a Btrfs subvolume. ;; initrd paths, to allow booting from a Btrfs subvolume.
#~(format port "menuentry ~s { #~(format port "menuentry ~s {
~a ~a
linux ~a ~a linux ~a ~a
initrd ~a initrd ~a
}~%" }~%"
#$label #$label
#$(grub-root-search device linux) #$(grub-root-search device linux)
#$linux (string-join (list #$@arguments)) #$linux (string-join (list #$@arguments))
#$initrd)) #$initrd)))
(let ((kernel (menu-entry-multiboot-kernel entry)) (multiboot-kernel
(arguments (menu-entry-multiboot-arguments entry)) (let ((kernel (menu-entry-multiboot-kernel entry))
(modules (menu-entry-multiboot-modules entry)) (arguments (menu-entry-multiboot-arguments entry))
(root-index 1)) ; XXX EFI will need root-index 2 (modules (menu-entry-multiboot-modules entry))
#~(format port " (root-index 1)) ; XXX EFI will need root-index 2
#~(format port "
menuentry ~s { menuentry ~s {
multiboot ~a root=device:hd0s~a~a~a 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))))
(chain-loader
#~(format port "
menuentry ~s {
~a
chainloader ~a
}~%" }~%"
#$label #$label
#$kernel #$(grub-root-search device chain-loader)
#$root-index (string-join (list #$@arguments) " " 'prefix) #$chain-loader)))))
(string-join (map string-join '#$modules)
"\n module " 'prefix))))))
(define (crypto-devices) (define (crypto-devices)
(define (crypto-device->cryptomount dev) (define (crypto-device->cryptomount dev)