gnu: nnn: Don't use NAME in source URI.
[jackhill/guix/guix.git] / gnu / packages / bootloaders.scm
index 0db6ad3..5bd784f 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
@@ -8,6 +8,7 @@
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 nee <nee@cock.li>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module (gnu packages disk)
   #:use-module (gnu packages bison)
   #:use-module (gnu packages cdrom)
+  #:use-module (gnu packages check)
+  #:use-module (gnu packages compression)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages firmware)
   #:use-module (gnu packages python)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages tls)
+  #:use-module (gnu packages sdl)
   #:use-module (gnu packages swig)
+  #:use-module (gnu packages valgrind)
   #:use-module (gnu packages virtualization)
+  #:use-module (gnu packages xorg)
   #:use-module (gnu packages web)
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
@@ -59,7 +65,8 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26))
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 regex))
 
 (define unifont
   ;; GNU Unifont, <http://gnu.org/s/unifont>.
@@ -81,7 +88,9 @@
              (uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
              (sha256
               (base32
-               "03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))))
+               "03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))
+             (patches (search-patches "grub-check-error-efibootmgr.patch"
+                                      "grub-binutils-compat.patch"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases (modify-phases %standard-phases
                      ;; Make the font visible.
                      (copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz")
                      (system* "gunzip" "unifont.bdf.gz")
+
+                     ;; Give the absolute file name of 'ckbcomp'.
+                     (substitute* "util/grub-kbdcomp.in"
+                       (("^ckbcomp ")
+                        (string-append (assoc-ref inputs "console-setup")
+                                       "/bin/ckbcomp ")))
                      #t))
                   (add-before 'check 'disable-flaky-test
                     (lambda _
        ;; to determine whether the root file system is RAID.
        ("mdadm" ,mdadm)
 
+       ;; Console-setup's ckbcomp is invoked by grub-kbdcomp.  It is required
+       ;; for generating alternative keyboard layouts.
+       ("console-setup" ,console-setup)
+
        ("freetype" ,freetype)
        ;; ("libusb" ,libusb)
        ;; ("fuse" ,fuse)
        ("texinfo" ,texinfo)
        ("help2man" ,help2man)
 
+       ;; XXX: When building GRUB 2.02 on 32-bit x86, we need a binutils
+       ;; capable of assembling 64-bit instructions.  However, our default
+       ;; binutils on 32-bit x86 is not 64-bit capable.
+       ,@(if (string-match "^i[3456]86-" (%current-system))
+             (let ((binutils (package/inherit
+                              binutils
+                              (name "binutils-i386")
+                              (arguments
+                               (substitute-keyword-arguments (package-arguments binutils)
+                                 ((#:configure-flags flags ''())
+                                  `(cons "--enable-64-bit-bfd" ,flags)))))))
+               `(("ld-wrapper" ,(make-ld-wrapper "ld-wrapper-i386"
+                                                 #:binutils binutils))
+                 ("binutils" ,binutils)))
+             '())
+
        ;; Dependencies for the test suite.  The "real" QEMU is needed here,
        ;; because several targets are used.
        ("parted" ,parted)
@@ -283,17 +318,19 @@ menu to select one of the installed operating systems.")
            (delete 'configure)
            (add-before 'build 'set-permissions
              (lambda _
-               (zero? (system* "chmod" "a+w" "utils/isohybrid.in"))))
+               (invoke "chmod" "a+w" "utils/isohybrid.in")))
            (replace 'check
              (lambda _
                (setenv "CC" "gcc")
                (substitute* "tests/unittest/include/unittest/unittest.h"
                  ;; Don't look up headers under /usr.
                  (("/usr/include/") ""))
-               (zero? (system* "make" "unittest")))))))
-      (home-page "http://www.syslinux.org")
+               (invoke "make" "unittest"))))))
+      (home-page "https://www.syslinux.org")
       (synopsis "Lightweight Linux bootloader")
       (description "Syslinux is a lightweight Linux bootloader.")
+      ;; The Makefile specifically targets i386 and x86_64 using nasm.
+      (supported-systems '("i686-linux" "x86_64-linux"))
       (license (list license:gpl2+
                      license:bsd-3 ; gnu-efi/*
                      license:bsd-4 ; gnu-efi/inc/* gnu-efi/lib/*
@@ -303,7 +340,7 @@ menu to select one of the installed operating systems.")
 (define-public dtc
   (package
     (name "dtc")
-    (version "1.4.6")
+    (version "1.4.7")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -311,12 +348,13 @@ menu to select one of the installed operating systems.")
                     "dtc-" version ".tar.xz"))
               (sha256
                (base32
-                "0zkvih0fpwvk31aqyyfy9kn13nbi76c21ihax15p6h1wrjzh48rq"))))
+                "1rydi5jvhlhsr110h6n0pavv3daqa0cb4m5vcps50qzq1zqfhhv6"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("bison" ,bison)
        ("flex" ,flex)
-       ("swig" ,swig)))
+       ("swig" ,swig)
+       ("valgrind" ,valgrind)))
     (inputs
      `(("python-2" ,python-2)))
     (arguments
@@ -338,7 +376,7 @@ tree binary files.  These are board description files used by Linux and BSD.")
 (define u-boot
   (package
     (name "u-boot")
-    (version "2018.01")
+    (version "2019.01")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -346,20 +384,110 @@ tree binary files.  These are board description files used by Linux and BSD.")
                     "u-boot-" version ".tar.bz2"))
               (sha256
                (base32
-                "1nidnnjprgxdhiiz7gmaj8cgcf52l5gbv64cmzjq4gmkjirmk3wk"))))
+                "08hwsmh5xsb1gcxsv8gvx00bai938dm5y3889n8jif3a8rd7xgah"))))
     (native-inputs
      `(("bc" ,bc)
-       ;("dtc" ,dtc) ; they have their own incompatible copy.
+       ("bison" ,bison)
+       ("dtc" ,dtc)
+       ("flex" ,flex)
+       ("lz4" ,lz4)
+       ("openssl" ,openssl)
        ("python-2" ,python-2)
+       ("python2-coverage" ,python2-coverage)
+       ("python2-pytest" ,python2-pytest)
+       ("sdl" ,sdl)
        ("swig" ,swig)))
     (build-system  gnu-build-system)
-    (home-page "http://www.denx.de/wiki/U-Boot/")
+    (home-page "https://www.denx.de/wiki/U-Boot/")
     (synopsis "ARM bootloader")
     (description "U-Boot is a bootloader used mostly for ARM boards. It
 also initializes the boards (RAM etc).")
     (license license:gpl2+)))
 
-(define (make-u-boot-package board triplet)
+(define-public u-boot-tools
+  (package
+    (inherit u-boot)
+    (name "u-boot-tools")
+    (arguments
+     `(#:make-flags '("HOSTCC=gcc")
+       #:test-target "tests"
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "Makefile"
+              (("/bin/pwd") (which "pwd"))
+              (("/bin/false") (which "false")))
+             (substitute* "tools/dtoc/fdt_util.py"
+              (("'cc'") "'gcc'"))
+             (substitute* "tools/patman/test_util.py"
+              ;; python-coverage is simply called coverage in guix.
+              (("python-coverage") "coverage")
+              ;; XXX Allow for only 99% test coverage.
+              ;; TODO: Find out why that is needed.
+              (("if coverage != '100%':") "if not int(coverage.rstrip('%')) >= 99:"))
+             (substitute* "test/run"
+              ;; Make it easier to find test failures.
+              (("#!/bin/bash") "#!/bin/bash -x")
+              ;; pytest doesn't find it otherwise.
+              (("test/py/tests/test_ofplatdata.py")
+               "tests/test_ofplatdata.py")
+              ;; This test would require git.
+              (("\\./tools/patman/patman") (which "true"))
+              ;; This test would require internet access.
+              (("\\./tools/buildman/buildman") (which "true")))
+             (substitute* "test/py/tests/test_sandbox_exit.py"
+              (("def test_ctrl_c")
+               "@pytest.mark.skip(reason='Guix has problems with SIGINT')
+def test_ctrl_c"))
+             ;; This test requires a sound system, which is un-used in u-boot-tools.
+             (for-each (lambda (file)
+                              (substitute* file
+                                  (("CONFIG_SOUND=y") "CONFIG_SOUND=n")))
+                              (find-files "configs" "sandbox_.*defconfig$"))
+             #t))
+         (replace 'configure
+           (lambda* (#:key make-flags #:allow-other-keys)
+             (call-with-output-file "configs/tools_defconfig"
+               (lambda (port)
+                 (display "CONFIG_SYS_TEXT_BASE=0\n" port)))
+             (apply invoke "make" "tools_defconfig" make-flags)))
+         (replace 'build
+           (lambda* (#:key inputs make-flags #:allow-other-keys)
+             (apply invoke "make" "tools-all" make-flags)))
+         (replace 'install
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin")))
+               (for-each (lambda (name)
+                           (install-file name bin))
+                         '("tools/netconsole"
+                           "tools/jtagconsole"
+                           "tools/gen_eth_addr"
+                           "tools/gen_ethaddr_crc"
+                           "tools/img2srec"
+                           "tools/mkenvimage"
+                           "tools/dumpimage"
+                           "tools/mkimage"
+                           "tools/proftool"
+                           "tools/fdtgrep"
+                           "tools/env/fw_printenv"
+                           "tools/sunxi-spl-image-builder"))
+               #t)))
+           (delete 'check)
+           (add-after 'install 'check
+             (lambda* (#:key make-flags test-target #:allow-other-keys)
+               (apply invoke "make" "mrproper" make-flags)
+               (setenv "SDL_VIDEODRIVER" "dummy")
+               (setenv "PAGER" "cat")
+               (apply invoke "make" test-target make-flags)
+               (symlink "build-sandbox_spl" "sandbox")
+               (invoke "test/image/test-imagetools.sh"))))))
+    (description "U-Boot is a bootloader used mostly for ARM boards.  It
+also initializes the boards (RAM etc).  This package provides its
+board-independent tools.")))
+
+(define-public (make-u-boot-package board triplet)
   "Returns a u-boot package for BOARD cross-compiled for TRIPLET."
   (let ((same-arch? (if (string-prefix? (%current-system)
                                         (gnu-triplet->nix-system triplet))
@@ -377,7 +505,10 @@ also initializes the boards (RAM etc).")
              `(("gcc-7" ,gcc-7)))
          ,@(package-native-inputs u-boot)))
       (arguments
-       `(#:modules ((ice-9 ftw) (guix build utils) (guix build gnu-build-system))
+       `(#:modules ((ice-9 ftw)
+                    (srfi srfi-1)
+                    (guix build utils)
+                    (guix build gnu-build-system))
          #:test-target "test"
          #:make-flags
          (list "HOSTCC=gcc"
@@ -390,33 +521,49 @@ also initializes the boards (RAM etc).")
              (lambda* (#:key outputs make-flags #:allow-other-keys)
                (let ((config-name (string-append ,board "_defconfig")))
                  (if (file-exists? (string-append "configs/" config-name))
-                     (zero? (apply system* "make" `(,@make-flags ,config-name)))
+                     (apply invoke "make" `(,@make-flags ,config-name))
                      (begin
-                       (display "Invalid board name. Valid board names are:")
-                       (let ((suffix-len (string-length "_defconfig")))
-                         (scandir "configs"
-                                  (lambda (file-name)
-                                    (when (string-suffix? "_defconfig" file-name)
-                                      (format #t
-                                              "- ~A\n"
-                                              (string-drop-right file-name
-                                                                 suffix-len))))))
-                       #f)))))
+                       (display "Invalid board name. Valid board names are:"
+                                (current-error-port))
+                       (let ((suffix-len (string-length "_defconfig"))
+                             (entries (scandir "configs")))
+                         (for-each (lambda (file-name)
+                                     (when (string-suffix? "_defconfig" file-name)
+                                       (format (current-error-port)
+                                               "- ~A\n"
+                                               (string-drop-right file-name
+                                                                  suffix-len))))
+                                   (sort entries string-ci<)))
+                       (error "Invalid boardname ~s." ,board))))))
            (replace 'install
              (lambda* (#:key outputs #:allow-other-keys)
                (let* ((out (assoc-ref outputs "out"))
                       (libexec (string-append out "/libexec"))
                       (uboot-files (append
-                                    (find-files "." ".*\\.(bin|efi|img|spl|itb|dtb)$")
+                                    (remove
+                                     ;; Those would not be reproducible
+                                     ;; because of the randomness used
+                                     ;; to produce them.
+                                     ;; It's expected that the user will
+                                     ;; use u-boot-tools to generate them
+                                     ;; instead.
+                                     (lambda (name)
+                                       (string-suffix?
+                                        "sunxi-spl-with-ecc.bin"
+                                        name))
+                                     (find-files "." ".*\\.(bin|efi|img|spl|itb|dtb|rksd)$"))
                                     (find-files "." "^(MLO|SPL)$"))))
                  (mkdir-p libexec)
                  (install-file ".config" libexec)
+                 ;; Useful for "qemu -kernel".
+                 (install-file "u-boot" libexec)
                  (for-each
                   (lambda (file)
                     (let ((target-file (string-append libexec "/" file)))
                       (mkdir-p (dirname target-file))
                       (copy-file file target-file)))
-                  uboot-files))))))))))
+                  uboot-files)
+                 #t)))))))))
 
 (define-public u-boot-vexpress
   (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))
@@ -427,8 +574,8 @@ also initializes the boards (RAM etc).")
 (define-public u-boot-beagle-bone-black
   (make-u-boot-package "am335x_boneblack" "arm-linux-gnueabihf"))
 
-(define-public u-boot-pine64-plus
-  (let ((base (make-u-boot-package "pine64_plus" "aarch64-linux-gnu")))
+(define-public (make-u-boot-sunxi64-package board triplet)
+  (let ((base (make-u-boot-package board triplet)))
     (package
       (inherit base)
       (arguments
@@ -440,15 +587,22 @@ also initializes the boards (RAM etc).")
                   (let ((bl31 (string-append (assoc-ref inputs "firmware")
                                              "/bl31.bin")))
                     (setenv "BL31" bl31)
-                    ;; This is necessary while we're using the bundled dtc.
-                    (setenv "PATH" (string-append (getenv "PATH") ":"
-                                                  "scripts/dtc")))
+                    ;; This is necessary when we're using the bundled dtc.
+                    ;(setenv "PATH" (string-append (getenv "PATH") ":"
+                    ;                              "scripts/dtc"))
+                    )
                   #t))))))
       (native-inputs
-       `(("firmware" ,arm-trusted-firmware-pine64-plus)
+       `(("firmware" ,arm-trusted-firmware-sun50i-a64)
          ,@(package-native-inputs base))))))
 
-(define-public u-boot-banana-pi-m2-ultra
+(define-public u-boot-pine64-plus
+  (make-u-boot-sunxi64-package "pine64_plus" "aarch64-linux-gnu"))
+
+(define-public u-boot-pinebook
+  (make-u-boot-sunxi64-package "pinebook" "aarch64-linux-gnu"))
+
+(define-public u-boot-bananapi-m2-ultra
   (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf"))
 
 (define-public u-boot-a20-olinuxino-lime
@@ -469,6 +623,46 @@ also initializes the boards (RAM etc).")
 (define-public u-boot-mx6cuboxi
   (make-u-boot-package "mx6cuboxi" "arm-linux-gnueabihf"))
 
+(define-public u-boot-novena
+  (make-u-boot-package "novena" "arm-linux-gnueabihf"))
+
+(define-public u-boot-cubieboard
+  (make-u-boot-package "Cubieboard" "arm-linux-gnueabihf"))
+
+(define-public u-boot-cubietruck
+  (make-u-boot-package "Cubietruck" "arm-linux-gnueabihf"))
+
+(define-public u-boot-puma-rk3399
+  (let ((base (make-u-boot-package "puma-rk3399" "aarch64-linux-gnu")))
+    (package
+      (inherit base)
+      (arguments
+       (substitute-keyword-arguments (package-arguments base)
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (add-after 'unpack 'set-environment
+               (lambda* (#:key inputs #:allow-other-keys)
+                 ;; Need to copy the firmware into u-boot build
+                 ;; directory.
+                 (copy-file (string-append (assoc-ref inputs "firmware")
+                                           "/bl31.bin") "bl31-rk3399.bin")
+                 (copy-file (string-append (assoc-ref inputs "firmware-m0")
+                                           "/rk3399m0.bin") "rk3399m0.bin")
+                 #t))
+             (add-after 'build 'build-itb
+               (lambda* (#:key make-flags #:allow-other-keys)
+                 ;; The u-boot.itb is not built by default.
+                 (apply invoke "make" `(,@make-flags ,"u-boot.itb"))))
+             (add-after 'build-itb 'build-rksd
+               (lambda* (#:key inputs #:allow-other-keys)
+                 ;; Build Rockchip SD card images.
+                 (invoke "./tools/mkimage" "-T" "rksd" "-n" "rk3399" "-d"
+                         "spl/u-boot-spl.bin" "u-boot-spl.rksd")))))))
+      (native-inputs
+       `(("firmware" ,arm-trusted-firmware-puma-rk3399)
+         ("firmware-m0" ,rk3399-cortex-m0)
+         ,@(package-native-inputs base))))))
+
 (define-public vboot-utils
   (package
     (name "vboot-utils")
@@ -483,10 +677,25 @@ also initializes the boards (RAM etc).")
               (file-name (string-append name "-" version "-checkout"))
               (sha256
                (base32
-                "0h0m3l69vp9dr6xrs1p6y7ilkq3jq8jraw2z20kqfv7lvc9l1lxj"))))
+                "0h0m3l69vp9dr6xrs1p6y7ilkq3jq8jraw2z20kqfv7lvc9l1lxj"))
+              (patches
+               (search-patches "vboot-utils-skip-test-workbuf.patch"
+                               "vboot-utils-fix-tests-show-contents.patch"
+                               "vboot-utils-fix-format-load-address.patch"))))
     (build-system gnu-build-system)
     (arguments
      `(#:make-flags (list "CC=gcc"
+                          ;; On ARM, we must pass "HOST_ARCH=arm" so that the
+                          ;; ${HOST_ARCH} and ${ARCH} variables in the makefile
+                          ;; match.  Otherwise, ${HOST_ARCH} will be assigned
+                          ;; "armv7l", the value of `uname -m`, and will not
+                          ;; match ${ARCH}, which will make the tests require
+                          ;; QEMU for testing.
+                          ,@(if (string-prefix? "arm"
+                                                (or (%current-target-system)
+                                                    (%current-system)))
+                                '("HOST_ARCH=arm")
+                                '())
                           (string-append "DESTDIR=" (assoc-ref %outputs "out")))
        #:phases (modify-phases %standard-phases
                   (add-after 'unpack 'patch-hard-coded-paths
@@ -512,7 +721,14 @@ also initializes the boards (RAM etc).")
                                         ".drv-0/source")))
                       ;; Tests require write permissions to many of these files.
                       (for-each make-file-writable (find-files "tests/futility"))
-                      #t)))
+                      #t))
+                  (add-after 'install 'install-devkeys
+                    (lambda* (#:key outputs #:allow-other-keys)
+                      (let* ((out (assoc-ref outputs "out"))
+                             (share (string-append out "/share/vboot-utils")))
+                        (copy-recursively "tests/devkeys"
+                                          (string-append share "/devkeys"))
+                        #t))))
        #:test-target "runtests"))
     (native-inputs
      `(("pkg-config" ,pkg-config)