futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

bootloader: Use <menu-entry> for the bootloader side.

Browse Source 
* 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 2017-06-29 12:42:59 +02:00
parent 9ca8aa38ec
commit 1975c754f4
No known key found for this signature in database
GPG Key ID: E71A35542C30BAA5
5 changed files with 44 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gnu/bootloader.scm
View File

@ -30,6 +30,7 @@
menu-entry-linux menu-entry-linux
menu-entry-linux-arguments menu-entry-linux-arguments
menu-entry-initrd menu-entry-initrd
menu-entry-device-mount-point
bootloader bootloader
bootloader? bootloader?
@ -67,6 +68,8 @@
(label menu-entry-label) (label menu-entry-label)
(device menu-entry-device ; file system uuid, label, or #f (device menu-entry-device ; file system uuid, label, or #f
(default #f)) (default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
(linux menu-entry-linux) (linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments (linux-arguments menu-entry-linux-arguments
(default '())) ; list of string-valued gexps (default '())) ; list of string-valued gexps

17
gnu/bootloader/extlinux.scm
View File

@ -38,14 +38,13 @@
corresponding to old generations of the system." corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (map menu-entry->boot-parameters (append entries (bootloader-configuration-menu-entries config)))
(bootloader-configuration-menu-entries config))))
(define (boot-parameters->gexp params) (define (menu-entry->gexp entry)
(let ((label (boot-parameters-label params)) (let ((label (menu-entry-label entry))
(kernel (boot-parameters-kernel params)) (kernel (menu-entry-linux entry))
(kernel-arguments (boot-parameters-kernel-arguments params)) (kernel-arguments (menu-entry-linux-arguments entry))
(initrd (boot-parameters-initrd params))) (initrd (menu-entry-initrd entry)))
#~(format port "LABEL ~a #~(format port "LABEL ~a
MENU LABEL ~a MENU LABEL ~a
KERNEL ~a KERNEL ~a
@ -69,11 +68,11 @@ TIMEOUT ~a~%"
(if (> timeout 0) 1 0) (if (> timeout 0) 1 0)
;; timeout is expressed in 1/10s of seconds. ;; timeout is expressed in 1/10s of seconds.
(* 10 timeout)) (* 10 timeout))
#$@(map boot-parameters->gexp all-entries) #$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
#~((format port "~%") #~((format port "~%")
#$@(map boot-parameters->gexp old-entries) #$@(map menu-entry->gexp old-entries)
(format port "~%")) (format port "~%"))
#~()))))) #~())))))

27
gnu/bootloader/grub.scm
View File

@ -316,16 +316,14 @@ code."
STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system." entries corresponding to old generations of the system."
(define all-entries (define all-entries
(append entries (map menu-entry->boot-parameters (append entries (bootloader-configuration-menu-entries config)))
(bootloader-configuration-menu-entries config)))) (define (menu-entry->gexp entry)
(let ((device (menu-entry-device entry))
(define (boot-parameters->gexp params) (device-mount-point (menu-entry-device-mount-point entry))
(let ((device (boot-parameters-store-device params)) (label (menu-entry-label entry))
(device-mount-point (boot-parameters-store-mount-point params)) (kernel (menu-entry-linux entry))
(label (boot-parameters-label params)) (arguments (menu-entry-linux-arguments entry))
(kernel (boot-parameters-kernel params)) (initrd (menu-entry-initrd entry)))
(arguments (boot-parameters-kernel-arguments params))
(initrd (boot-parameters-initrd params)))
;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
;; Use the right file names for KERNEL 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 ;; 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) #$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments)) #$kernel (string-join (list #$@arguments))
#$initrd)))) #$initrd))))
(mlet %store-monad ((sugar (eye-candy config (mlet %store-monad ((sugar (eye-candy config
(boot-parameters-store-device (menu-entry-device
(first all-entries)) (first all-entries))
(boot-parameters-store-mount-point (menu-entry-device-mount-point
(first all-entries)) (first all-entries))
#:system system #:system system
#:port #~port))) #:port #~port)))
@ -362,12 +359,12 @@ set default=~a
set timeout=~a~%" set timeout=~a~%"
#$(bootloader-configuration-default-entry config) #$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config)) #$(bootloader-configuration-timeout config))
#$@(map boot-parameters->gexp all-entries) #$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
#~((format port " #~((format port "
submenu \"GNU system, old configurations...\" {~%") submenu \"GNU system, old configurations...\" {~%")
#$@(map boot-parameters->gexp old-entries) #$@(map menu-entry->gexp old-entries)
(format port "}~%")) (format port "}~%"))
#~())))) #~()))))

29
gnu/system.scm
View File

@ -112,7 +112,7 @@
boot-parameters-initrd boot-parameters-initrd
read-boot-parameters read-boot-parameters
read-boot-parameters-file read-boot-parameters-file
menu-entry->boot-parameters boot-parameters->menu-entry
local-host-aliases local-host-aliases
%setuid-programs %setuid-programs
@ -301,17 +301,15 @@ The object has its kernel-arguments extended in order to make it bootable."
root-device))) root-device)))
#f))) #f)))
(define (menu-entry->boot-parameters menu-entry) (define (boot-parameters->menu-entry conf)
"Convert a <menu-entry> instance to a corresponding <boot-parameters>." (menu-entry
(boot-parameters (label (boot-parameters-label conf))
(label (menu-entry-label menu-entry)) (device (boot-parameters-store-device conf))
(root-device #f) (device-mount-point (boot-parameters-store-mount-point conf))
(bootloader-name 'custom) (linux (boot-parameters-kernel conf))
(store-device #f) (linux-arguments (boot-parameters-kernel-arguments conf))
(store-mount-point #f) (initrd (boot-parameters-initrd conf))))
(kernel (menu-entry-linux menu-entry))
(kernel-arguments (menu-entry-linux-arguments menu-entry))
(initrd (menu-entry-initrd menu-entry))))
;;; ;;;
@ -866,15 +864,16 @@ listed in OS. The C library expects to find it under
(store-file-system (operating-system-file-systems os))) (store-file-system (operating-system-file-systems os)))
(define* (operating-system-bootcfg os #:optional (old-entries '())) (define* (operating-system-bootcfg os #:optional (old-entries '()))
"Return the bootloader configuration file for OS. Use OLD-ENTRIES to "Return the bootloader configuration file for OS. Use OLD-ENTRIES
populate the \"old entries\" menu." (which is a list of <menu-entry>) to populate the \"old entries\" menu."
(mlet* %store-monad (mlet* %store-monad
((system (operating-system-derivation os)) ((system (operating-system-derivation os))
(root-fs -> (operating-system-root-file-system os)) (root-fs -> (operating-system-root-file-system os))
(root-device -> (if (eq? 'uuid (file-system-title root-fs)) (root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs)) (uuid->string (file-system-device root-fs))
(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-conf -> (operating-system-bootloader os)))
((bootloader-configuration-file-generator ((bootloader-configuration-file-generator
(bootloader-configuration-bootloader bootloader-conf)) (bootloader-configuration-bootloader bootloader-conf))

13
guix/scripts/system.scm
View File

@ -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. "Re-install bootloader for existing system profile generation NUMBER.
STORE is an open connection to the store." STORE is an open connection to the store."
(let* ((generation (generation-file-name %system-profile number)) (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. ;; Detect the bootloader used in %system-profile.
(bootloader (lookup-bootloader-by-name (system-bootloader-name))) (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
@ -442,10 +440,12 @@ STORE is an open connection to the store."
(bootloader bootloader))) (bootloader bootloader)))
;; Make the specified system generation the default entry. ;; 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-generations (delv number (generation-numbers %system-profile)))
(old-entries (profile-boot-parameters (old-params (profile-boot-parameters
%system-profile old-generations))) %system-profile old-generations))
(entries (map boot-parameters->menu-entry params))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store (run-with-store store
(mlet* %store-monad (mlet* %store-monad
((bootcfg ((bootloader-configuration-file-generator bootloader) ((bootcfg ((bootloader-configuration-file-generator bootloader)
@ -657,7 +657,8 @@ output when building a system derivation, such as a disk image."
os os
(if (eq? 'init action) (if (eq? 'init action)
'() '()
(profile-boot-parameters))))) (map boot-parameters->menu-entry
(profile-boot-parameters))))))
(bootcfg-file -> (bootloader-configuration-file bootloader)) (bootcfg-file -> (bootloader-configuration-file bootloader))
(bootloader-installer (bootloader-installer
(let ((installer (bootloader-installer bootloader)) (let ((installer (bootloader-installer bootloader))