From 0e2ddecd8e9a0f2dc856f2a2da9a9c98688d195c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 7 Sep 2013 17:23:23 +0200 Subject: gnu: grub: Add support for building configuration files. * gnu/packages/grub.scm (): New record type. (grub-configuration-file): New procedure. * gnu/system/vm.scm (qemu-image): Remove parameters 'linux', 'linux-arguments', and 'initrd'. Add 'grub-configuration' parameter. Honor them, and remove grub.cfg generation code accordingly. (example2): Use `grub-configuration-file', and adjust accordingly. --- gnu/packages/grub.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++- gnu/system/vm.scm | 52 ++++++++++++++++-------------------------- 2 files changed, 80 insertions(+), 34 deletions(-) (limited to 'gnu') diff --git a/gnu/packages/grub.scm b/gnu/packages/grub.scm index 8c981bf88d..71c4fad781 100644 --- a/gnu/packages/grub.scm +++ b/gnu/packages/grub.scm @@ -19,6 +19,9 @@ (define-module (gnu packages grub) #:use-module (guix download) #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (guix derivations) #:use-module ((guix licenses) #:select (gpl3+)) #:use-module (guix build-system gnu) #:use-module (gnu packages) @@ -30,7 +33,11 @@ (define-module (gnu packages grub) #:use-module (gnu packages qemu) #:use-module (gnu packages ncurses) #:use-module (gnu packages cdrom) - #:use-module (srfi srfi-1)) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:export (menu-entry + menu-entry? + grub-configuration-file)) (define qemu-for-tests ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown' @@ -110,3 +117,56 @@ (define-public grub the operating system kernel software (such as the Hurd or the Linux). The kernel, in turn, initializes the rest of the operating system (e.g., GNU).") (license gpl3+))) + + +;;; +;;; Configuration. +;;; + +(define-record-type* + menu-entry make-menu-entry + menu-entry? + (label menu-entry-label) + (linux menu-entry-linux) + (linux-arguments menu-entry-linux-arguments + (default '())) + (initrd menu-entry-initrd)) + +(define* (grub-configuration-file store entries + #:key (default-entry 1) (timeout 5) + (system (%current-system))) + "Return the GRUB configuration file in STORE for ENTRIES, a list of + objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." + (define prologue + (format #f " +set default=~a +set timeout=~a +search.file ~a~%" + default-entry timeout + (any (match-lambda + (($ _ linux) + (let* ((drv (package-derivation store linux system)) + (out (derivation-path->output-path drv))) + (string-append out "/bzImage")))) + entries))) + + (define entry->text + (match-lambda + (($ label linux arguments initrd) + (let ((linux-drv (package-derivation store linux system)) + (initrd-drv (package-derivation store initrd system))) + ;; XXX: Assume that INITRD is a directory containing an 'initrd' file. + (format #f "menuentry ~s { + linux ~a/bzImage ~a + initrd ~a/initrd +}~%" + label + (derivation-path->output-path linux-drv) + (string-join arguments) + (derivation-path->output-path initrd-drv)))))) + + (add-text-to-store store "grub.cfg" + (string-append prologue + (string-concatenate + (map entry->text entries))) + '())) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 28ab4663b3..73543896ef 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -180,15 +180,13 @@ (define* (qemu-image store #:key (name "qemu-image") (system (%current-system)) (disk-image-size (* 100 (expt 2 20))) - (linux linux-libre) - (linux-arguments '()) - (initrd qemu-initrd) + grub-configuration (populate #f) (inputs '()) (inputs-to-copy '())) "Return a bootable, stand-alone QEMU image. The returned image is a full -disk image, with a GRUB installation whose default entry boots LINUX, with the -arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk. +disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its +configuration file. INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied into the image being built. @@ -224,10 +222,7 @@ (define input->name+derivation "/sbin/grub-install")) (umount (string-append (assoc-ref %build-inputs "util-linux") "/bin/umount")) ; XXX: add to Guile - (initrd (string-append (assoc-ref %build-inputs "initrd") - "/initrd")) - (linux (string-append (assoc-ref %build-inputs "linux") - "/bzImage"))) + (grub.cfg (assoc-ref %build-inputs "grub.cfg"))) (define (read-reference-graph port) ;; Return a list of store paths from the reference graph at PORT. @@ -280,8 +275,7 @@ (define (graph-from-file file) (mkdir "/fs") (mount "/dev/vda1" "/fs" "ext3") (mkdir-p "/fs/boot/grub") - (copy-file linux "/fs/boot/bzImage") - (copy-file initrd "/fs/boot/initrd") + (symlink grub.cfg "/fs/boot/grub/grub.cfg") ;; Populate the image's store. (mkdir-p (string-append "/fs" ,%store-directory)) @@ -289,7 +283,7 @@ (define (graph-from-file file) (copy-recursively thing (string-append "/fs" thing))) - (things-to-copy)) + (cons grub.cfg (things-to-copy))) ;; Populate /dev. (make-essential-device-nodes #:root "/fs") @@ -300,32 +294,17 @@ (define (graph-from-file file) (primitive-load populate) (chdir "/"))) - ;; TODO: Move to a GRUB menu builder. - (call-with-output-file "/fs/boot/grub/grub.cfg" - (lambda (p) - (format p " -set default=1 -set timeout=5 -search.file /boot/bzImage - -menuentry \"Boot-to-Guile! (GNU System technology preview)\" { - linux /boot/bzImage ~a - initrd /boot/initrd -}" - ,(string-join linux-arguments)))) (and (zero? (system* grub "--no-floppy" "--boot-directory" "/fs/boot" "/dev/vda")) - (zero? - (system* umount "/fs")) + (zero? (system* umount "/fs")) (reboot)))))))) #:system system #:inputs `(("parted" ,parted) ("grub" ,grub) ("e2fsprogs" ,e2fsprogs) - ("linux" ,linux-libre) - ("initrd" ,initrd) + ("grub.cfg" ,grub-configuration) ;; For shell scripts. ("sed" ,(car (assoc-ref %final-inputs "sed"))) @@ -420,14 +399,21 @@ (define (example2) ;; Directly into mingetty. (execl ,getty "mingetty" "--noclear" "tty1"))) - (list out)))) + (list out))) + (entries (list (menu-entry + (label "Boot-to-Guile! (GNU System technology preview)") + (linux linux-libre) + (linux-arguments `("--root=/dev/vda1" + ,(string-append "--load=" boot))) + (initrd gnu-system-initrd)))) + (grub.cfg (grub-configuration-file store entries))) (qemu-image store + #:grub-configuration grub.cfg #:populate populate - #:initrd gnu-system-initrd - #:linux-arguments `("--root=/dev/vda1" - ,(string-append "--load=" boot)) #:disk-image-size (* 400 (expt 2 20)) #:inputs-to-copy `(("boot" ,boot) + ("linux" ,linux-libre) + ("initrd" ,gnu-system-initrd) ("coreutils" ,coreutils) ("bash" ,bash) ("guile" ,guile-2.0) -- cgit v1.2.3