aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--build-aux/hydra/demo-os.scm3
-rw-r--r--gnu/system.scm11
-rw-r--r--gnu/system/grub.scm39
3 files changed, 38 insertions, 15 deletions
diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm
index 32c6fa3abf..fe9c77242e 100644
--- a/build-aux/hydra/demo-os.scm
+++ b/build-aux/hydra/demo-os.scm
@@ -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.
diff --git a/gnu/system.scm b/gnu/system.scm
index ec3e2fcd6c..dd44878462 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -39,10 +39,11 @@
#: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 @@
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 @@ we're running in the final root."
#~(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."
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 1893672a2a..e789e4c591 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -25,8 +25,13 @@
#: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 @@
;;;
;;; 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 @@
(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 @@
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))