bootloader: Use <menu-entry> for the bootloader side.
* gnu/bootloader.scm (menu-entry-device-mount-point): New variable. Export it. (<menu-entry>: New field "device". * gnu/bootloader/grub.scm (grub-confgiuration-file): Handle <menu-entry> entries. * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Handle <menu-entry> entries. * gnu/system.scm (menu->entry->boot-parameters): Delete variable. (boot-parameters->menu-entry): New variable. Export it. (operating-system-bootcfg): Make OLD-ENTRIES a list of <menu-entry>. * guix/script/system.scm (reinstall-bootloader): Fix bootcfg usage. (perform-action): Fix bootcfg usage.
This commit is contained in:
Danny Milosavljevic
parent
9ca8aa38ec
commit
1975c754f4
|
|
@ -30,6 +30,7 @@
|
|||
menu-entry-linux
|
||||
menu-entry-linux-arguments
|
||||
menu-entry-initrd
|
||||
menu-entry-device-mount-point
|
||||
|
||||
bootloader
|
||||
bootloader?
|
||||
|
|
@ -67,6 +68,8 @@
|
|||
(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 #f))
|
||||
(linux menu-entry-linux)
|
||||
(linux-arguments menu-entry-linux-arguments
|
||||
(default '())) ; list of string-valued gexps
|
||||
|
|
|
|||
|
|
@ -38,14 +38,13 @@
|
|||
corresponding to old generations of the system."
|
||||
|
||||
(define all-entries
|
||||
(append entries (map menu-entry->boot-parameters
|
||||
(bootloader-configuration-menu-entries config))))
|
||||
(append entries (bootloader-configuration-menu-entries config)))
|
||||
|
||||
(define (boot-parameters->gexp params)
|
||||
(let ((label (boot-parameters-label params))
|
||||
(kernel (boot-parameters-kernel params))
|
||||
(kernel-arguments (boot-parameters-kernel-arguments params))
|
||||
(initrd (boot-parameters-initrd params)))
|
||||
(define (menu-entry->gexp entry)
|
||||
(let ((label (menu-entry-label entry))
|
||||
(kernel (menu-entry-linux entry))
|
||||
(kernel-arguments (menu-entry-linux-arguments entry))
|
||||
(initrd (menu-entry-initrd entry)))
|
||||
#~(format port "LABEL ~a
|
||||
MENU LABEL ~a
|
||||
KERNEL ~a
|
||||
|
|
@ -69,11 +68,11 @@ TIMEOUT ~a~%"
|
|||
(if (> timeout 0) 1 0)
|
||||
;; timeout is expressed in 1/10s of seconds.
|
||||
(* 10 timeout))
|
||||
#$@(map boot-parameters->gexp all-entries)
|
||||
#$@(map menu-entry->gexp all-entries)
|
||||
|
||||
#$@(if (pair? old-entries)
|
||||
#~((format port "~%")
|
||||
#$@(map boot-parameters->gexp old-entries)
|
||||
#$@(map menu-entry->gexp old-entries)
|
||||
(format port "~%"))
|
||||
#~())))))
|
||||
|
||||
|
|
|
|||
|
|
@ -316,16 +316,14 @@ 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
|
||||
(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)))
|
||||
(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))
|
||||
(kernel (menu-entry-linux entry))
|
||||
(arguments (menu-entry-linux-arguments entry))
|
||||
(initrd (menu-entry-initrd entry)))
|
||||
;; 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
|
||||
|
|
@ -341,11 +339,10 @@ entries corresponding to old generations of the system."
|
|||
#$(grub-root-search device kernel)
|
||||
#$kernel (string-join (list #$@arguments))
|
||||
#$initrd))))
|
||||
|
||||
(mlet %store-monad ((sugar (eye-candy config
|
||||
(boot-parameters-store-device
|
||||
(menu-entry-device
|
||||
(first all-entries))
|
||||
(boot-parameters-store-mount-point
|
||||
(menu-entry-device-mount-point
|
||||
(first all-entries))
|
||||
#:system system
|
||||
#:port #~port)))
|
||||
|
|
@ -362,12 +359,12 @@ set default=~a
|
|||
set timeout=~a~%"
|
||||
#$(bootloader-configuration-default-entry config)
|
||||
#$(bootloader-configuration-timeout config))
|
||||
#$@(map boot-parameters->gexp all-entries)
|
||||
#$@(map menu-entry->gexp all-entries)
|
||||
|
||||
#$@(if (pair? old-entries)
|
||||
#~((format port "
|
||||
submenu \"GNU system, old configurations...\" {~%")
|
||||
#$@(map boot-parameters->gexp old-entries)
|
||||
#$@(map menu-entry->gexp old-entries)
|
||||
(format port "}~%"))
|
||||
#~()))))
|
||||
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@
|
|||
boot-parameters-initrd
|
||||
read-boot-parameters
|
||||
read-boot-parameters-file
|
||||
menu-entry->boot-parameters
|
||||
boot-parameters->menu-entry
|
||||
|
||||
local-host-aliases
|
||||
%setuid-programs
|
||||
|
|
@ -301,17 +301,15 @@ The object has its kernel-arguments extended in order to make it bootable."
|
|||
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)
|
||||
(bootloader-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))))
|
||||
(define (boot-parameters->menu-entry conf)
|
||||
(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))))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -866,15 +864,16 @@ listed in OS. The C library expects to find it under
|
|||
(store-file-system (operating-system-file-systems os)))
|
||||
|
||||
(define* (operating-system-bootcfg os #:optional (old-entries '()))
|
||||
"Return the bootloader configuration file for OS. Use OLD-ENTRIES to
|
||||
populate the \"old entries\" menu."
|
||||
"Return the bootloader configuration file for OS. Use OLD-ENTRIES
|
||||
(which is a list of <menu-entry>) to populate the \"old entries\" menu."
|
||||
(mlet* %store-monad
|
||||
((system (operating-system-derivation os))
|
||||
(root-fs -> (operating-system-root-file-system os))
|
||||
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
|
||||
(uuid->string (file-system-device root-fs))
|
||||
(file-system-device root-fs)))
|
||||
(entry (operating-system-boot-parameters os system root-device))
|
||||
(params (operating-system-boot-parameters os system root-device))
|
||||
(entry -> (boot-parameters->menu-entry params))
|
||||
(bootloader-conf -> (operating-system-bootloader os)))
|
||||
((bootloader-configuration-file-generator
|
||||
(bootloader-configuration-bootloader bootloader-conf))
|
||||
|
|
|
|||
|
|
@ -431,8 +431,6 @@ generation as its default entry. STORE is an open connection to the store."
|
|||
"Re-install bootloader for existing system profile generation NUMBER.
|
||||
STORE is an open connection to the store."
|
||||
(let* ((generation (generation-file-name %system-profile number))
|
||||
(params (unless-file-not-found
|
||||
(read-boot-parameters-file generation)))
|
||||
;; Detect the bootloader used in %system-profile.
|
||||
(bootloader (lookup-bootloader-by-name (system-bootloader-name)))
|
||||
|
||||
|
|
@ -442,10 +440,12 @@ STORE is an open connection to the store."
|
|||
(bootloader bootloader)))
|
||||
|
||||
;; Make the specified system generation the default entry.
|
||||
(entries (profile-boot-parameters %system-profile (list number)))
|
||||
(params (profile-boot-parameters %system-profile (list number)))
|
||||
(old-generations (delv number (generation-numbers %system-profile)))
|
||||
(old-entries (profile-boot-parameters
|
||||
%system-profile old-generations)))
|
||||
(old-params (profile-boot-parameters
|
||||
%system-profile old-generations))
|
||||
(entries (map boot-parameters->menu-entry params))
|
||||
(old-entries (map boot-parameters->menu-entry old-params)))
|
||||
(run-with-store store
|
||||
(mlet* %store-monad
|
||||
((bootcfg ((bootloader-configuration-file-generator bootloader)
|
||||
|
|
@ -657,7 +657,8 @@ output when building a system derivation, such as a disk image."
|
|||
os
|
||||
(if (eq? 'init action)
|
||||
'()
|
||||
(profile-boot-parameters)))))
|
||||
(map boot-parameters->menu-entry
|
||||
(profile-boot-parameters))))))
|
||||
(bootcfg-file -> (bootloader-configuration-file bootloader))
|
||||
(bootloader-installer
|
||||
(let ((installer (bootloader-installer bootloader))
|
||||
|
|
|
|||
Loading…
Reference in New Issue