mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -05:00
system: Add 'grub-configuration' record.
* gnu/system/grub.scm (<grub-configuration>): New record type. (grub-configuration-file): Add 'config' parameter; remove #:default-entry and #:timeout. Honor CONFIG. * gnu/system.scm (<operating-system>): Remove 'bootloader-entries' field; remove default value for 'bootloader' field. (operating-system-grub.cfg): Pass the 'bootloader' field to 'grub-configuration-file'. * build-aux/hydra/demo-os.scm (bootloader): New field.
This commit is contained in:
parent
72b9d60df4
commit
d5b429abda
3 changed files with 38 additions and 15 deletions
|
@ -33,6 +33,7 @@
|
|||
(gnu packages tor)
|
||||
(gnu packages package-management)
|
||||
|
||||
(gnu system grub) ; 'grub-configuration'
|
||||
(gnu system shadow) ; 'user-account'
|
||||
(gnu system linux) ; 'base-pam-services'
|
||||
(gnu services base)
|
||||
|
@ -43,6 +44,8 @@
|
|||
(host-name "gnu")
|
||||
(timezone "Europe/Paris")
|
||||
(locale "en_US.UTF-8")
|
||||
(bootloader (grub-configuration
|
||||
(device "/dev/sda")))
|
||||
(file-systems
|
||||
;; We provide a dummy file system for /, but that's OK because the VM build
|
||||
;; code will automatically declare the / file system for us.
|
||||
|
|
|
@ -39,10 +39,11 @@ (define-module (gnu system)
|
|||
#:use-module (srfi srfi-26)
|
||||
#:export (operating-system
|
||||
operating-system?
|
||||
|
||||
operating-system-bootloader
|
||||
operating-system-services
|
||||
operating-system-user-services
|
||||
operating-system-packages
|
||||
operating-system-bootloader-entries
|
||||
operating-system-host-name
|
||||
operating-system-kernel
|
||||
operating-system-initrd
|
||||
|
@ -83,10 +84,8 @@ (define-record-type* <operating-system> operating-system
|
|||
operating-system?
|
||||
(kernel operating-system-kernel ; package
|
||||
(default linux-libre))
|
||||
(bootloader operating-system-bootloader ; package
|
||||
(default grub))
|
||||
(bootloader-entries operating-system-bootloader-entries ; list
|
||||
(default '()))
|
||||
(bootloader operating-system-bootloader) ; <grub-configuration>
|
||||
|
||||
(initrd operating-system-initrd ; (list fs) -> M derivation
|
||||
(default qemu-initrd))
|
||||
|
||||
|
@ -504,7 +503,7 @@ (define (operating-system-grub.cfg os)
|
|||
#~(string-append "--load=" #$system
|
||||
"/boot")))
|
||||
(initrd #~(string-append #$system "/initrd"))))))
|
||||
(grub-configuration-file entries)))
|
||||
(grub-configuration-file (operating-system-bootloader os) entries)))
|
||||
|
||||
(define (operating-system-derivation os)
|
||||
"Return a derivation that builds OS."
|
||||
|
|
|
@ -25,8 +25,13 @@ (define-module (gnu system grub)
|
|||
#:use-module (guix gexp)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (menu-entry
|
||||
#:export (grub-configuration
|
||||
grub-configuration?
|
||||
grub-configuration-device
|
||||
|
||||
menu-entry
|
||||
menu-entry?
|
||||
|
||||
grub-configuration-file))
|
||||
|
||||
;;; Commentary:
|
||||
|
@ -35,6 +40,19 @@ (define-module (gnu system grub)
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define-record-type* <grub-configuration>
|
||||
grub-configuration make-grub-configuration
|
||||
grub-configuration?
|
||||
(grub grub-configuration-grub ; package
|
||||
(default (@ (gnu packages grub) grub)))
|
||||
(device grub-configuration-device) ; string
|
||||
(menu-entries grub-configuration-menu-entries ; list
|
||||
(default '()))
|
||||
(default-entry grub-configuration-default-entry ; integer
|
||||
(default 1))
|
||||
(timeout grub-configuration-timeout ; integer
|
||||
(default 5)))
|
||||
|
||||
(define-record-type* <menu-entry>
|
||||
menu-entry make-menu-entry
|
||||
menu-entry?
|
||||
|
@ -44,11 +62,13 @@ (define-record-type* <menu-entry>
|
|||
(default '())) ; list of string-valued gexps
|
||||
(initrd menu-entry-initrd)) ; file name of the initrd as a gexp
|
||||
|
||||
(define* (grub-configuration-file entries
|
||||
#:key (default-entry 1) (timeout 5)
|
||||
(system (%current-system)))
|
||||
"Return the GRUB configuration file for ENTRIES, a list of
|
||||
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
|
||||
(define* (grub-configuration-file config entries
|
||||
#:key (system (%current-system)))
|
||||
"Return the GRUB configuration file corresponding to CONFIG, a
|
||||
<grub-configuration> object."
|
||||
(define all-entries
|
||||
(append entries (grub-configuration-menu-entries config)))
|
||||
|
||||
(define entry->gexp
|
||||
(match-lambda
|
||||
(($ <menu-entry> label linux arguments initrd)
|
||||
|
@ -67,12 +87,13 @@ (define builder
|
|||
set default=~a
|
||||
set timeout=~a
|
||||
search.file ~a/bzImage~%"
|
||||
#$default-entry #$timeout
|
||||
#$(grub-configuration-default-entry config)
|
||||
#$(grub-configuration-timeout config)
|
||||
#$(any (match-lambda
|
||||
(($ <menu-entry> _ linux)
|
||||
linux))
|
||||
entries))
|
||||
#$@(map entry->gexp entries))))
|
||||
all-entries))
|
||||
#$@(map entry->gexp all-entries))))
|
||||
|
||||
(gexp->derivation "grub.cfg" builder))
|
||||
|
||||
|
|
Loading…
Reference in a new issue