gnu/packages/bootloaders.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
   5 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;; Copyright © 2016, 2017, 2018 Marius Bakke <mbakke@fastmail.com>
   7 ;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym@scratchpost.org>
   8 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
   9 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
  10 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
  11 ;;;
  12 ;;; This file is part of GNU Guix.
  13 ;;;
  14 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  15 ;;; under the terms of the GNU General Public License as published by
  16 ;;; the Free Software Foundation; either version 3 of the License, or (at
  17 ;;; your option) any later version.
  18 ;;;
  19 ;;; GNU Guix is distributed in the hope that it will be useful, but
  20 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;;; GNU General Public License for more details.
  23 ;;;
  24 ;;; You should have received a copy of the GNU General Public License
  25 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 (define-module (gnu packages bootloaders)
  28   #:use-module (gnu packages)
  29   #:use-module (gnu packages admin)
  30   #:use-module ((gnu packages algebra) #:select (bc))
  31   #:use-module (gnu packages assembly)
  32   #:use-module (gnu packages base)
  33   #:use-module (gnu packages disk)
  34   #:use-module (gnu packages bison)
  35   #:use-module (gnu packages cdrom)
  36   #:use-module (gnu packages check)
  37   #:use-module (gnu packages cross-base)
  38   #:use-module (gnu packages disk)
  39   #:use-module (gnu packages firmware)
  40   #:use-module (gnu packages flex)
  41   #:use-module (gnu packages fontutils)
  42   #:use-module (gnu packages gcc)
  43   #:use-module (gnu packages gettext)
  44   #:use-module (gnu packages linux)
  45   #:use-module (gnu packages man)
  46   #:use-module (gnu packages mtools)
  47   #:use-module (gnu packages ncurses)
  48   #:use-module (gnu packages perl)
  49   #:use-module (gnu packages pkg-config)
  50   #:use-module (gnu packages python)
  51   #:use-module (gnu packages texinfo)
  52   #:use-module (gnu packages tls)
  53   #:use-module (gnu packages sdl)
  54   #:use-module (gnu packages swig)
  55   #:use-module (gnu packages virtualization)
  56   #:use-module (gnu packages web)
  57   #:use-module (guix build-system gnu)
  58   #:use-module (guix download)
  59   #:use-module (guix git-download)
  60   #:use-module ((guix licenses) #:prefix license:)
  61   #:use-module (guix packages)
  62   #:use-module (guix utils)
  63   #:use-module (srfi srfi-1)
  64   #:use-module (srfi srfi-26)
  65   #:use-module (ice-9 regex))
  66
  67 (define unifont
  68   ;; GNU Unifont, <http://gnu.org/s/unifont>.
  69   ;; GRUB needs it for its graphical terminal, gfxterm.
  70   (origin
  71     (method url-fetch)
  72     (uri
  73      "http://unifoundry.com/pub/unifont-7.0.06/font-builds/unifont-7.0.06.bdf.gz")
  74     (sha256
  75      (base32
  76       "0p2vhnc18cnbmb39vq4m7hzv4mhnm2l0a2s7gx3ar277fwng3hys"))))
  77
  78 (define-public grub
  79   (package
  80     (name "grub")
  81     (version "2.02")
  82     (source (origin
  83              (method url-fetch)
  84              (uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
  85              (sha256
  86               (base32
  87                "03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))))
  88     (build-system gnu-build-system)
  89     (arguments
  90      `(#:phases (modify-phases %standard-phases
  91                   (add-after 'unpack 'patch-stuff
  92                    (lambda* (#:key inputs #:allow-other-keys)
  93                      (substitute* "grub-core/Makefile.in"
  94                        (("/bin/sh") (which "sh")))
  95
  96                      ;; Give the absolute file name of 'mdadm', used to
  97                      ;; determine the root file system when it's a RAID
  98                      ;; device.  Failing to do that, 'grub-probe' silently
  99                      ;; fails if 'mdadm' is not in $PATH.
 100                      (substitute* "grub-core/osdep/linux/getroot.c"
 101                        (("argv\\[0\\] = \"mdadm\"")
 102                         (string-append "argv[0] = \""
 103                                        (assoc-ref inputs "mdadm")
 104                                        "/sbin/mdadm\"")))
 105
 106                      ;; Make the font visible.
 107                      (copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz")
 108                      (system* "gunzip" "unifont.bdf.gz")
 109                      #t))
 110                   (add-before 'check 'disable-flaky-test
 111                     (lambda _
 112                       ;; This test is unreliable. For more information, see:
 113                       ;; <https://bugs.gnu.org/26936>.
 114                       (substitute* "Makefile.in"
 115                         (("grub_cmd_date grub_cmd_set_date grub_cmd_sleep")
 116                           "grub_cmd_date grub_cmd_sleep"))
 117                       #t)))
 118        ;; Disable tests on ARM and AARCH64 platforms.
 119        #:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system)
 120                                                        (%current-system)))
 121                            '("arm" "aarch64")))))
 122     (inputs
 123      `(("gettext" ,gettext-minimal)
 124
 125        ;; Depend on LVM2 for libdevmapper, used by 'grub-probe' and
 126        ;; 'grub-install' to recognize mapped devices (LUKS, etc.)
 127        ("lvm2" ,lvm2)
 128
 129        ;; Depend on mdadm, which is invoked by 'grub-probe' and 'grub-install'
 130        ;; to determine whether the root file system is RAID.
 131        ("mdadm" ,mdadm)
 132
 133        ("freetype" ,freetype)
 134        ;; ("libusb" ,libusb)
 135        ;; ("fuse" ,fuse)
 136        ("ncurses" ,ncurses)))
 137     (native-inputs
 138      `(("pkg-config" ,pkg-config)
 139        ("unifont" ,unifont)
 140        ("bison" ,bison)
 141        ;; Due to a bug in flex >= 2.6.2, GRUB must be built with an older flex:
 142        ;; <http://lists.gnu.org/archive/html/grub-devel/2017-02/msg00133.html>
 143        ;; TODO Try building with flex > 2.6.4.
 144        ("flex" ,flex-2.6.1)
 145        ("texinfo" ,texinfo)
 146        ("help2man" ,help2man)
 147
 148        ;; XXX: When building GRUB 2.02 on 32-bit x86, we need a binutils
 149        ;; capable of assembling 64-bit instructions.  However, our default
 150        ;; binutils on 32-bit x86 is not 64-bit capable.
 151        ,@(if (string-match "^i[3456]86-" (%current-system))
 152              (let ((binutils (package/inherit
 153                               binutils
 154                               (name "binutils-i386")
 155                               (arguments
 156                                (substitute-keyword-arguments (package-arguments binutils)
 157                                  ((#:configure-flags flags ''())
 158                                   `(cons "--enable-64-bit-bfd" ,flags)))))))
 159                `(("ld-wrapper" ,(make-ld-wrapper "ld-wrapper-i386"
 160                                                  #:binutils binutils))
 161                  ("binutils" ,binutils)))
 162              '())
 163
 164        ;; Dependencies for the test suite.  The "real" QEMU is needed here,
 165        ;; because several targets are used.
 166        ("parted" ,parted)
 167        ("qemu" ,qemu-minimal-2.10)
 168        ("xorriso" ,xorriso)))
 169     (home-page "https://www.gnu.org/software/grub/")
 170     (synopsis "GRand Unified Boot loader")
 171     (description
 172      "GRUB is a multiboot bootloader.  It is used for initially loading the
 173 kernel of an operating system and then transferring control to it.  The kernel
 174 then goes on to load the rest of the operating system.  As a multiboot
 175 bootloader, GRUB handles the presence of multiple operating systems installed
 176 on the same computer; upon booting the computer, the user is presented with a
 177 menu to select one of the installed operating systems.")
 178     (license license:gpl3+)
 179     (properties '((cpe-name . "grub2")))))
 180
 181 (define-public grub-efi
 182   (package
 183     (inherit grub)
 184     (name "grub-efi")
 185     (synopsis "GRand Unified Boot loader (UEFI version)")
 186     (inputs
 187      `(("efibootmgr" ,efibootmgr)
 188        ("mtools" ,mtools)
 189        ,@(package-inputs grub)))
 190     (arguments
 191      `(;; TODO: Tests need a UEFI firmware for qemu. There is one at
 192        ;; https://github.com/tianocore/edk2/tree/master/OvmfPkg .
 193        ;; Search for 'OVMF' in "tests/util/grub-shell.in".
 194        ,@(substitute-keyword-arguments (package-arguments grub)
 195            ((#:tests? _ #f) #f)
 196            ((#:configure-flags flags ''())
 197             `(cons "--with-platform=efi" ,flags))
 198            ((#:phases phases)
 199             `(modify-phases ,phases
 200                (add-after 'patch-stuff 'use-absolute-efibootmgr-path
 201                  (lambda* (#:key inputs #:allow-other-keys)
 202                    (substitute* "grub-core/osdep/unix/platform.c"
 203                      (("efibootmgr")
 204                       (string-append (assoc-ref inputs "efibootmgr")
 205                                      "/sbin/efibootmgr")))
 206                    #t))
 207                (add-after 'patch-stuff 'use-absolute-mtools-path
 208                  (lambda* (#:key inputs #:allow-other-keys)
 209                    (let ((mtools (assoc-ref inputs "mtools")))
 210                      (substitute* "util/grub-mkrescue.c"
 211                        (("\"mformat\"")
 212                         (string-append "\"" mtools
 213                                        "/bin/mformat\"")))
 214                      (substitute* "util/grub-mkrescue.c"
 215                        (("\"mcopy\"")
 216                         (string-append "\"" mtools
 217                                        "/bin/mcopy\"")))
 218                      #t))))))))))
 219
 220 ;; Because grub searches hardcoded paths it's easiest to just build grub
 221 ;; again to make it find both grub-pc and grub-efi.  There is a command
 222 ;; line argument which allows you to specify ONE platform - but
 223 ;; grub-mkrescue will use multiple platforms if they are available
 224 ;; in the installation directory (without command line argument).
 225 (define-public grub-hybrid
 226   (package
 227     (inherit grub-efi)
 228     (name "grub-hybrid")
 229     (synopsis "GRand Unified Boot loader (hybrid version)")
 230     (inputs
 231      `(("grub" ,grub)
 232        ,@(package-inputs grub-efi)))
 233     (arguments
 234      (substitute-keyword-arguments (package-arguments grub-efi)
 235        ((#:modules modules `((guix build utils) (guix build gnu-build-system)))
 236         `((ice-9 ftw) ,@modules))
 237        ((#:phases phases)
 238         `(modify-phases ,phases
 239            (add-after 'install 'install-non-efi
 240              (lambda* (#:key inputs outputs #:allow-other-keys)
 241                (let ((input-dir (string-append (assoc-ref inputs "grub")
 242                                                "/lib/grub"))
 243                      (output-dir (string-append (assoc-ref outputs "out")
 244                                                 "/lib/grub")))
 245                  (for-each
 246                   (lambda (basename)
 247                     (if (not (or (string-prefix? "." basename)
 248                                  (file-exists? (string-append output-dir "/" basename))))
 249                         (symlink (string-append input-dir "/" basename)
 250                                  (string-append output-dir "/" basename))))
 251                   (scandir input-dir))
 252                  #t)))))))))
 253
 254 (define-public syslinux
 255   (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
 256     (package
 257       (name "syslinux")
 258       (version (git-version "6.04-pre" "1" commit))
 259       (source (origin
 260                 (method git-fetch)
 261                 (uri (git-reference
 262                       (url "https://github.com/geneC/syslinux")
 263                       (commit commit)))
 264                 (file-name (git-file-name name version))
 265                 (sha256
 266                  (base32
 267                   "0k8dvafd6410kqxf3kyr4y8jzmpmrih6wbjqg6gklak7945yflrc"))))
 268       (build-system gnu-build-system)
 269       (native-inputs
 270        `(("nasm" ,nasm)
 271          ("perl" ,perl)
 272          ("python-2" ,python-2)))
 273       (inputs
 274        `(("libuuid" ,util-linux)
 275          ("mtools" ,mtools)))
 276       (arguments
 277        `(#:parallel-build? #f
 278          #:make-flags
 279          (list (string-append "BINDIR=" %output "/bin")
 280                (string-append "SBINDIR=" %output "/sbin")
 281                (string-append "LIBDIR=" %output "/lib")
 282                (string-append "INCDIR=" %output "/include")
 283                (string-append "DATADIR=" %output "/share")
 284                (string-append "MANDIR=" %output "/share/man")
 285                "PERL=perl"
 286                "bios")
 287          #:phases
 288          (modify-phases %standard-phases
 289            (add-after 'unpack 'patch-files
 290              (lambda* (#:key inputs #:allow-other-keys)
 291                (substitute* (find-files "." "Makefile.*|ppmtolss16")
 292                  (("/bin/pwd") (which "pwd"))
 293                  (("/bin/echo") (which "echo"))
 294                  (("/usr/bin/perl") (which "perl")))
 295                (let ((mtools (assoc-ref inputs "mtools")))
 296                  (substitute* (find-files "." "\\.c$")
 297                    (("mcopy")
 298                     (string-append mtools "/bin/mcopy"))
 299                    (("mattrib")
 300                     (string-append mtools "/bin/mattrib"))))
 301                #t))
 302            (delete 'configure)
 303            (add-before 'build 'set-permissions
 304              (lambda _
 305                (zero? (system* "chmod" "a+w" "utils/isohybrid.in"))))
 306            (replace 'check
 307              (lambda _
 308                (setenv "CC" "gcc")
 309                (substitute* "tests/unittest/include/unittest/unittest.h"
 310                  ;; Don't look up headers under /usr.
 311                  (("/usr/include/") ""))
 312                (zero? (system* "make" "unittest")))))))
 313       (home-page "http://www.syslinux.org")
 314       (synopsis "Lightweight Linux bootloader")
 315       (description "Syslinux is a lightweight Linux bootloader.")
 316       (license (list license:gpl2+
 317                      license:bsd-3 ; gnu-efi/*
 318                      license:bsd-4 ; gnu-efi/inc/* gnu-efi/lib/*
 319                      ;; Also contains:
 320                      license:expat license:isc license:zlib)))))
 321
 322 (define-public dtc
 323   (package
 324     (name "dtc")
 325     (version "1.4.6")
 326     (source (origin
 327               (method url-fetch)
 328               (uri (string-append
 329                     "mirror://kernel.org/software/utils/dtc/"
 330                     "dtc-" version ".tar.xz"))
 331               (sha256
 332                (base32
 333                 "0zkvih0fpwvk31aqyyfy9kn13nbi76c21ihax15p6h1wrjzh48rq"))))
 334     (build-system gnu-build-system)
 335     (native-inputs
 336      `(("bison" ,bison)
 337        ("flex" ,flex)
 338        ("swig" ,swig)))
 339     (inputs
 340      `(("python-2" ,python-2)))
 341     (arguments
 342      `(#:make-flags
 343        (list "CC=gcc"
 344              (string-append "PREFIX=" (assoc-ref %outputs "out"))
 345              (string-append "SETUP_PREFIX=" (assoc-ref %outputs "out"))
 346              "INSTALL=install")
 347        #:phases
 348        (modify-phases %standard-phases
 349          (delete 'configure))))         ; no configure script
 350     (home-page "https://www.devicetree.org")
 351     (synopsis "Compiles device tree source files")
 352     (description "@command{dtc} compiles
 353 @uref{http://elinux.org/Device_Tree_Usage, device tree source files} to device
 354 tree binary files.  These are board description files used by Linux and BSD.")
 355     (license license:gpl2+)))
 356
 357 (define u-boot
 358   (package
 359     (name "u-boot")
 360     (version "2018.07")
 361     (source (origin
 362               (method url-fetch)
 363               (uri (string-append
 364                     "ftp://ftp.denx.de/pub/u-boot/"
 365                     "u-boot-" version ".tar.bz2"))
 366               (sha256
 367                (base32
 368                 "1m7nw64mxflpc6sqvnz2kb5fxfkb4mrpy8b1wi15dcwipj4dy44z"))))
 369     (native-inputs
 370      `(("bc" ,bc)
 371        ("bison" ,bison)
 372        ("dtc" ,dtc)
 373        ("flex" ,flex)
 374        ("openssl" ,openssl)
 375        ("python-2" ,python-2)
 376        ("python2-coverage" ,python2-coverage)
 377        ("python2-pytest" ,python2-pytest)
 378        ("sdl" ,sdl)
 379        ("swig" ,swig)))
 380     (build-system  gnu-build-system)
 381     (home-page "http://www.denx.de/wiki/U-Boot/")
 382     (synopsis "ARM bootloader")
 383     (description "U-Boot is a bootloader used mostly for ARM boards. It
 384 also initializes the boards (RAM etc).")
 385     (license license:gpl2+)))
 386
 387 (define-public u-boot-tools
 388   (package
 389     (inherit u-boot)
 390     (name "u-boot-tools")
 391     (arguments
 392      `(#:make-flags '("HOSTCC=gcc")
 393        #:test-target "tests"
 394        #:phases
 395        (modify-phases %standard-phases
 396          (add-after 'unpack 'patch
 397            (lambda* (#:key inputs #:allow-other-keys)
 398              (substitute* "Makefile"
 399               (("/bin/pwd") (which "pwd"))
 400               (("/bin/false") (which "false")))
 401              (substitute* "tools/dtoc/fdt_util.py"
 402               (("'cc'") "'gcc'"))
 403              (substitute* "test/run"
 404               ;; Make it easier to find test failures.
 405               (("#!/bin/bash") "#!/bin/bash -x")
 406               ;; pytest doesn't find it otherwise.
 407               (("test/py/tests/test_ofplatdata.py")
 408                "tests/test_ofplatdata.py")
 409               ;; This test would require git.
 410               (("\\./tools/patman/patman") (which "true"))
 411               ;; This test would require internet access.
 412               (("\\./tools/buildman/buildman") (which "true")))
 413              (substitute* "test/py/tests/test_sandbox_exit.py"
 414               (("def test_ctrl_c")
 415                "@pytest.mark.skip(reason='Guix has problems with SIGINT')
 416 def test_ctrl_c"))
 417              (substitute* "tools/binman/binman.py"
 418               (("100%") "99%")) ; TODO: Find out why that is needed.
 419              #t))
 420          (replace 'configure
 421            (lambda* (#:key make-flags #:allow-other-keys)
 422              (call-with-output-file "configs/tools_defconfig"
 423                (lambda (port)
 424                  (display "CONFIG_SYS_TEXT_BASE=0\n" port)))
 425              (apply invoke "make" "tools_defconfig" make-flags)))
 426          (replace 'build
 427            (lambda* (#:key inputs make-flags #:allow-other-keys)
 428              (apply invoke "make" "tools-only" make-flags)
 429              (apply invoke "make" "envtools" make-flags)
 430              (invoke "make" "-C" "tools" "sunxi-spl-image-builder")))
 431          (replace 'install
 432            (lambda* (#:key outputs #:allow-other-keys)
 433              (let* ((out (assoc-ref outputs "out"))
 434                     (bin (string-append out "/bin")))
 435                (for-each (lambda (name)
 436                            (install-file name bin))
 437                          '("tools/netconsole"
 438                            "tools/jtagconsole"
 439                            "tools/gen_eth_addr"
 440                            "tools/gen_ethaddr_crc"
 441                            "tools/img2srec"
 442                            "tools/mkenvimage"
 443                            "tools/dumpimage"
 444                            "tools/mkimage"
 445                            "tools/proftool"
 446                            "tools/fdtgrep"
 447                            "tools/env/fw_printenv"
 448                            "tools/sunxi-spl-image-builder"))
 449                #t)))
 450            (delete 'check)
 451            (add-after 'install 'check
 452              (lambda* (#:key make-flags test-target #:allow-other-keys)
 453                (apply invoke "make" "mrproper" make-flags)
 454                (setenv "SDL_VIDEODRIVER" "dummy")
 455                (setenv "PAGER" "cat")
 456                (apply invoke "make" test-target make-flags)
 457                (symlink "build-sandbox_spl" "sandbox")
 458                (invoke "test/image/test-imagetools.sh"))))))
 459     (description "U-Boot is a bootloader used mostly for ARM boards.  It
 460 also initializes the boards (RAM etc).  This package provides its
 461 board-independent tools.")))
 462
 463 (define-public (make-u-boot-package board triplet)
 464   "Returns a u-boot package for BOARD cross-compiled for TRIPLET."
 465   (let ((same-arch? (if (string-prefix? (%current-system)
 466                                         (gnu-triplet->nix-system triplet))
 467                       `#t
 468                       `#f)))
 469     (package
 470       (inherit u-boot)
 471       (name (string-append "u-boot-"
 472                            (string-replace-substring (string-downcase board)
 473                                                      "_" "-")))
 474       (native-inputs
 475        `(,@(if (not same-arch?)
 476              `(("cross-gcc" ,(cross-gcc triplet #:xgcc gcc-7))
 477                ("cross-binutils" ,(cross-binutils triplet)))
 478              `(("gcc-7" ,gcc-7)))
 479          ,@(package-native-inputs u-boot)))
 480       (arguments
 481        `(#:modules ((ice-9 ftw) (guix build utils) (guix build gnu-build-system))
 482          #:test-target "test"
 483          #:make-flags
 484          (list "HOSTCC=gcc"
 485                ,@(if (not same-arch?)
 486                    `((string-append "CROSS_COMPILE=" ,triplet "-"))
 487                    '()))
 488          #:phases
 489          (modify-phases %standard-phases
 490            (replace 'configure
 491              (lambda* (#:key outputs make-flags #:allow-other-keys)
 492                (let ((config-name (string-append ,board "_defconfig")))
 493                  (if (file-exists? (string-append "configs/" config-name))
 494                      (zero? (apply system* "make" `(,@make-flags ,config-name)))
 495                      (begin
 496                        (display "Invalid board name. Valid board names are:"
 497                                 (current-error-port))
 498                        (let ((suffix-len (string-length "_defconfig"))
 499                              (entries (scandir "configs")))
 500                          (for-each (lambda (file-name)
 501                                      (when (string-suffix? "_defconfig" file-name)
 502                                        (format (current-error-port)
 503                                                "- ~A\n"
 504                                                (string-drop-right file-name
 505                                                                   suffix-len))))
 506                                    (sort entries string-ci<)))
 507                        (error "Invalid boardname ~s." ,board))))))
 508            (replace 'install
 509              (lambda* (#:key outputs #:allow-other-keys)
 510                (let* ((out (assoc-ref outputs "out"))
 511                       (libexec (string-append out "/libexec"))
 512                       (uboot-files (append
 513                                     (find-files "." ".*\\.(bin|efi|img|spl|itb|dtb|rksd)$")
 514                                     (find-files "." "^(MLO|SPL)$"))))
 515                  (mkdir-p libexec)
 516                  (install-file ".config" libexec)
 517                  ;; Useful for "qemu -kernel".
 518                  (install-file "u-boot" libexec)
 519                  (for-each
 520                   (lambda (file)
 521                     (let ((target-file (string-append libexec "/" file)))
 522                       (mkdir-p (dirname target-file))
 523                       (copy-file file target-file)))
 524                   uboot-files)
 525                  #t)))))))))
 526
 527 (define-public u-boot-vexpress
 528   (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))
 529
 530 (define-public u-boot-malta
 531   (make-u-boot-package "malta" "mips64el-linux-gnuabi64"))
 532
 533 (define-public u-boot-beagle-bone-black
 534   (make-u-boot-package "am335x_boneblack" "arm-linux-gnueabihf"))
 535
 536 (define-public u-boot-pine64-plus
 537   (let ((base (make-u-boot-package "pine64_plus" "aarch64-linux-gnu")))
 538     (package
 539       (inherit base)
 540       (arguments
 541         (substitute-keyword-arguments (package-arguments base)
 542           ((#:phases phases)
 543            `(modify-phases ,phases
 544               (add-after 'unpack 'set-environment
 545                 (lambda* (#:key inputs #:allow-other-keys)
 546                   (let ((bl31 (string-append (assoc-ref inputs "firmware")
 547                                              "/bl31.bin")))
 548                     (setenv "BL31" bl31)
 549                     ;; This is necessary when we're using the bundled dtc.
 550                     ;(setenv "PATH" (string-append (getenv "PATH") ":"
 551                     ;                              "scripts/dtc"))
 552                     )
 553                   #t))))))
 554       (native-inputs
 555        `(("firmware" ,arm-trusted-firmware-pine64-plus)
 556          ,@(package-native-inputs base))))))
 557
 558 (define-public u-boot-banana-pi-m2-ultra
 559   (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf"))
 560
 561 (define-public u-boot-a20-olinuxino-lime
 562   (make-u-boot-package "A20-OLinuXino-Lime" "arm-linux-gnueabihf"))
 563
 564 (define-public u-boot-a20-olinuxino-lime2
 565   (make-u-boot-package "A20-OLinuXino-Lime2" "arm-linux-gnueabihf"))
 566
 567 (define-public u-boot-a20-olinuxino-micro
 568   (make-u-boot-package "A20-OLinuXino_MICRO" "arm-linux-gnueabihf"))
 569
 570 (define-public u-boot-nintendo-nes-classic-edition
 571   (make-u-boot-package "Nintendo_NES_Classic_Edition" "arm-linux-gnueabihf"))
 572
 573 (define-public u-boot-wandboard
 574   (make-u-boot-package "wandboard" "arm-linux-gnueabihf"))
 575
 576 (define-public u-boot-mx6cuboxi
 577   (make-u-boot-package "mx6cuboxi" "arm-linux-gnueabihf"))
 578
 579 (define-public u-boot-novena
 580   (make-u-boot-package "novena" "arm-linux-gnueabihf"))
 581
 582 (define-public u-boot-cubieboard
 583   (make-u-boot-package "Cubieboard" "arm-linux-gnueabihf"))
 584
 585 (define-public u-boot-puma-rk3399
 586   (let ((base (make-u-boot-package "puma-rk3399" "aarch64-linux-gnu")))
 587     (package
 588       (inherit base)
 589       (arguments
 590        (substitute-keyword-arguments (package-arguments base)
 591          ((#:phases phases)
 592           `(modify-phases ,phases
 593              (add-after 'unpack 'set-environment
 594                (lambda* (#:key inputs #:allow-other-keys)
 595                  ;; Need to copy the firmware into u-boot build
 596                  ;; directory.
 597                  (copy-file (string-append (assoc-ref inputs "firmware")
 598                                            "/bl31.bin") "bl31-rk3399.bin")
 599                  (copy-file (string-append (assoc-ref inputs "firmware-m0")
 600                                            "/rk3399m0.bin") "rk3399m0.bin")
 601                  #t))
 602              (add-after 'build 'build-itb
 603                (lambda* (#:key make-flags #:allow-other-keys)
 604                  ;; The u-boot.itb is not built by default.
 605                  (apply invoke "make" `(,@make-flags ,"u-boot.itb"))))
 606              (add-after 'build-itb 'build-rksd
 607                (lambda* (#:key inputs #:allow-other-keys)
 608                  ;; Build Rockchip SD card images.
 609                  (invoke "./tools/mkimage" "-T" "rksd" "-n" "rk3399" "-d"
 610                          "spl/u-boot-spl.bin" "u-boot-spl.rksd")))))))
 611       (native-inputs
 612        `(("firmware" ,arm-trusted-firmware-puma-rk3399)
 613          ("firmware-m0" ,rk3399-cortex-m0)
 614          ,@(package-native-inputs base))))))
 615
 616 (define-public vboot-utils
 617   (package
 618     (name "vboot-utils")
 619     (version "R63-10032.B")
 620     (source (origin
 621               ;; XXX: Snapshots are available but changes timestamps every download.
 622               (method git-fetch)
 623               (uri (git-reference
 624                     (url (string-append "https://chromium.googlesource.com"
 625                                         "/chromiumos/platform/vboot_reference"))
 626                     (commit (string-append "release-" version))))
 627               (file-name (string-append name "-" version "-checkout"))
 628               (sha256
 629                (base32
 630                 "0h0m3l69vp9dr6xrs1p6y7ilkq3jq8jraw2z20kqfv7lvc9l1lxj"))))
 631     (build-system gnu-build-system)
 632     (arguments
 633      `(#:make-flags (list "CC=gcc"
 634                           (string-append "DESTDIR=" (assoc-ref %outputs "out")))
 635        #:phases (modify-phases %standard-phases
 636                   (add-after 'unpack 'patch-hard-coded-paths
 637                     (lambda* (#:key inputs outputs #:allow-other-keys)
 638                       (let ((coreutils (assoc-ref inputs "coreutils"))
 639                             (diffutils (assoc-ref inputs "diffutils")))
 640                         (substitute* "futility/misc.c"
 641                           (("/bin/cp") (string-append coreutils "/bin/cp")))
 642                         (substitute* "tests/bitmaps/TestBmpBlock.py"
 643                           (("/usr/bin/cmp") (string-append diffutils "/bin/cmp")))
 644                         (substitute* "vboot_host.pc.in"
 645                           (("prefix=/usr")
 646                            (string-append "prefix=" (assoc-ref outputs "out"))))
 647                         #t)))
 648                   (delete 'configure)
 649                   (add-before 'check 'patch-tests
 650                     (lambda _
 651                       ;; These tests compare diffs against known-good values.
 652                       ;; Patch the paths to match those in the build container.
 653                       (substitute* (find-files "tests/futility/expect_output")
 654                         (("/mnt/host/source/src/platform/vboot_reference")
 655                          (string-append "/tmp/guix-build-" ,name "-" ,version
 656                                         ".drv-0/source")))
 657                       ;; Tests require write permissions to many of these files.
 658                       (for-each make-file-writable (find-files "tests/futility"))
 659                       #t)))
 660        #:test-target "runtests"))
 661     (native-inputs
 662      `(("pkg-config" ,pkg-config)
 663
 664        ;; For tests.
 665        ("diffutils" ,diffutils)
 666        ("python@2" ,python-2)))
 667     (inputs
 668      `(("coreutils" ,coreutils)
 669        ("libyaml" ,libyaml)
 670        ("openssl" ,openssl)
 671        ("openssl:static" ,openssl "static")
 672        ("util-linux" ,util-linux)))
 673     (home-page
 674      "https://dev.chromium.org/chromium-os/chromiumos-design-docs/verified-boot")
 675     (synopsis "ChromiumOS verified boot utilities")
 676     (description
 677      "vboot-utils is a collection of tools to facilitate booting of
 678 Chrome-branded devices.  This includes the @command{cgpt} partitioning
 679 program, the @command{futility} and @command{crossystem} firmware management
 680 tools, and more.")
 681     (license license:bsd-3)))
 682
 683 (define-public os-prober
 684   (package
 685     (name "os-prober")
 686     (version "1.76")
 687     (source
 688      (origin
 689        (method url-fetch)
 690        (uri (string-append "mirror://debian/pool/main/o/os-prober/os-prober_"
 691                            version ".tar.xz"))
 692        (sha256
 693         (base32
 694          "1vb45i76bqivlghrq7m3n07qfmmq4wxrkplqx8gywj011rhq19fk"))))
 695     (build-system gnu-build-system)
 696     (arguments
 697      `(#:modules ((guix build gnu-build-system)
 698                   (guix build utils)
 699                   (ice-9 regex)   ; for string-match
 700                   (srfi srfi-26)) ; for cut
 701        #:make-flags (list "CC=gcc")
 702        #:tests? #f ; no tests
 703        #:phases
 704        (modify-phases %standard-phases
 705          (replace 'configure
 706            (lambda* (#:key outputs #:allow-other-keys)
 707              (substitute* (find-files ".")
 708                (("/usr") (assoc-ref outputs "out")))
 709              (substitute* (find-files "." "50mounted-tests$")
 710                (("mkdir") "mkdir -p"))
 711              #t))
 712          (replace 'install
 713            (lambda* (#:key outputs #:allow-other-keys)
 714              (define (find-files-non-recursive directory)
 715                (find-files directory
 716                            (lambda (file stat)
 717                              (string-match (string-append "^" directory "/[^/]*$")
 718                                            file))
 719                            #:directories? #t))
 720
 721              (let* ((out (assoc-ref outputs "out"))
 722                     (bin (string-append out "/bin"))
 723                     (lib (string-append out "/lib"))
 724                     (share (string-append out "/share")))
 725                (for-each (cut install-file <> bin)
 726                          (list "linux-boot-prober" "os-prober"))
 727                (install-file "newns" (string-append lib "/os-prober"))
 728                (install-file "common.sh" (string-append share "/os-prober"))
 729                (install-file "os-probes/mounted/powerpc/20macosx"
 730                              (string-append lib "/os-probes/mounted"))
 731                (for-each
 732                 (lambda (directory)
 733                   (for-each
 734                    (lambda (file)
 735                      (let ((destination (string-append lib "/" directory
 736                                                        "/" (basename file))))
 737                        (mkdir-p (dirname destination))
 738                        (copy-recursively file destination)))
 739                    (append (find-files-non-recursive (string-append directory "/common"))
 740                            (find-files-non-recursive (string-append directory "/x86")))))
 741                 (list "os-probes" "os-probes/mounted" "os-probes/init"
 742                       "linux-boot-probes" "linux-boot-probes/mounted"))
 743                #t))))))
 744     (home-page "https://joeyh.name/code/os-prober")
 745     (synopsis "Detect other operating systems")
 746     (description "os-prober probes disks on the system for other operating
 747 systems so that they can be added to the bootloader.  It also works out how to
 748 boot existing GNU/Linux systems and detects what distribution is installed in
 749 order to add a suitable bootloader menu entry.")
 750     (license license:gpl2+)))