diff options
| -rw-r--r-- | build-aux/hydra/demo-os.scm | 3 | ||||
| -rw-r--r-- | gnu/system.scm | 11 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 39 |
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)) |