code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages bison)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages m4)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages flex)
  #:use-module (srfi srfi-1))

(define-public bison
  (package
    (name "bison")
    (version "3.0.4")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "mirror://gnu/bison/bison-"
                          version ".tar.xz"))
      (sha256
       (base32
        "1qbgf6q1n2z17k8g33444m0q68kf3fbiq65q7jlrzpvvj73jh957"))))
    (build-system gnu-build-system)
    (native-inputs `(("perl" ,perl)
                     ;; m4 is not present in PATH when cross-building
                     ("m4" ,m4)))
    (inputs `(("flex" ,flex)))
    (propagated-inputs `(("m4" ,m4)))
    (home-page "https://www.gnu.org/software/bison/")
    (synopsis "Parser generator")
    (description
     "GNU Bison is a general-purpose parser generator.  It can build a
deterministic or generalized LR parser from an annotated, context-free
grammar.  It is versatile enough to have many applications, from parsers for
simple tools through complex programming languages.")
    (license gpl3+)))

(define-public bison-2.7
  (package (inherit bison)
    (version "2.7")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "mirror://gnu/bison/bison-"
                          version ".tar.xz"))
      (sha256
       (base32
        "1zd77ilmpv5mi3kr55jrj6ncqlcnyhpianhrwzak2q28cv2cbn23"))))))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Taylan Ulrich Bayirli/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2018 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Tomáš Čech <sleep_walker@gnu.org>
;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2018 Fis Trivial <ybbs.daans@hotmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages bittorrent)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system python)
  #:use-module (guix build-system glib-or-gtk)
  #:use-module ((guix licenses) #:prefix l:)
  #:use-module (gnu packages)
  #:use-module (gnu packages adns)
  #:use-module (gnu packages boost)
  #:use-module (gnu packages check)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages crypto)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages cyrus-sasl)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages file)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages gstreamer)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages libevent)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages nettle)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages qt)
  #:use-module (gnu packages ssh)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages xml))

(define-public transmission
  (package
    (name "transmission")
    (version "2.94")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://github.com/transmission/transmission-releases/raw/"
                    "master/transmission-" version ".tar.xz"))
              (sha256
               (base32
                "0zbbj7rlm6m7vb64x68a64cwmijhsrwx9l63hbwqs7zr9742qi1m"))))
    (build-system glib-or-gtk-build-system)
    (outputs '("out"                      ; library and command-line interface
               "gui"))                    ; graphical user interface
    (arguments
     '(#:glib-or-gtk-wrap-excluded-outputs '("out")
       #:phases
       (modify-phases %standard-phases
         (add-after 'install 'move-gui
           (lambda* (#:key outputs #:allow-other-keys)
             ;; Move the GUI to its own output, so that "out" doesn't
             ;; depend on GTK+.
             (let ((out (assoc-ref outputs "out"))
                   (gui (assoc-ref outputs "gui")))
               (mkdir-p (string-append gui "/bin"))
               (rename-file (string-append out "/bin/transmission-gtk")
                            (string-append gui
                                           "/bin/transmission-gtk"))

               ;; Move the '.desktop' file as well.
               (mkdir (string-append gui "/share"))
               (rename-file (string-append out "/share/applications")
                            (string-append gui "/share/applications")))
             #t)))))
    (inputs
     `(("inotify-tools" ,inotify-tools)
       ("libevent" ,libevent)
       ("curl" ,curl)
       ("cyrus-sasl" ,cyrus-sasl)
       ("openssl" ,openssl)
       ("file" ,file)
       ("zlib" ,zlib)
       ("gtk+" ,gtk+)))
    (native-inputs
     `(("intltool" ,intltool)
       ("pkg-config" ,pkg-config)))
    (home-page "http://www.transmissionbt.com/")
    (synopsis "Fast and easy BitTorrent client")
    (description
     "Transmission is a BitTorrent client that comes with graphical,
textual, and Web user interfaces.  Transmission also has a daemon for
unattended operations.  It supports local peer discovery, full encryption,
DHT, µTP, PEX and Magnet Links.")

    ;; COPYING reads:
    ;;
    ;;     Transmission can be redistributed and/or modified under the terms of
    ;; the GNU GPLv2 (http://www.gnu.org/licenses/license-list.html#GPLv2),
    ;; the GNU GPLv3 (http://www.gnu.org/licenses/license-list.html#GNUGPLv3),
    ;; or any future license endorsed by Mnemosyne LLC.
    ;;
    ;; A few files files carry an MIT/X11 license header.
    (license l:gpl3+)))

(define-public libtorrent
  (package
    (name "libtorrent")
    (version "0.13.6")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "http://rtorrent.net/downloads/libtorrent-"
                    version ".tar.gz"))
              (sha256
               (base32
                "012s1nwcvz5m5r4d2z9klgy2n34kpgn9kgwgzxm97zgdjs6a0f18"))))
    (build-system gnu-build-system)
    (inputs `(("openssl" ,openssl)
              ("zlib" ,zlib)))
    (native-inputs `(("pkg-config" ,pkg-config)
                     ("cppunit" ,cppunit)))
    (synopsis "BitTorrent library of rtorrent")
    (description
     "LibTorrent is a BitTorrent library used by and developed in parallel
with the BitTorrent client rtorrent.  It is written in C++ with emphasis on
speed and efficiency.")
    (home-page "https://github.com/rakshasa/libtorrent")
    (license l:gpl2+)))

(define-public rtorrent
  (package
    (name "rtorrent")
    (version "0.9.6")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "http://rtorrent.net/downloads/rtorrent-"
                    version ".tar.gz"))
              (sha256
               (base32
                "03jvzw9pi2mhcm913h8qg0qw9gwjqc6lhwynb1yz1y163x7w4s8y"))))
    (build-system gnu-build-system)
    (inputs `(("libtorrent" ,libtorrent)
              ("ncurses" ,ncurses)
              ("curl" ,curl)
              ("cyrus-sasl" ,cyrus-sasl)
              ("openssl" ,openssl)
              ("zlib" ,zlib)))
    (native-inputs `(("pkg-config" ,pkg-config)
                     ("cppunit" ,cppunit)))
    (synopsis "BitTorrent client with ncurses interface")
    (description
     "rTorrent is a BitTorrent client with an ncurses interface.  It supports
full encryption, DHT, PEX, and Magnet Links.  It can also be controlled via
XML-RPC over SCGI.")
    (home-page "https://github.com/rakshasa/rtorrent")
    (license l:gpl2+)))

(define-public tremc
  (package
    (name "tremc")
    (version "0.9.1")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/tremc/tremc.git")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32 "1yhwvlcyv1s830p5a7q5x3mkb3mbvr5cn5nh7y62l5b6iyyynlvm"))))
    (build-system gnu-build-system)
    (arguments
     `(#:tests? #f                      ; no test suite
       #:make-flags
       (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
       #:phases
       (modify-phases %standard-phases
         ;; The software is just a Python script that must be copied into place.
         (delete 'configure)
         (delete 'build))))
    (inputs
     `(("python" ,python)))
    (synopsis "Console client for the Transmission BitTorrent daemon")
    (description "Tremc is a console client, with a curses interface, for the
Transmission BitTorrent daemon.")
    (home-page "https://github.com/tremc/tremc")
    (license l:gpl3+)))

(define-public transmission-remote-cli
  (package
    (name "transmission-remote-cli")
    (version "1.7.1")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/fagga/"
                                  "transmission-remote-cli/archive/v"
                                  version ".tar.gz"))
              (file-name (string-append name "-" version ".tar.gz"))
              (sha256
               (base32
                "1y0hkpcjf6jw9xig8yf484hbhy63nip0pkchx401yxj81m25l4z9"))))
    (build-system python-build-system)
    (arguments
     `(#:python ,python-2 ; only supports Python 2
       #:tests? #f ; no test suite
       #:phases (modify-phases %standard-phases
                  ;; The software is just a Python script that must be
                  ;; copied into place.
                  (delete 'build)
                  (replace 'install
                    (lambda* (#:key outputs #:allow-other-keys)
                      (let* ((out (assoc-ref outputs "out"))
                             (bin (string-append out "/bin"))
                             (man (string-append out "/share/man/man1"))
                             ;; FIXME install zsh completions
                             (completions (string-append out "/etc/bash_completion.d")))
                        (install-file "transmission-remote-cli" bin)
                        (install-file "transmission-remote-cli.1" man)
                        (install-file
                          (string-append
                            "completion/bash/"
                            "transmission-remote-cli-bash-completion.sh")
                          completions)))))))
    (synopsis "Console client for the Transmission BitTorrent daemon")
    (description "Transmission-remote-cli is a console client, with a curses
interface, for the Transmission BitTorrent daemon.  This package is no longer
maintained upstream.")
    (home-page "https://github.com/fagga/transmission-remote-cli")
    (license l:gpl3+)
    (properties `((superseded . ,tremc)))))

(define-public aria2
  (package
    (name "aria2")
    (version "1.34.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/tatsuhiro-t/aria2/"
                                  "releases/download/release-" version "/"
                                  name "-" version ".tar.xz"))
              (sha256
               (base32
                "18vpgr430vxlwbcc3598rr1srfmwypls6wp1m4wf21hncc1ahi1s"))))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags (list "--enable-libaria2"
                               (string-append "--with-bashcompletiondir="
                                              %output "/etc/bash_completion.d/"))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'delete-socket-tests
           (lambda _
             (substitute* "test/LpdMessageDispatcherTest.cc"
               (("CPPUNIT_TEST_SUITE_REGISTRATION\\(LpdMessageDispatcherTest\\);" text)
                (string-append "// " text)))
             (substitute* "test/LpdMessageReceiverTest.cc"
               (("CPPUNIT_TEST_SUITE_REGISTRATION\\(LpdMessageReceiverTest\\);" text)
                (string-append "// " text)))
             #t)))))
    (native-inputs
     `(("cppunit" ,cppunit) ; for the tests
       ("pkg-config" ,pkg-config)))
    (inputs
     `(("c-ares" ,c-ares)
       ("gnutls" ,gnutls)
       ("gmp" ,gmp)
       ("libssh2" ,libssh2)
       ("libxml2" ,libxml2)
       ("nettle" ,nettle)
       ("sqlite" ,sqlite)
       ("zlib" ,zlib)))
    (home-page "https://aria2.github.io/")
    (synopsis "Utility for parallel downloading files")
    (description
      "Aria2 is a lightweight, multi-protocol & multi-source command-line
download utility.  It supports HTTP/HTTPS, FTP, SFTP, BitTorrent and Metalink.
Aria2 can be manipulated via built-in JSON-RPC and XML-RPC interfaces.")
    (license l:gpl2+)))

(define-public uget
  (package
    (name "uget")
    (version "2.0.8")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/urlget/"
                                  "uget%20%28stable%29/" version "/uget-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0919cf7lfk1djdl003cahqjvafdliv7v2l8r5wg95n4isqggdk75"))))
    (build-system gnu-build-system)
    (inputs
     `(("curl" ,curl)
       ("gtk+" ,gtk+)
       ("glib" ,glib)
       ("gnutls" ,gnutls)
       ("gstreamer" ,gstreamer)
       ("libgcrypt" ,libgcrypt)
       ("libnotify" ,libnotify)
       ("openssl" ,openssl)))
    (native-inputs
     `(("intltool" ,intltool)
       ("pkg-config" ,pkg-config)))
    (home-page "http://ugetdm.com/")
    (synopsis "Universal download manager with GTK+ interface")
    (description
     "uGet is portable download manager with GTK+ interface supporting
HTTP, HTTPS, BitTorrent and Metalink, supporting multi-connection
downloads, download scheduling, download rate limiting.")
    (license l:lgpl2.1+)))

(define-public mktorrent
  (package
    (name "mktorrent")
    (version "1.1")
    (source (origin
              (method url-fetch)
              (file-name (string-append name "-" version ".tar.gz"))
              (uri (string-append "https://github.com/Rudde/mktorrent/archive/v"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1j9qc4fxa9isnaygqk6jazsiklqywl2wcs95b8dx01963407bx6h"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases (modify-phases %standard-phases
                  (delete 'configure))          ; no configure script
       #:make-flags (list "CC=gcc"
                          (string-append "PREFIX=" (assoc-ref %outputs "out"))
                          "NO_HASH_CHECK=1"
                          "USE_LARGE_FILES=1"
                          "USE_LONG_OPTIONS=1"
                          "USE_PTHREADS=1")
       #:tests? #f))                            ; no tests
    (home-page "https://github.com/Rudde/mktorrent")
    (synopsis "Utility to create BitTorrent metainfo files")
    (description
     "mktorrent is a simple command-line utility to create BitTorrent
@dfn{metainfo} files, often known simply as @dfn{torrents}, from both single
files and whole directories.  It can add multiple trackers and web seed URLs,
and set the @code{private} flag to disallow advertisement through the
distributed hash table (@dfn{DHT}) and Peer Exchange.  Hashing is multi-threaded
and will take advantage of multiple processor cores where possible.")
    (license (list l:public-domain      ; sha1.*, used to build without OpenSSL
                   l:gpl2+))))          ; with permission to link with OpenSSL

(define-public libtorrent-rasterbar
  (package
    (name "libtorrent-rasterbar")
    (version "1.1.8")
    (source (origin
              (method url-fetch)
              (uri
               (string-append
                "https://github.com/arvidn/libtorrent/releases/download/libtorrent-"
                (string-join (string-split version #\.) "_")
                "/libtorrent-rasterbar-" version ".tar.gz"))
              (sha256
               (base32
                "0pcdy26l5ivcs78y2bqh2qca83ikzjfchw5815xh69qf8g88zgvb"))))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags
       (list (string-append "--with-boost-libdir="
                            (assoc-ref %build-inputs "boost")
                            "/lib")
             "--enable-python-binding"
             "--enable-tests"
             "CXXFLAGS=-std=c++11")     ; Use std::chrono instead of boost
       #:make-flags (list
                     (string-append "LDFLAGS=-Wl,-rpath="
                                    (assoc-ref %outputs "out") "/lib"))))
    (inputs `(("boost" ,boost)
              ("openssl" ,openssl)))
    (native-inputs `(("python" ,python-2)
                     ("pkg-config" ,pkg-config)))
    (home-page "https://www.libtorrent.org/")
    (synopsis "Feature complete BitTorrent implementation")
    (description
     "libtorrent-rasterbar is a feature complete C++ BitTorrent implementation
focusing on efficiency and scalability.  It runs on embedded devices as well as
desktops.")
    (license l:bsd-2)))

(define-public qbittorrent
  (package
    (name "qbittorrent")
    (version "4.1.3")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://github.com/qbittorrent/qBittorrent/archive/release-"
                    version ".tar.gz"))
              (file-name (string-append name "-release-" version ".tar.gz"))
              (sha256
               (base32
                "00zrpnwanq9f7maky2z4wnzw08xy902s77scm2gcvxxxankr4j92"))))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags
       (list (string-append "--with-boost-libdir="
                            (assoc-ref %build-inputs "boost")
                            "/lib")
             "--enable-debug"
             "QMAKE_LRELEASE=lrelease")))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("qttools" ,qttools)))
    (inputs
     `(("boost" ,boost)
       ("libtorrent-rasterbar" ,libtorrent-rasterbar)
       ("openssl" ,openssl)
       ("python" ,python-wrapper)
       ("qtbase" ,qtbase)
       ("qtsvg" ,qtsvg)
       ("zlib" ,zlib)))
    (home-page "https://www.qbittorrent.org/")
    (synopsis "Graphical BitTorrent client")
    (description
     "qBittorrent is a BitTorrent client programmed in C++/Qt that uses
libtorrent (sometimes called libtorrent-rasterbar) by Arvid Norberg.

It aims to be a good alternative to all other BitTorrent clients out there.
qBittorrent is fast, stable and provides unicode support as well as many
features.")
    (license l:gpl2+)))

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages boost)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build utils)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages icu4c)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages python)
  #:use-module (gnu packages shells))

(define-public boost
  (package
    (name "boost")
    (version "1.66.0")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "mirror://sourceforge/boost/boost/" version "/boost_"
                    (string-map (lambda (x) (if (eq? x #\.) #\_ x)) version)
                    ".tar.bz2"))
              (sha256
               (base32
                "1aaw48cmimsskzgiclwn0iifp62a5iw9cbqrhfari876af1828ap"))
              (patches (search-patches "boost-fix-icu-build.patch"))))
    (build-system gnu-build-system)
    (inputs `(("icu4c" ,icu4c)
              ("zlib" ,zlib)))
    (native-inputs
     `(("perl" ,perl)
       ("python" ,python-2)
       ("tcsh" ,tcsh)))
    (arguments
     `(#:tests? #f
       #:make-flags
       (list "threading=multi" "link=shared"

             ;; Set the RUNPATH to $libdir so that the libs find each other.
             (string-append "linkflags=-Wl,-rpath="
                            (assoc-ref %outputs "out") "/lib"))
       #:phases
       (modify-phases %standard-phases
         (delete 'bootstrap)
         (replace 'configure
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let ((icu (assoc-ref inputs "icu4c"))
                   (out (assoc-ref outputs "out")))
               (substitute* '("libs/config/configure"
                              "libs/spirit/classic/phoenix/test/runtest.sh"
                              "tools/build/doc/bjam.qbk"
                              "tools/build/src/engine/execunix.c"
                              "tools/build/src/engine/Jambase"
                              "tools/build/src/engine/jambase.c")
                 (("/bin/sh") (which "sh")))

               (setenv "SHELL" (which "sh"))
               (setenv "CONFIG_SHELL" (which "sh"))

               (invoke "./bootstrap.sh"
                       (string-append "--prefix=" out)
                       ;; Auto-detection looks for ICU only in traditional
                       ;; install locations.
                       (string-append "--with-icu=" icu)
                       "--with-toolset=gcc"))))
         (replace 'build
           (lambda* (#:key make-flags #:allow-other-keys)
             (apply invoke "./b2"
                    (format #f "-j~a" (parallel-job-count))
                    make-flags)))
         (replace 'install
           (lambda* (#:key make-flags #:allow-other-keys)
             (apply invoke "./b2" "install" make-flags))))))

    (home-page "https://www.boost.org")
    (synopsis "Peer-reviewed portable C++ source libraries")
    (description
     "A collection of libraries intended to be widely useful, and usable
across a broad spectrum of applications.")
    (license (license:x11-style "https://www.boost.org/LICENSE_1_0.txt"
                                "Some components have other similar licences."))))

(define-public boost-for-mysql
  ;; Older version for MySQL 5.7.23.
  (package
    (inherit boost)
    (version "1.59.0")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "mirror://sourceforge/boost/boost/" version "/boost_"
                    (string-map (lambda (x) (if (eq? x #\.) #\_ x)) version)
                    ".tar.bz2"))
              (sha256
               (base32
                "1jj1aai5rdmd72g90a3pd8sw9vi32zad46xv5av8fhnr48ir6ykj"))))
    (properties '((hidden? . #t)))))

(define-public boost-sync
  (let ((commit "c72891d9b90e2ceb466ec859f640cd012b2d8709")
        (version "1.55")
        (revision "1"))
    (package
      (name "boost-sync")
      (version (git-version version revision commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/boostorg/sync.git")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "197mp5z048vz5kv1m4v3jm447l2gqsyv0rbfz11dz0ns343ihbyx"))))
      (build-system trivial-build-system)
      (arguments
       `(#:modules ((guix build utils))
         #:builder
         (begin
           (use-modules (guix build utils))
           (let ((source (assoc-ref %build-inputs "source")))
             (copy-recursively (string-append source "/include")
                               (string-append %output "/include"))))))
      (home-page "https://github.com/boostorg/sync")
      (synopsis "Boost.Sync library")
      (description "The Boost.Sync library provides mutexes, semaphores, locks
and events and other thread related facilities.  Boost.Sync originated from
Boost.Thread.")
      (license (license:x11-style "https://www.boost.org/LICENSE_1_0.txt")))))

(define-public mdds
  (package
    (name "mdds")
    (version "1.3.1")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "http://kohei.us/files/mdds/src/mdds-" version ".tar.bz2"))
             (sha256
              (base32
               "18g511z1lgfxrga2ld9yr95phmyfbd3ymbv4q5g5lyjn4ljcvf6w"))))
    (build-system gnu-build-system)
    (propagated-inputs
      `(("boost" ,boost))) ; inclusion of header files
    (home-page "https://gitlab.com/mdds/mdds")
    (synopsis "Multi-dimensional C++ data structures and indexing algorithms")
    (description "Mdds (multi-dimensional data structure) provides a
collection of multi-dimensional data structures and indexing algorithms
for C++.  It includes flat segment trees, segment trees, rectangle sets,
point quad trees, multi-type vectors and multi-type matrices.")
    (license license:expat)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 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>
;;; Copyright © 2016, 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2016, 2017 Danny Milosavljevic <dannym@scratchpost.org>
;;; 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>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages bootloaders)
  #:use-module (gnu packages)
  #:use-module (gnu packages admin)
  #:use-module ((gnu packages algebra) #:select (bc))
  #:use-module (gnu packages assembly)
  #:use-module (gnu packages base)
  #:use-module (gnu packages disk)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages cdrom)
  #:use-module (gnu packages check)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages disk)
  #:use-module (gnu packages firmware)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages man)
  #:use-module (gnu packages mtools)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #: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 web)
  #:use-module (guix build-system gnu)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 regex))

(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 "2.02")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/grub/grub-" version ".tar.xz"))
             (sha256
              (base32
               "03vvdfhdmf16121v7xs8is2krwnv15wpkhkf16a4yf8nsfc3f2w1"))
             (patches (search-patches "grub-check-error-efibootmgr.patch"))))
    (build-system gnu-build-system)
    (arguments
     `(#: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")))

                     ;; Give the absolute file name of 'mdadm', used to
                     ;; determine the root file system when it's a RAID
                     ;; device.  Failing to do that, 'grub-probe' silently
                     ;; fails if 'mdadm' is not in $PATH.
                     (substitute* "grub-core/osdep/linux/getroot.c"
                       (("argv\\[0\\] = \"mdadm\"")
                        (string-append "argv[0] = \""
                                       (assoc-ref inputs "mdadm")
                                       "/sbin/mdadm\"")))

                     ;; Make the font visible.
                     (copy-file (assoc-ref inputs "unifont") "unifont.bdf.gz")
                     (system* "gunzip" "unifont.bdf.gz")
                     #t))
                  (add-before 'check 'disable-flaky-test
                    (lambda _
                      ;; This test is unreliable. For more information, see:
                      ;; <https://bugs.gnu.org/26936>.
                      (substitute* "Makefile.in"
                        (("grub_cmd_date grub_cmd_set_date grub_cmd_sleep")
                          "grub_cmd_date grub_cmd_sleep"))
                      #t)))
       ;; Disable tests on ARM and AARCH64 platforms.
       #:tests? ,(not (any (cute string-prefix? <> (or (%current-target-system)
                                                       (%current-system)))
                           '("arm" "aarch64")))))
    (inputs
     `(("gettext" ,gettext-minimal)

       ;; Depend on LVM2 for libdevmapper, used by 'grub-probe' and
       ;; 'grub-install' to recognize mapped devices (LUKS, etc.)
       ("lvm2" ,lvm2)

       ;; Depend on mdadm, which is invoked by 'grub-probe' and 'grub-install'
       ;; to determine whether the root file system is RAID.
       ("mdadm" ,mdadm)

       ("freetype" ,freetype)
       ;; ("libusb" ,libusb)
       ;; ("fuse" ,fuse)
       ("ncurses" ,ncurses)))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("unifont" ,unifont)
       ("bison" ,bison)
       ;; Due to a bug in flex >= 2.6.2, GRUB must be built with an older flex:
       ;; <http://lists.gnu.org/archive/html/grub-devel/2017-02/msg00133.html>
       ;; TODO Try building with flex > 2.6.4.
       ("flex" ,flex-2.6.1)
       ("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)
       ("qemu" ,qemu-minimal-2.10)
       ("xorriso" ,xorriso)))
    (home-page "https://www.gnu.org/software/grub/")
    (synopsis "GRand Unified Boot loader")
    (description
     "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 license:gpl3+)
    (properties '((cpe-name . "grub2")))))

(define-public grub-efi
  (package
    (inherit grub)
    (name "grub-efi")
    (synopsis "GRand Unified Boot loader (UEFI version)")
    (inputs
     `(("efibootmgr" ,efibootmgr)
       ("mtools" ,mtools)
       ,@(package-inputs grub)))
    (arguments
     `(;; TODO: Tests need a UEFI firmware for qemu. There is one at
       ;; https://github.com/tianocore/edk2/tree/master/OvmfPkg .
       ;; Search for 'OVMF' in "tests/util/grub-shell.in".
       ,@(substitute-keyword-arguments (package-arguments grub)
           ((#:tests? _ #f) #f)
           ((#:configure-flags flags ''())
            `(cons "--with-platform=efi" ,flags))
           ((#:phases phases)
            `(modify-phases ,phases
               (add-after 'patch-stuff 'use-absolute-efibootmgr-path
                 (lambda* (#:key inputs #:allow-other-keys)
                   (substitute* "grub-core/osdep/unix/platform.c"
                     (("efibootmgr")
                      (string-append (assoc-ref inputs "efibootmgr")
                                     "/sbin/efibootmgr")))
                   #t))
               (add-after 'patch-stuff 'use-absolute-mtools-path
                 (lambda* (#:key inputs #:allow-other-keys)
                   (let ((mtools (assoc-ref inputs "mtools")))
                     (substitute* "util/grub-mkrescue.c"
                       (("\"mformat\"")
                        (string-append "\"" mtools
                                       "/bin/mformat\"")))
                     (substitute* "util/grub-mkrescue.c"
                       (("\"mcopy\"")
                        (string-append "\"" mtools
                                       "/bin/mcopy\"")))
                     #t))))))))))

;; Because grub searches hardcoded paths it's easiest to just build grub
;; again to make it find both grub-pc and grub-efi.  There is a command
;; line argument which allows you to specify ONE platform - but
;; grub-mkrescue will use multiple platforms if they are available
;; in the installation directory (without command line argument).
(define-public grub-hybrid
  (package
    (inherit grub-efi)
    (name "grub-hybrid")
    (synopsis "GRand Unified Boot loader (hybrid version)")
    (inputs
     `(("grub" ,grub)
       ,@(package-inputs grub-efi)))
    (arguments
     (substitute-keyword-arguments (package-arguments grub-efi)
       ((#:modules modules `((guix build utils) (guix build gnu-build-system)))
        `((ice-9 ftw) ,@modules))
       ((#:phases phases)
        `(modify-phases ,phases
           (add-after 'install 'install-non-efi
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (let ((input-dir (string-append (assoc-ref inputs "grub")
                                               "/lib/grub"))
                     (output-dir (string-append (assoc-ref outputs "out")
                                                "/lib/grub")))
                 (for-each
                  (lambda (basename)
                    (if (not (or (string-prefix? "." basename)
                                 (file-exists? (string-append output-dir "/" basename))))
                        (symlink (string-append input-dir "/" basename)
                                 (string-append output-dir "/" basename))))
                  (scandir input-dir))
                 #t)))))))))

(define-public syslinux
  (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
    (package
      (name "syslinux")
      (version (git-version "6.04-pre" "1" commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/geneC/syslinux")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "0k8dvafd6410kqxf3kyr4y8jzmpmrih6wbjqg6gklak7945yflrc"))))
      (build-system gnu-build-system)
      (native-inputs
       `(("nasm" ,nasm)
         ("perl" ,perl)
         ("python-2" ,python-2)))
      (inputs
       `(("libuuid" ,util-linux)
         ("mtools" ,mtools)))
      (arguments
       `(#:parallel-build? #f
         #:make-flags
         (list (string-append "BINDIR=" %output "/bin")
               (string-append "SBINDIR=" %output "/sbin")
               (string-append "LIBDIR=" %output "/lib")
               (string-append "INCDIR=" %output "/include")
               (string-append "DATADIR=" %output "/share")
               (string-append "MANDIR=" %output "/share/man")
               "PERL=perl"
               "bios")
         #:phases
         (modify-phases %standard-phases
           (add-after 'unpack 'patch-files
             (lambda* (#:key inputs #:allow-other-keys)
               (substitute* (find-files "." "Makefile.*|ppmtolss16")
                 (("/bin/pwd") (which "pwd"))
                 (("/bin/echo") (which "echo"))
                 (("/usr/bin/perl") (which "perl")))
               (let ((mtools (assoc-ref inputs "mtools")))
                 (substitute* (find-files "." "\\.c$")
                   (("mcopy")
                    (string-append mtools "/bin/mcopy"))
                   (("mattrib")
                    (string-append mtools "/bin/mattrib"))))
               #t))
           (delete 'configure)
           (add-before 'build 'set-permissions
             (lambda _
               (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/") ""))
               (invoke "make" "unittest"))))))
      (home-page "https://www.syslinux.org")
      (synopsis "Lightweight Linux bootloader")
      (description "Syslinux is a lightweight Linux bootloader.")
      (license (list license:gpl2+
                     license:bsd-3 ; gnu-efi/*
                     license:bsd-4 ; gnu-efi/inc/* gnu-efi/lib/*
                     ;; Also contains:
                     license:expat license:isc license:zlib)))))

(define-public dtc
  (package
    (name "dtc")
    (version "1.4.7")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "mirror://kernel.org/software/utils/dtc/"
                    "dtc-" version ".tar.xz"))
              (sha256
               (base32
                "1rydi5jvhlhsr110h6n0pavv3daqa0cb4m5vcps50qzq1zqfhhv6"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("bison" ,bison)
       ("flex" ,flex)
       ("swig" ,swig)
       ("valgrind" ,valgrind)))
    (inputs
     `(("python-2" ,python-2)))
    (arguments
     `(#:make-flags
       (list "CC=gcc"
             (string-append "PREFIX=" (assoc-ref %outputs "out"))
             (string-append "SETUP_PREFIX=" (assoc-ref %outputs "out"))
             "INSTALL=install")
       #:phases
       (modify-phases %standard-phases
         (delete 'configure))))         ; no configure script
    (home-page "https://www.devicetree.org")
    (synopsis "Compiles device tree source files")
    (description "@command{dtc} compiles
@uref{http://elinux.org/Device_Tree_Usage, device tree source files} to device
tree binary files.  These are board description files used by Linux and BSD.")
    (license license:gpl2+)))

(define u-boot
  (package
    (name "u-boot")
    (version "2018.09")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "ftp://ftp.denx.de/pub/u-boot/"
                    "u-boot-" version ".tar.bz2"))
              (sha256
               (base32
                "0s122kyz1svvs2yjzj4j9qravl3ra4vn0fjqgski7rlczqyg56w3"))))
    (native-inputs
     `(("bc" ,bc)
       ("bison" ,bison)
       ("dtc" ,dtc)
       ("flex" ,flex)
       ("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 "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-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"))
             #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))
                      `#t
                      `#f)))
    (package
      (inherit u-boot)
      (name (string-append "u-boot-"
                           (string-replace-substring (string-downcase board)
                                                     "_" "-")))
      (native-inputs
       `(,@(if (not same-arch?)
             `(("cross-gcc" ,(cross-gcc triplet #:xgcc gcc-7))
               ("cross-binutils" ,(cross-binutils triplet)))
             `(("gcc-7" ,gcc-7)))
         ,@(package-native-inputs u-boot)))
      (arguments
       `(#:modules ((ice-9 ftw)
                    (srfi srfi-1)
                    (guix build utils)
                    (guix build gnu-build-system))
         #:test-target "test"
         #:make-flags
         (list "HOSTCC=gcc"
               ,@(if (not same-arch?)
                   `((string-append "CROSS_COMPILE=" ,triplet "-"))
                   '()))
         #:phases
         (modify-phases %standard-phases
           (replace 'configure
             (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)))
                     (begin
                       (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
                                    (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)
                 #t)))))))))

(define-public u-boot-vexpress
  (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))

(define-public u-boot-malta
  (make-u-boot-package "malta" "mips64el-linux-gnuabi64"))

(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")))
    (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)
                  (let ((bl31 (string-append (assoc-ref inputs "firmware")
                                             "/bl31.bin")))
                    (setenv "BL31" bl31)
                    ;; 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)
         ,@(package-native-inputs base))))))

(define-public u-boot-bananapi-m2-ultra
  (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf"))

(define-public u-boot-a20-olinuxino-lime
  (make-u-boot-package "A20-OLinuXino-Lime" "arm-linux-gnueabihf"))

(define-public u-boot-a20-olinuxino-lime2
  (make-u-boot-package "A20-OLinuXino-Lime2" "arm-linux-gnueabihf"))

(define-public u-boot-a20-olinuxino-micro
  (make-u-boot-package "A20-OLinuXino_MICRO" "arm-linux-gnueabihf"))

(define-public u-boot-nintendo-nes-classic-edition
  (make-u-boot-package "Nintendo_NES_Classic_Edition" "arm-linux-gnueabihf"))

(define-public u-boot-wandboard
  (make-u-boot-package "wandboard" "arm-linux-gnueabihf"))

(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")
    (version "R63-10032.B")
    (source (origin
              ;; XXX: Snapshots are available but changes timestamps every download.
              (method git-fetch)
              (uri (git-reference
                    (url (string-append "https://chromium.googlesource.com"
                                        "/chromiumos/platform/vboot_reference"))
                    (commit (string-append "release-" version))))
              (file-name (string-append name "-" version "-checkout"))
              (sha256
               (base32
                "0h0m3l69vp9dr6xrs1p6y7ilkq3jq8jraw2z20kqfv7lvc9l1lxj"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags (list "CC=gcc"
                          (string-append "DESTDIR=" (assoc-ref %outputs "out")))
       #:phases (modify-phases %standard-phases
                  (add-after 'unpack 'patch-hard-coded-paths
                    (lambda* (#:key inputs outputs #:allow-other-keys)
                      (let ((coreutils (assoc-ref inputs "coreutils"))
                            (diffutils (assoc-ref inputs "diffutils")))
                        (substitute* "futility/misc.c"
                          (("/bin/cp") (string-append coreutils "/bin/cp")))
                        (substitute* "tests/bitmaps/TestBmpBlock.py"
                          (("/usr/bin/cmp") (string-append diffutils "/bin/cmp")))
                        (substitute* "vboot_host.pc.in"
                          (("prefix=/usr")
                           (string-append "prefix=" (assoc-ref outputs "out"))))
                        #t)))
                  (delete 'configure)
                  (add-before 'check 'patch-tests
                    (lambda _
                      ;; These tests compare diffs against known-good values.
                      ;; Patch the paths to match those in the build container.
                      (substitute* (find-files "tests/futility/expect_output")
                        (("/mnt/host/source/src/platform/vboot_reference")
                         (string-append "/tmp/guix-build-" ,name "-" ,version
                                        ".drv-0/source")))
                      ;; Tests require write permissions to many of these files.
                      (for-each make-file-writable (find-files "tests/futility"))
                      #t)))
       #:test-target "runtests"))
    (native-inputs
     `(("pkg-config" ,pkg-config)

       ;; For tests.
       ("diffutils" ,diffutils)
       ("python@2" ,python-2)))
    (inputs
     `(("coreutils" ,coreutils)
       ("libyaml" ,libyaml)
       ("openssl" ,openssl)
       ("openssl:static" ,openssl "static")
       ("util-linux" ,util-linux)))
    (home-page
     "https://dev.chromium.org/chromium-os/chromiumos-design-docs/verified-boot")
    (synopsis "ChromiumOS verified boot utilities")
    (description
     "vboot-utils is a collection of tools to facilitate booting of
Chrome-branded devices.  This includes the @command{cgpt} partitioning
program, the @command{futility} and @command{crossystem} firmware management
tools, and more.")
    (license license:bsd-3)))

(define-public os-prober
  (package
    (name "os-prober")
    (version "1.76")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "mirror://debian/pool/main/o/os-prober/os-prober_"
                           version ".tar.xz"))
       (sha256
        (base32
         "1vb45i76bqivlghrq7m3n07qfmmq4wxrkplqx8gywj011rhq19fk"))))
    (build-system gnu-build-system)
    (arguments
     `(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (ice-9 regex)   ; for string-match
                  (srfi srfi-26)) ; for cut
       #:make-flags (list "CC=gcc")
       #:tests? #f ; no tests
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             (substitute* (find-files ".")
               (("/usr") (assoc-ref outputs "out")))
             (substitute* (find-files "." "50mounted-tests$")
               (("mkdir") "mkdir -p"))
             #t))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (define (find-files-non-recursive directory)
               (find-files directory
                           (lambda (file stat)
                             (string-match (string-append "^" directory "/[^/]*$")
                                           file))
                           #:directories? #t))

             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin"))
                    (lib (string-append out "/lib"))
                    (share (string-append out "/share")))
               (for-each (cut install-file <> bin)
                         (list "linux-boot-prober" "os-prober"))
               (install-file "newns" (string-append lib "/os-prober"))
               (install-file "common.sh" (string-append share "/os-prober"))
               (install-file "os-probes/mounted/powerpc/20macosx"
                             (string-append lib "/os-probes/mounted"))
               (for-each
                (lambda (directory)
                  (for-each
                   (lambda (file)
                     (let ((destination (string-append lib "/" directory
                                                       "/" (basename file))))
                       (mkdir-p (dirname destination))
                       (copy-recursively file destination)))
                   (append (find-files-non-recursive (string-append directory "/common"))
                           (find-files-non-recursive (string-append directory "/x86")))))
                (list "os-probes" "os-probes/mounted" "os-probes/init"
                      "linux-boot-probes" "linux-boot-probes/mounted"))
               #t))))))
    (home-page "https://joeyh.name/code/os-prober")
    (synopsis "Detect other operating systems")
    (description "os-prober probes disks on the system for other operating
systems so that they can be added to the bootloader.  It also works out how to
boot existing GNU/Linux systems and detects what distribution is installed in
order to add a suitable bootloader menu entry.")
    (license license:gpl2+)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages bootstrap)
  #:use-module (guix licenses)
  #:use-module (gnu packages)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module ((guix store)
                #:select (run-with-store add-to-store add-text-to-store))
  #:use-module ((guix derivations)
                #:select (derivation derivation->output-path))
  #:use-module ((guix utils) #:select (gnu-triplet->nix-system))
  #:use-module (guix memoization)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:export (bootstrap-origin
            package-with-bootstrap-guile
            glibc-dynamic-linker

            bootstrap-guile-origin

            %bootstrap-guile
            %bootstrap-coreutils&co
            %bootstrap-binutils
            %bootstrap-gcc
            %bootstrap-glibc
            %bootstrap-inputs))

;;; Commentary:
;;;
;;; Pre-built packages that are used to bootstrap the
;;; distribution--i.e., to build all the core packages from scratch.
;;;
;;; Code:

;;;
;;; Helper procedures.
;;;

(define (bootstrap-origin source)
  "Return a variant of SOURCE, an <origin> instance, whose method uses
%BOOTSTRAP-GUILE to do its job."
  (define (boot fetch)
    (lambda* (url hash-algo hash
              #:optional name #:key system)
      (fetch url hash-algo hash name
             #:guile %bootstrap-guile
             #:system system)))

  (define %bootstrap-patch-inputs
    ;; Packages used when an <origin> has a non-empty 'patches' field.
    `(("tar"   ,%bootstrap-coreutils&co)
      ("xz"    ,%bootstrap-coreutils&co)
      ("bzip2" ,%bootstrap-coreutils&co)
      ("gzip"  ,%bootstrap-coreutils&co)
      ("patch" ,%bootstrap-coreutils&co)))

  (let ((orig-method (origin-method source)))
    (origin (inherit source)
      (method (cond ((eq? orig-method url-fetch)
                     (boot url-fetch))
                    (else orig-method)))
      (patch-guile %bootstrap-guile)
      (patch-inputs %bootstrap-patch-inputs)

      ;; Patches can be origins as well, so process them.
      (patches (map (match-lambda
                     ((? origin? patch)
                      (bootstrap-origin patch))
                     (patch patch))
                    (origin-patches source))))))

(define* (package-from-tarball name source program-to-test description
                               #:key snippet)
  "Return a package that correspond to the extraction of SOURCE.
PROGRAM-TO-TEST is a program to run after extraction of SOURCE, to check
whether everything is alright.  If SNIPPET is provided, it is evaluated after
extracting SOURCE.  SNIPPET should raise an exception to signal an error; its
return value is ignored."
  (package
    (name name)
    (version "0")
    (build-system trivial-build-system)
    (arguments
     `(#:guile ,%bootstrap-guile
       #:modules ((guix build utils))
       #:builder
       (let ((out     (assoc-ref %outputs "out"))
             (tar     (assoc-ref %build-inputs "tar"))
             (xz      (assoc-ref %build-inputs "xz"))
             (tarball (assoc-ref %build-inputs "tarball")))
         (use-modules (guix build utils))

         (mkdir out)
         (copy-file tarball "binaries.tar.xz")
         (invoke xz "-d" "binaries.tar.xz")
         (let ((builddir (getcwd)))
           (with-directory-excursion out
             (invoke tar "xvf"
                     (string-append builddir "/binaries.tar"))
             ,@(if snippet (list snippet) '())
             (invoke (string-append "bin/" ,program-to-test)
                     "--version"))))))
    (inputs
     `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
       ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
       ("tarball" ,(bootstrap-origin (source (%current-system))))))
    (source #f)
    (synopsis description)
    (description description)
    (home-page #f)
    (license gpl3+)))

(define package-with-bootstrap-guile
  (mlambdaq (p)
    "Return a variant of P such that all its origins are fetched with
%BOOTSTRAP-GUILE."
    (define rewritten-input
      (match-lambda
        ((name (? origin? o))
         `(,name ,(bootstrap-origin o)))
        ((name (? package? p) sub-drvs ...)
         `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
        (x x)))

    (package (inherit p)
             (source (match (package-source p)
                       ((? origin? o) (bootstrap-origin o))
                       (s s)))
             (inputs (map rewritten-input
                          (package-inputs p)))
             (native-inputs (map rewritten-input
                                 (package-native-inputs p)))
             (propagated-inputs (map rewritten-input
                                     (package-propagated-inputs p)))
             (replacement (and=> (package-replacement p)
                                 package-with-bootstrap-guile)))))

(define* (glibc-dynamic-linker
          #:optional (system (or (and=> (%current-target-system)
                                        gnu-triplet->nix-system)
                                 (%current-system))))
  "Return the name of Glibc's dynamic linker for SYSTEM."
  ;; See the 'SYSDEP_KNOWN_INTERPRETER_NAMES' cpp macro in libc.
  (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
        ((string=? system "i686-linux") "/lib/ld-linux.so.2")
        ((string=? system "armhf-linux") "/lib/ld-linux-armhf.so.3")
        ((string=? system "mips64el-linux") "/lib/ld.so.1")
        ((string=? system "i586-gnu") "/lib/ld.so.1")
        ((string=? system "i686-gnu") "/lib/ld.so.1")
        ((string=? system "aarch64-linux") "/lib/ld-linux-aarch64.so.1")
        ((string=? system "powerpc-linux") "/lib/ld.so.1")
        ((string=? system "powerpc64le-linux") "/lib/ld64.so.2")
        ((string=? system "alpha-linux") "/lib/ld-linux.so.2")
        ((string=? system "s390x-linux") "/lib/ld64.so.1")

        ;; XXX: This one is used bare-bones, without a libc, so add a case
        ;; here just so we can keep going.
        ((string=? system "arm-eabi") "no-ld.so")
        ((string=? system "xtensa-elf") "no-ld.so")
        ((string=? system "avr") "no-ld.so")
        ((string=? system "propeller-elf") "no-ld.so")
        ((string=? system "i686-mingw") "no-ld.so")
        ((string=? system "vc4-elf") "no-ld.so")

        (else (error "dynamic linker name not known for this system"
                     system))))

;;;
;;; Bootstrap packages.
;;;

(define %bootstrap-base-urls
  ;; This is where the initial binaries come from.
  '("https://alpha.gnu.org/gnu/guix/bootstrap"
    "http://alpha.gnu.org/gnu/guix/bootstrap"
    "ftp://alpha.gnu.org/gnu/guix/bootstrap"
    "http://www.fdn.fr/~lcourtes/software/guix/packages"
    "http://flashner.co.il/guix/bootstrap"))

(define (bootstrap-guile-url-path system)
  "Return the URI for FILE."
  (string-append "/" system
                 (match system
                   ("aarch64-linux"
                    "/20170217/guile-2.0.14.tar.xz")
                   ("armhf-linux"
                    "/20150101/guile-2.0.11.tar.xz")
                   (_
                    "/20131110/guile-2.0.9.tar.xz"))))

(define (bootstrap-guile-hash system)
  "Return the SHA256 hash of the Guile bootstrap tarball for SYSTEM."
  (match system
    ("x86_64-linux"
     (base32 "1w2p5zyrglzzniqgvyn1b55vprfzhgk8vzbzkkbdgl5248si0yq3"))
    ("i686-linux"
     (base32 "0im800m30abgh7msh331pcbjvb4n02smz5cfzf1srv0kpx3csmxp"))
    ("mips64el-linux"
     (base32 "0fzp93lvi0hn54acc0fpvhc7bvl0yc853k62l958cihk03q80ilr"))
    ("armhf-linux"
     (base32 "1mi3brl7l58aww34rawhvja84xc7l1b4hmwdmc36fp9q9mfx0lg5"))
    ("aarch64-linux"
     (base32 "1giy2aprjmn5fp9c4s9r125fljw4wv6ixy5739i5bffw4jgr0f9r"))))

(define (bootstrap-guile-origin system)
  "Return an <origin> object for the Guile tarball of SYSTEM."
  (origin
    (method url-fetch)
    (uri (map (cute string-append <> (bootstrap-guile-url-path system))
              %bootstrap-base-urls))
    (sha256 (bootstrap-guile-hash system))))

(define (download-bootstrap-guile store system)
  "Return a derivation that downloads the bootstrap Guile tarball for SYSTEM."
  (let* ((path (bootstrap-guile-url-path system))
         (base (basename path))
         (urls (map (cut string-append <> path) %bootstrap-base-urls)))
    (run-with-store store
      (url-fetch urls 'sha256 (bootstrap-guile-hash system)
                 #:system system))))

(define* (raw-build store name inputs
                    #:key outputs system search-paths
                    #:allow-other-keys)
  (define (->store file)
    (add-to-store store file #t "sha256"
                  (or (search-bootstrap-binary file
                                               system)
                      (error "bootstrap binary not found"
                             file system))))

  (let* ((tar   (->store "tar"))
         (xz    (->store "xz"))
         (mkdir (->store "mkdir"))
         (bash  (->store "bash"))
         (guile (download-bootstrap-guile store system))
         ;; The following code, run by the bootstrap guile after it is
         ;; unpacked, creates a wrapper for itself to set its load path.
         ;; This replaces the previous non-portable method based on
         ;; reading the /proc/self/exe symlink.
         (make-guile-wrapper
          '(begin
             (use-modules (ice-9 match))
             (match (command-line)
               ((_ out bash)
                (let ((bin-dir    (string-append out "/bin"))
                      (guile      (string-append out "/bin/guile"))
                      (guile-real (string-append out "/bin/.guile-real"))
                      ;; We must avoid using a bare dollar sign in this code,
                      ;; because it would be interpreted by the shell.
                      (dollar     (string (integer->char 36))))
                  (chmod bin-dir #o755)
                  (rename-file guile guile-real)
                  (call-with-output-file guile
                    (lambda (p)
                      (format p "\
#!~a
export GUILE_SYSTEM_PATH=~a/share/guile/2.0
export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
exec -a \"~a0\" ~a \"~a@\"\n"
                              bash out out dollar guile-real dollar)))
                  (chmod guile   #o555)
                  (chmod bin-dir #o555))))))
         (builder
          (add-text-to-store store
                             "build-bootstrap-guile.sh"
                             (format #f "
echo \"unpacking bootstrap Guile to '$out'...\"
~a $out
cd $out
~a -dc < $GUILE_TARBALL | ~a xv

# Use the bootstrap guile to create its own wrapper to set the load path.
GUILE_SYSTEM_PATH=$out/share/guile/2.0 \
GUILE_SYSTEM_COMPILED_PATH=$out/lib/guile/2.0/ccache \
$out/bin/guile -c ~s $out ~a

# Sanity check.
$out/bin/guile --version~%"
                                     mkdir xz tar
                                     (format #f "~s" make-guile-wrapper)
                                     bash)
                             (list mkdir xz tar bash))))
    (derivation store name
                bash `(,builder)
                #:system system
                #:inputs `((,bash) (,builder) (,guile))
                #:env-vars `(("GUILE_TARBALL"
                              . ,(derivation->output-path guile))))))

(define* (make-raw-bag name
                       #:key source inputs native-inputs outputs
                       system target)
  (bag
    (name name)
    (system system)
    (build-inputs inputs)
    (build raw-build)))

(define %bootstrap-guile
  ;; The Guile used to run the build scripts of the initial derivations.
  ;; It is just unpacked from a tarball containing a pre-built binary.
  ;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
  ;;
  ;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
  ;; support (for /etc/services).
  (let ((raw (build-system
               (name 'raw)
               (description "Raw build system with direct store access")
               (lower make-raw-bag))))
   (package
     (name "guile-bootstrap")
     (version "2.0")
     (source #f)
     (build-system raw)
     (synopsis "Bootstrap Guile")
     (description "Pre-built Guile for bootstrapping purposes.")
     (home-page #f)
     (license lgpl3+))))

(define %bootstrap-coreutils&co
  (package-from-tarball "bootstrap-binaries"
                        (lambda (system)
                          (origin
                           (method url-fetch)
                           (uri (map (cut string-append <> "/" system
                                          (match system
                                            ("armhf-linux"
                                             "/20150101/static-binaries.tar.xz")
                                            ("aarch64-linux"
                                             "/20170217/static-binaries.tar.xz")
                                            (_
                                             "/20131110/static-binaries.tar.xz")))
                                     %bootstrap-base-urls))
                           (sha256
                            (match system
                              ("x86_64-linux"
                               (base32
                                "0c533p9dhczzcsa1117gmfq3pc8w362g4mx84ik36srpr7cx2bg4"))
                              ("i686-linux"
                               (base32
                                "0s5b3jb315n13m1k8095l0a5hfrsz8g0fv1b6riyc5hnxqyphlak"))
                              ("armhf-linux"
                               (base32
                                "0gf0fn2kbpxkjixkmx5f4z6hv6qpmgixl69zgg74dbsfdfj8jdv5"))
                              ("aarch64-linux"
                               (base32
                                "18dfiq6c6xhsdpbidigw6480wh0vdgsxqq3xindq4lpdgqlccpfh"))
                              ("mips64el-linux"
                               (base32
                                "072y4wyfsj1bs80r6vbybbafy8ya4vfy7qj25dklwk97m6g71753"))))))
                        "fgrep"                    ; the program to test
                        "Bootstrap binaries of Coreutils, Awk, etc."
                        #:snippet
                        '(let ((path (list (string-append (getcwd) "/bin"))))
                           (chmod "bin" #o755)
                           (patch-shebang "bin/egrep" path)
                           (patch-shebang "bin/fgrep" path)
                           ;; Starting with grep@2.25 'egrep' and 'fgrep' are shell files
                           ;; that call 'grep'.  If the bootstrap 'egrep' and 'fgrep'
                           ;; are not binaries then patch them to execute 'grep' via its
                           ;; absolute file name instead of searching for it in $PATH.
                           (if (not (elf-file? "bin/egrep"))
                             (substitute* '("bin/egrep" "bin/fgrep")
                               (("^exec grep") (string-append (getcwd) "/bin/grep"))))
                           (chmod "bin" #o555))))

(define %bootstrap-binutils
  (package-from-tarball "binutils-bootstrap"
                        (lambda (system)
                          (origin
                           (method url-fetch)
                           (uri (map (cut string-append <> "/" system
                                          (match system
                                            ("armhf-linux"
                                             "/20150101/binutils-2.25.tar.xz")
                                            ("aarch64-linux"
                                             "/20170217/binutils-2.27.tar.xz")
                                            (_
                                             "/20131110/binutils-2.23.2.tar.xz")))
                                     %bootstrap-base-urls))
                           (sha256
                            (match system
                              ("x86_64-linux"
                               (base32
                                "1j5yivz7zkjqfsfmxzrrrffwyayjqyfxgpi89df0w4qziqs2dg20"))
                              ("i686-linux"
                               (base32
                                "14jgwf9gscd7l2pnz610b1zia06dvcm2qyzvni31b8zpgmcai2v9"))
                              ("armhf-linux"
                               (base32
                                "1v7dj6bzn6m36f20gw31l99xaabq4xrhrx3gwqkhhig0mdlmr69q"))
                              ("aarch64-linux"
                               (base32
                                "111s7ilfiby033rczc71797xrmaa3qlv179wdvsaq132pd51xv3n"))
                              ("mips64el-linux"
                               (base32
                                "1x8kkhcxmfyzg1ddpz2pxs6fbdl6412r7x0nzbmi5n7mj8zw2gy7"))))))
                        "ld"                      ; the program to test
                        "Bootstrap binaries of the GNU Binutils"))

(define %bootstrap-glibc
  ;; The initial libc.
  (package
    (name "glibc-bootstrap")
    (version "0")
    (source #f)
    (build-system trivial-build-system)
    (arguments
     `(#:guile ,%bootstrap-guile
       #:modules ((guix build utils))
       #:builder
       (let ((out     (assoc-ref %outputs "out"))
             (tar     (assoc-ref %build-inputs "tar"))
             (xz      (assoc-ref %build-inputs "xz"))
             (tarball (assoc-ref %build-inputs "tarball")))
         (use-modules (guix build utils))

         (mkdir out)
         (copy-file tarball "binaries.tar.xz")
         (invoke xz "-d" "binaries.tar.xz")
         (let ((builddir (getcwd)))
           (with-directory-excursion out
             (invoke tar "xvf"
                     (string-append builddir
                                    "/binaries.tar"))
             (chmod "lib" #o755)

             ;; Patch libc.so so it refers to the right path.
             (substitute* "lib/libc.so"
               (("/[^ ]+/lib/(libc|ld)" _ prefix)
                (string-append out "/lib/" prefix)))

             #t)))))
    (inputs
     `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
       ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
       ("tarball" ,(bootstrap-origin
                    (origin
                     (method url-fetch)
                     (uri (map (cut string-append <> "/" (%current-system)
                                    (match (%current-system)
                                      ("armhf-linux"
                                       "/20150101/glibc-2.20.tar.xz")
                                      ("aarch64-linux"
                                       "/20170217/glibc-2.25.tar.xz")
                                      (_
                                       "/20131110/glibc-2.18.tar.xz")))
                               %bootstrap-base-urls))
                     (sha256
                      (match (%current-system)
                        ("x86_64-linux"
                         (base32
                          "0jlqrgavvnplj1b083s20jj9iddr4lzfvwybw5xrcis9spbfzk7v"))
                        ("i686-linux"
                         (base32
                          "1hgrccw1zqdc7lvgivwa54d9l3zsim5pqm0dykxg0z522h6gr05w"))
                        ("armhf-linux"
                         (base32
                          "18cmgvpllqfpn6khsmivqib7ys8ymnq0hdzi3qp24prik0ykz8gn"))
                        ("aarch64-linux"
                         (base32
                          "07nx3x8598i2924rjnlrncg6rm61c9bmcczbbcpbx0fb742nvv5c"))
                        ("mips64el-linux"
                         (base32
                          "0k97a3whzx3apsi9n2cbsrr79ad6lh00klxph9hw4fqyp1abkdsg")))))))))
    (synopsis "Bootstrap binaries and headers of the GNU C Library")
    (description synopsis)
    (home-page #f)
    (license lgpl2.1+)))

(define %bootstrap-gcc
  ;; The initial GCC.  Uses binaries from a tarball typically built by
  ;; %GCC-BOOTSTRAP-TARBALL.
  (package
    (name "gcc-bootstrap")
    (version "0")
    (source #f)
    (build-system trivial-build-system)
    (arguments
     `(#:guile ,%bootstrap-guile
       #:modules ((guix build utils))
       #:builder
       (let ((out     (assoc-ref %outputs "out"))
             (tar     (assoc-ref %build-inputs "tar"))
             (xz      (assoc-ref %build-inputs "xz"))
             (bash    (assoc-ref %build-inputs "bash"))
             (libc    (assoc-ref %build-inputs "libc"))
             (tarball (assoc-ref %build-inputs "tarball")))
         (use-modules (guix build utils)
                      (ice-9 popen))

         (mkdir out)
         (copy-file tarball "binaries.tar.xz")
         (invoke xz "-d" "binaries.tar.xz")
         (let ((builddir (getcwd))
               (bindir   (string-append out "/bin")))
           (with-directory-excursion out
             (invoke tar "xvf"
                     (string-append builddir "/binaries.tar")))

           (with-directory-excursion bindir
             (chmod "." #o755)
             (rename-file "gcc" ".gcc-wrapped")
             (call-with-output-file "gcc"
               (lambda (p)
                 (format p "#!~a
exec ~a/bin/.gcc-wrapped -B~a/lib \
     -Wl,-rpath -Wl,~a/lib \
     -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
                         bash
                         out libc libc libc
                         ,(glibc-dynamic-linker))))

             (chmod "gcc" #o555)
             #t)))))
    (inputs
     `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
       ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
       ("bash" ,(search-bootstrap-binary "bash" (%current-system)))
       ("libc" ,%bootstrap-glibc)
       ("tarball" ,(bootstrap-origin
                    (origin
                     (method url-fetch)
                     (uri (map (cut string-append <> "/" (%current-system)
                                    (match (%current-system)
                                      ("armhf-linux"
                                       "/20150101/gcc-4.8.4.tar.xz")
                                      ("aarch64-linux"
                                       "/20170217/gcc-5.4.0.tar.xz")
                                      (_
                                       "/20131110/gcc-4.8.2.tar.xz")))
                               %bootstrap-base-urls))
                     (sha256
                      (match (%current-system)
                        ("x86_64-linux"
                         (base32
                          "17ga4m6195n4fnbzdkmik834znkhs53nkypp6557pl1ps7dgqbls"))
                        ("i686-linux"
                         (base32
                          "150c1arrf2k8vfy6dpxh59vcgs4p1bgiz2av5m19dynpks7rjnyw"))
                        ("armhf-linux"
                         (base32
                          "0ghz825yzp43fxw53kd6afm8nkz16f7dxi9xi40bfwc8x3nbbr8v"))
                        ("aarch64-linux"
                         (base32
                          "1ar3vdzyqbfm0z36kmvazvfswxhcihlacl2dzdjgiq25cqnq9ih1"))
                        ("mips64el-linux"
                         (base32
                          "1m5miqkyng45l745n0sfafdpjkqv9225xf44jqkygwsipj2cv9ks")))))))))
    (native-search-paths
     (list (search-path-specification
            (variable "CPATH")
            (files '("include")))
           (search-path-specification
            (variable "LIBRARY_PATH")
            (files '("lib" "lib64")))))
    (synopsis "Bootstrap binaries of the GNU Compiler Collection")
    (description synopsis)
    (home-page #f)
    (license gpl3+)))

(define %bootstrap-inputs
  ;; The initial, pre-built inputs.  From now on, we can start building our
  ;; own packages.
  `(("libc" ,%bootstrap-glibc)
    ("gcc" ,%bootstrap-gcc)
    ("binutils" ,%bootstrap-binutils)
    ("coreutils&co" ,%bootstrap-coreutils&co)

    ;; In gnu-build-system.scm, we rely on the availability of Bash.
    ("bash" ,%bootstrap-coreutils&co)))

;;; bootstrap.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017 Corentin Bocquillon <corentin@nybble.fr>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Fis Trivial <ybbs.daans@hotmail.com>
;;; Copyright © 2018 Tomáš Čech <sleep_walker@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages build-tools)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system cmake)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages python)
  #:use-module (gnu packages python-crypto)
  #:use-module (gnu packages python-web)
  #:use-module (gnu packages ninja)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system python))

(define-public bam
  (package
    (name "bam")
    (version "0.4.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://github.com/downloads/matricks/"
                                  "bam/bam-" version ".tar.bz2"))
              (sha256
               (base32
                "0z90wvyd4nfl7mybdrv9dsd4caaikc6fxw801b72gqi1m9q0c0sn"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (replace 'build
           (lambda _
             (zero? (system* "bash" "make_unix.sh"))))
         (replace 'check
           (lambda _
             (zero? (system* "python" "scripts/test.py"))))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((bin (string-append (assoc-ref outputs "out") "/bin")))
               (mkdir-p bin)
               (install-file "bam" bin)
               #t))))))
    (native-inputs
     `(("python" ,python-2)))
    (home-page "https://matricks.github.io/bam/")
    (synopsis "Fast and flexible build system")
    (description "Bam is a fast and flexible build system.  Bam uses Lua to
describe the build process.  It takes its inspiration for the script files
from scons.  While scons focuses on being 100% correct when building, bam
makes a few sacrifices to acquire fast full and incremental build times.")
    (license license:bsd-3)))

(define-public bear
  (package
    (name "bear")
    (version "2.3.12")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/rizsotto/Bear")
                    (commit version)))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "1zzz2yiiny9pm4h6ayb82xzxc2j5djcpf8va2wagcw92m7w6miqw"))))
    (build-system cmake-build-system)
    (inputs
     `(("python" ,python-wrapper)))
    (home-page "https://github.com/rizsotto/Bear")
    (synopsis "Tool for generating a compilation database")
    (description "A JSON compilation database is used in the Clang project to
provide information on how a given compilation unit is processed.  With this,
it is easy to re-run the compilation with alternate programs.  Bear is used to
generate such a compilation database.")
    (license license:gpl3+)))

(define-public meson
  (package
    (name "meson")
    (version "0.47.1")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/mesonbuild/meson/"
                                  "releases/download/" version  "/meson-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "19mdap2ncvczajx220bd73xmwhd8x906382y18cn9c5syxwxwwyn"))))
    (build-system python-build-system)
    (arguments
     `(;; FIXME: Tests require many additional inputs, a fix for the RUNPATH
       ;; patch in meson-for-build, and patching many hard-coded file system
       ;; locations in "run_unittests.py".
       #:tests? #f
       #:phases (modify-phases %standard-phases
                  ;; Meson calls the various executables in out/bin through the
                  ;; Python interpreter, so we cannot use the shell wrapper.
                  (delete 'wrap))))
    (inputs `(("ninja" ,ninja)))
    (propagated-inputs `(("python" ,python)))
    (home-page "https://mesonbuild.com/")
    (synopsis "Build system designed to be fast and user-friendly")
    (description
     "The Meson build system is focused on user-friendliness and speed.
It can compile code written in C, C++, Fortran, Java, Rust, and other
languages.  Meson provides features comparable to those of the
Autoconf/Automake/make combo.  Build specifications, also known as @dfn{Meson
files}, are written in a custom domain-specific language (@dfn{DSL}) that
resembles Python.")
    (license license:asl2.0)))

(define-public meson-for-build
  (package
    (inherit meson)
    (name "meson-for-build")
    (source (origin
              (inherit (package-source meson))
              (patches (search-patches "meson-for-build-rpath.patch"))))

    ;; People should probably install "meson", not "meson-for-build".
    (properties `((hidden? . #t)))))

(define-public premake4
  (package
    (name "premake")
    (version "4.3")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/premake/Premake/"
                                  version "/premake-" version "-src.zip"))
              (sha256
               (base32
                "1017rd0wsjfyq2jvpjjhpszaa7kmig6q1nimw76qx3cjz2868lrn"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("unzip" ,unzip))) ; for unpacking the source
    (arguments
     `(#:make-flags '("CC=gcc")
       #:tests? #f ; No test suite
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (add-after 'unpack 'enter-source
           (lambda _ (chdir "build/gmake.unix") #t))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (install-file "../../bin/release/premake4"
                           (string-append (assoc-ref outputs "out") "/bin"))
             #t)))))
    (synopsis "Portable software build tool")
    (description "@code{premake4} is a command line utility that reads a
scripted definition of a software project and outputs @file{Makefile}s or
other lower-level build files.")
    (home-page "https://premake.github.io")
    (license license:bsd-3)))

(define-public osc
  (package
    (name "osc")
    (version "0.162.1")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://github.com/openSUSE/" name
                           "/archive/" version ".tar.gz"))
       (file-name (string-append name "-" version ".tar.gz"))
       (sha256
        (base32 "0b4kpm96ns4smqyfjysbk2p78d36x44xprpna8zz85q1y5xn57aj"))))
    (build-system python-build-system)
    (arguments
     `(#:python ,python-2 ; Module is python2 only.
       #:phases
       (modify-phases %standard-phases
         (add-after 'install 'fix-filename-and-remove-unused
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((bin (string-append (assoc-ref outputs "out") "/bin/")))
               ;; Main osc tool is renamed in spec file, not setup.py, let's
               ;; do that too.
               (rename-file
                (string-append bin "osc-wrapper.py")
                (string-append bin "osc"))
               ;; Remove unused and broken script.
               (delete-file (string-append bin "osc_hotshot.py"))
             #t))))))
    (inputs
     `(("python2-m2crypto" ,python2-m2crypto)
       ("python2-pycurl" ,python2-pycurl)
       ("python2-urlgrabber" ,python2-urlgrabber)))
    (home-page "https://github.com/openSUSE/osc")
    (synopsis "Open Build Service command line tool")
    (description "@command{osc} is a command line interface to the Open Build
Service.  It allows you to checkout, commit, perform reviews etc.  The vast
majority of the OBS functionality is available via commands and the rest can
be reached via direct API calls.")
    (license license:gpl2+)))