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:
Ludovic Courtès 2014-05-18 21:58:01 +02:00
parent 72b9d60df4
commit d5b429abda
3 changed files with 38 additions and 15 deletions

View File

@ -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.

View File

@ -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."

View File

@ -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))