gnu: grub: Add support for building configuration files.

* gnu/packages/grub.scm (<menu-entry>): 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

@@ -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>
+  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
+<menu-entry> 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
+                  (($ <menu-entry> _ linux)
+                   (let* ((drv (package-derivation store linux system))
+                          (out (derivation-path->output-path drv)))
+                     (string-append out "/bzImage"))))
+                 entries)))
+
+  (define entry->text
+    (match-lambda
+     (($ <menu-entry> 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)))
+                     '()))

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)
+                     grub-configuration
-                     (linux-arguments '())
-                     (initrd qemu-initrd)
                      (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
+disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its
-arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk.
+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")
+            (grub.cfg (assoc-ref %build-inputs "grub.cfg")))
-                                    "/initrd"))
-            (linux   (string-append (assoc-ref %build-inputs "linux")
-                                    "/bzImage")))
 
         (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")
+                      (symlink grub.cfg "/fs/boot/grub/grub.cfg")
-                      (copy-file initrd "/fs/boot/initrd")
 
                       ;; 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?
+                           (zero? (system* umount "/fs"))
-                            (system* umount "/fs"))
                            (reboot))))))))
    #:system system
    #:inputs `(("parted" ,parted)
               ("grub" ,grub)
               ("e2fsprogs" ,e2fsprogs)
-              ("linux" ,linux-libre)
+              ("grub.cfg" ,grub-configuration)
-              ("initrd" ,initrd)
 
               ;; 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)