gnu: Add gst-python.
[jackhill/guix/guix.git] / gnu / packages / grub.scm
index 71c4fad..96d284c 100644 (file)
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
 (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)
   #:use-module (gnu packages flex)
   #:use-module (gnu packages bison)
-  #:use-module ((gnu packages gettext) #:renamer (symbol-prefix-proc 'gnu:))
+  #:use-module (gnu packages gettext)
   #:use-module (gnu packages fontutils)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages qemu)
+  #:use-module (gnu packages man)
+  #:use-module (gnu packages texinfo)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages cdrom)
-  #:use-module (srfi srfi-1)
-  #:use-module (ice-9 match)
-  #:export (menu-entry
-            menu-entry?
-            grub-configuration-file))
+  #:use-module (srfi srfi-1))
 
 (define qemu-for-tests
   ;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
@@ -45,7 +42,7 @@
   ;; <https://bugs.launchpad.net/bugs/947597> and fixed at
   ;; <http://bzr.savannah.gnu.org/lh/grub/trunk/grub/revision/4828>.
   ;; Work around it by using an older QEMU.
-  (package (inherit qemu)
+  (package (inherit qemu-minimal)
     (version "1.3.1")
     (source (origin
              (method url-fetch)
     ;;   ERROR:tests/rtc-test.c:176:check_time: assertion failed (ABS(t - s) <= wiggle): (382597824 <= 2)
     ;; Simply disable the tests.
     (arguments `(#:tests? #f
-                          ,@(package-arguments qemu)))
+                 ,@(package-arguments qemu-minimal)))
 
     ;; The manual fails to build with Texinfo 5.x.
     (native-inputs (alist-delete "texinfo" (package-native-inputs qemu)))))
 
+(define unifont
+  ;; GNU Unifont, <http://gnu.org/s/unifont>.
+  ;; GRUB needs it for its graphical terminal, gfxterm.
+  (origin
+    (method url-fetch)
+    (uri
+     "http://unifoundry.com/pub/unifont-7.0.06/font-builds/unifont-7.0.06.bdf.gz")
+    (sha256
+     (base32
+      "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys"))))
+
 (define-public grub
   (package
     (name "grub")
                                  version ".tar.xz"))
              (sha256
               (base32
-               "0n64hpmsccvicagvr0c6v0kgp2yw0kgnd3jvsyd26cnwgs7c6kkq"))))
+               "0n64hpmsccvicagvr0c6v0kgp2yw0kgnd3jvsyd26cnwgs7c6kkq"))
+             (patches (list (search-patch "grub-gets-undeclared.patch")
+                            (search-patch "grub-freetype.patch")
+                            (search-patch "grub-CVE-2015-8370.patch")))))
     (build-system gnu-build-system)
     (arguments
-     '(#:patches (list (assoc-ref %build-inputs "patch/gets"))
-       #:configure-flags '("--disable-werror")
-       #:phases (alist-cons-before
-                 'patch-source-shebangs 'patch-stuff
-                 (lambda _
-                   (substitute* "grub-core/Makefile.in"
-                     (("/bin/sh") (which "sh")))
+     '(#:configure-flags '("--disable-werror")
+       #:phases (modify-phases %standard-phases
+                  (add-after
+                   'unpack 'patch-stuff
+                   (lambda* (#:key inputs #:allow-other-keys)
+                     (substitute* "grub-core/Makefile.in"
+                       (("/bin/sh") (which "sh")))
+
+                     ;; Make the font visible.
+                     (copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz")
+                     (system* "gunzip" "unifont.bdf.gz")
+
+                     ;; TODO: Re-enable this test when we have Parted.
+                     (substitute* "tests/partmap_test.in"
+                       (("set -e") "exit 77"))
 
-                   ;; TODO: Re-enable this test when we have Parted.
-                   (substitute* "tests/partmap_test.in"
-                     (("set -e") "exit 77")))
-                 %standard-phases)))
+                     #t)))))
     (inputs
      `(;; ("lvm2" ,lvm2)
-       ("gettext" ,gnu:gettext)
+       ("gettext" ,gnu-gettext)
        ("freetype" ,freetype)
        ;; ("libusb" ,libusb)
-       ("ncurses" ,ncurses)
-
-       ("patch/gets" ,(search-patch "grub-gets-undeclared.patch"))))
+       ;; ("fuse" ,fuse)
+       ("ncurses" ,ncurses)))
     (native-inputs
-     `(("bison" ,bison)
+     `(("unifont" ,unifont)
+       ("bison" ,bison)
        ("flex" ,flex)
+       ("texinfo" ,texinfo)
+       ("help2man" ,help2man)
 
        ;; Dependencies for the test suite.  The "real" QEMU is needed here,
        ;; because several targets are used.
        ("qemu" ,qemu-for-tests)
        ("xorriso" ,xorriso)))
     (home-page "http://www.gnu.org/software/grub/")
-    (synopsis "GRand unified boot loader")
+    (synopsis "GRand Unified Boot loader")
     (description
-     "GNU GRUB is a Multiboot boot loader. It was derived from GRUB, GRand
-Unified Bootloader, which was originally designed and implemented by Erich
-Stefan Boleyn.
-
-Briefly, the boot loader is the first software program that runs when a
-computer starts.  It is responsible for loading and transferring control to
-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).")
+     "GRUB is a multiboot bootloader.  It is used for initially loading the
+kernel of an operating system and then transferring control to it.  The kernel
+then goes on to load the rest of the operating system.  As a multiboot
+bootloader, GRUB handles the presence of multiple operating systems installed
+on the same computer; upon booting the computer, the user is presented with a
+menu to select one of the installed operating systems.")
     (license gpl3+)))
-
-\f
-;;;
-;;; 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)))
-                     '()))