gnu/packages/bootstrap.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu packages bootstrap)
  21   #:use-module (guix licenses)
  22   #:use-module (gnu packages)
  23   #:use-module (guix packages)
  24   #:use-module (guix download)
  25   #:use-module (guix build-system)
  26   #:use-module (guix build-system gnu)
  27   #:use-module (guix build-system trivial)
  28   #:use-module ((guix store) #:select (add-to-store add-text-to-store))
  29   #:use-module ((guix derivations) #:select (derivation))
  30   #:use-module ((guix utils) #:select (gnu-triplet->nix-system))
  31   #:use-module (guix memoization)
  32   #:use-module (srfi srfi-1)
  33   #:use-module (srfi srfi-26)
  34   #:use-module (ice-9 match)
  35   #:export (bootstrap-origin
  36             package-with-bootstrap-guile
  37             glibc-dynamic-linker
  38
  39             %bootstrap-guile
  40             %bootstrap-coreutils&co
  41             %bootstrap-binutils
  42             %bootstrap-gcc
  43             %bootstrap-glibc
  44             %bootstrap-inputs))
  45
  46 ;;; Commentary:
  47 ;;;
  48 ;;; Pre-built packages that are used to bootstrap the
  49 ;;; distribution--i.e., to build all the core packages from scratch.
  50 ;;;
  51 ;;; Code:
  52
  53
  54 \f
  55 ;;;
  56 ;;; Helper procedures.
  57 ;;;
  58
  59 (define (bootstrap-origin source)
  60   "Return a variant of SOURCE, an <origin> instance, whose method uses
  61 %BOOTSTRAP-GUILE to do its job."
  62   (define (boot fetch)
  63     (lambda* (url hash-algo hash
  64               #:optional name #:key system)
  65       (fetch url hash-algo hash name
  66              #:guile %bootstrap-guile
  67              #:system system)))
  68
  69   (define %bootstrap-patch-inputs
  70     ;; Packages used when an <origin> has a non-empty 'patches' field.
  71     `(("tar"   ,%bootstrap-coreutils&co)
  72       ("xz"    ,%bootstrap-coreutils&co)
  73       ("bzip2" ,%bootstrap-coreutils&co)
  74       ("gzip"  ,%bootstrap-coreutils&co)
  75       ("patch" ,%bootstrap-coreutils&co)))
  76
  77   (let ((orig-method (origin-method source)))
  78     (origin (inherit source)
  79       (method (cond ((eq? orig-method url-fetch)
  80                      (boot url-fetch))
  81                     (else orig-method)))
  82       (patch-guile %bootstrap-guile)
  83       (patch-inputs %bootstrap-patch-inputs)
  84
  85       ;; Patches can be origins as well, so process them.
  86       (patches (map (match-lambda
  87                      ((? origin? patch)
  88                       (bootstrap-origin patch))
  89                      (patch patch))
  90                     (origin-patches source))))))
  91
  92 (define* (package-from-tarball name source program-to-test description
  93                                #:key snippet)
  94   "Return a package that correspond to the extraction of SOURCE.
  95 PROGRAM-TO-TEST is a program to run after extraction of SOURCE, to
  96 check whether everything is alright.  If SNIPPET is provided, it is
  97 evaluated after extracting SOURCE.  SNIPPET should return true if
  98 successful, or false to signal an error."
  99   (package
 100     (name name)
 101     (version "0")
 102     (build-system trivial-build-system)
 103     (arguments
 104      `(#:guile ,%bootstrap-guile
 105        #:modules ((guix build utils))
 106        #:builder
 107        (let ((out     (assoc-ref %outputs "out"))
 108              (tar     (assoc-ref %build-inputs "tar"))
 109              (xz      (assoc-ref %build-inputs "xz"))
 110              (tarball (assoc-ref %build-inputs "tarball")))
 111          (use-modules (guix build utils))
 112
 113          (mkdir out)
 114          (copy-file tarball "binaries.tar.xz")
 115          (system* xz "-d" "binaries.tar.xz")
 116          (let ((builddir (getcwd)))
 117            (with-directory-excursion out
 118              (and (zero? (system* tar "xvf"
 119                                   (string-append builddir "/binaries.tar")))
 120                   ,@(if snippet (list snippet) '())
 121                   (zero? (system* (string-append "bin/" ,program-to-test)
 122                                   "--version"))))))))
 123     (inputs
 124      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 125        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 126        ("tarball" ,(bootstrap-origin (source (%current-system))))))
 127     (source #f)
 128     (synopsis description)
 129     (description description)
 130     (home-page #f)
 131     (license gpl3+)))
 132
 133 (define package-with-bootstrap-guile
 134   (mlambda (p)
 135     "Return a variant of P such that all its origins are fetched with
 136 %BOOTSTRAP-GUILE."
 137     (define rewritten-input
 138       (match-lambda
 139         ((name (? origin? o))
 140          `(,name ,(bootstrap-origin o)))
 141         ((name (? package? p) sub-drvs ...)
 142          `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
 143         (x x)))
 144
 145     (package (inherit p)
 146              (source (match (package-source p)
 147                        ((? origin? o) (bootstrap-origin o))
 148                        (s s)))
 149              (inputs (map rewritten-input
 150                           (package-inputs p)))
 151              (native-inputs (map rewritten-input
 152                                  (package-native-inputs p)))
 153              (propagated-inputs (map rewritten-input
 154                                      (package-propagated-inputs p)))
 155              (replacement (and=> (package-replacement p)
 156                                  package-with-bootstrap-guile)))))
 157
 158 (define* (glibc-dynamic-linker
 159           #:optional (system (or (and=> (%current-target-system)
 160                                         gnu-triplet->nix-system)
 161                                  (%current-system))))
 162   "Return the name of Glibc's dynamic linker for SYSTEM."
 163   (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
 164         ((string=? system "i686-linux") "/lib/ld-linux.so.2")
 165         ((string=? system "armhf-linux") "/lib/ld-linux-armhf.so.3")
 166         ((string=? system "mips64el-linux") "/lib/ld.so.1")
 167         ((string=? system "i586-gnu") "/lib/ld.so.1")
 168         ((string=? system "i686-gnu") "/lib/ld.so.1")
 169         ((string=? system "aarch64-linux") "/lib/ld-linux-aarch64.so.1")
 170
 171         ;; XXX: This one is used bare-bones, without a libc, so add a case
 172         ;; here just so we can keep going.
 173         ((string=? system "arm-eabi") "no-ld.so")
 174         ((string=? system "xtensa-elf") "no-ld.so")
 175         ((string=? system "avr") "no-ld.so")
 176         ((string=? system "propeller-elf") "no-ld.so")
 177         ((string=? system "i686-mingw") "no-ld.so")
 178
 179         (else (error "dynamic linker name not known for this system"
 180                      system))))
 181
 182 \f
 183 ;;;
 184 ;;; Bootstrap packages.
 185 ;;;
 186
 187 (define* (raw-build store name inputs
 188                     #:key outputs system search-paths
 189                     #:allow-other-keys)
 190   (define (->store file)
 191     (add-to-store store file #t "sha256"
 192                   (or (search-bootstrap-binary file
 193                                                system)
 194                       (error "bootstrap binary not found"
 195                              file system))))
 196
 197   (let* ((tar   (->store "tar"))
 198          (xz    (->store "xz"))
 199          (mkdir (->store "mkdir"))
 200          (bash  (->store "bash"))
 201          (guile (->store (match system
 202                            ("armhf-linux"
 203                             "guile-2.0.11.tar.xz")
 204                            (_
 205                             "guile-2.0.9.tar.xz"))))
 206          ;; The following code, run by the bootstrap guile after it is
 207          ;; unpacked, creates a wrapper for itself to set its load path.
 208          ;; This replaces the previous non-portable method based on
 209          ;; reading the /proc/self/exe symlink.
 210          (make-guile-wrapper
 211           '(begin
 212              (use-modules (ice-9 match))
 213              (match (command-line)
 214                ((_ out bash)
 215                 (let ((bin-dir    (string-append out "/bin"))
 216                       (guile      (string-append out "/bin/guile"))
 217                       (guile-real (string-append out "/bin/.guile-real"))
 218                       ;; We must avoid using a bare dollar sign in this code,
 219                       ;; because it would be interpreted by the shell.
 220                       (dollar     (string (integer->char 36))))
 221                   (chmod bin-dir #o755)
 222                   (rename-file guile guile-real)
 223                   (call-with-output-file guile
 224                     (lambda (p)
 225                       (format p "\
 226 #!~a
 227 export GUILE_SYSTEM_PATH=~a/share/guile/2.0
 228 export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
 229 exec -a \"~a0\" ~a \"~a@\"\n"
 230                               bash out out dollar guile-real dollar)))
 231                   (chmod guile   #o555)
 232                   (chmod bin-dir #o555))))))
 233          (builder
 234           (add-text-to-store store
 235                              "build-bootstrap-guile.sh"
 236                              (format #f "
 237 echo \"unpacking bootstrap Guile to '$out'...\"
 238 ~a $out
 239 cd $out
 240 ~a -dc < ~a | ~a xv
 241
 242 # Use the bootstrap guile to create its own wrapper to set the load path.
 243 GUILE_SYSTEM_PATH=$out/share/guile/2.0 \
 244 GUILE_SYSTEM_COMPILED_PATH=$out/lib/guile/2.0/ccache \
 245 $out/bin/guile -c ~s $out ~a
 246
 247 # Sanity check.
 248 $out/bin/guile --version~%"
 249                                      mkdir xz guile tar
 250                                      (format #f "~s" make-guile-wrapper)
 251                                      bash)
 252                              (list mkdir xz guile tar bash))))
 253     (derivation store name
 254                 bash `(,builder)
 255                 #:system system
 256                 #:inputs `((,bash) (,builder)))))
 257
 258 (define* (make-raw-bag name
 259                        #:key source inputs native-inputs outputs
 260                        system target)
 261   (bag
 262     (name name)
 263     (system system)
 264     (build-inputs inputs)
 265     (build raw-build)))
 266
 267 (define %bootstrap-guile
 268   ;; The Guile used to run the build scripts of the initial derivations.
 269   ;; It is just unpacked from a tarball containing a pre-built binary.
 270   ;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
 271   ;;
 272   ;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
 273   ;; support (for /etc/services).
 274   (let ((raw (build-system
 275                (name 'raw)
 276                (description "Raw build system with direct store access")
 277                (lower make-raw-bag))))
 278    (package
 279      (name "guile-bootstrap")
 280      (version "2.0")
 281      (source #f)
 282      (build-system raw)
 283      (synopsis "Bootstrap Guile")
 284      (description "Pre-built Guile for bootstrapping purposes.")
 285      (home-page #f)
 286      (license lgpl3+))))
 287
 288 (define %bootstrap-base-urls
 289   ;; This is where the initial binaries come from.
 290   '("ftp://alpha.gnu.org/gnu/guix/bootstrap"
 291     "http://alpha.gnu.org/gnu/guix/bootstrap"
 292     "http://www.fdn.fr/~lcourtes/software/guix/packages"))
 293
 294 (define %bootstrap-coreutils&co
 295   (package-from-tarball "bootstrap-binaries"
 296                         (lambda (system)
 297                           (origin
 298                            (method url-fetch)
 299                            (uri (map (cut string-append <> "/" system
 300                                           (match system
 301                                             ("armhf-linux"
 302                                              "/20150101/static-binaries.tar.xz")
 303                                             (_
 304                                              "/20131110/static-binaries.tar.xz")))
 305                                      %bootstrap-base-urls))
 306                            (sha256
 307                             (match system
 308                               ("x86_64-linux"
 309                                (base32
 310                                 "0c533p9dhczzcsa1117gmfq3pc8w362g4mx84ik36srpr7cx2bg4"))
 311                               ("i686-linux"
 312                                (base32
 313                                 "0s5b3jb315n13m1k8095l0a5hfrsz8g0fv1b6riyc5hnxqyphlak"))
 314                               ("armhf-linux"
 315                                (base32
 316                                 "0gf0fn2kbpxkjixkmx5f4z6hv6qpmgixl69zgg74dbsfdfj8jdv5"))
 317                               ("mips64el-linux"
 318                                (base32
 319                                 "072y4wyfsj1bs80r6vbybbafy8ya4vfy7qj25dklwk97m6g71753"))))))
 320                         "fgrep"                    ; the program to test
 321                         "Bootstrap binaries of Coreutils, Awk, etc."
 322                         #:snippet
 323                         '(let ((path (list (string-append (getcwd) "/bin"))))
 324                            (chmod "bin" #o755)
 325                            (patch-shebang "bin/egrep" path)
 326                            (patch-shebang "bin/fgrep" path)
 327                            (chmod "bin" #o555)
 328                            #t)))
 329
 330 (define %bootstrap-binutils
 331   (package-from-tarball "binutils-bootstrap"
 332                         (lambda (system)
 333                           (origin
 334                            (method url-fetch)
 335                            (uri (map (cut string-append <> "/" system
 336                                           (match system
 337                                             ("armhf-linux"
 338                                              "/20150101/binutils-2.25.tar.xz")
 339                                             (_
 340                                              "/20131110/binutils-2.23.2.tar.xz")))
 341                                      %bootstrap-base-urls))
 342                            (sha256
 343                             (match system
 344                               ("x86_64-linux"
 345                                (base32
 346                                 "1j5yivz7zkjqfsfmxzrrrffwyayjqyfxgpi89df0w4qziqs2dg20"))
 347                               ("i686-linux"
 348                                (base32
 349                                 "14jgwf9gscd7l2pnz610b1zia06dvcm2qyzvni31b8zpgmcai2v9"))
 350                               ("armhf-linux"
 351                                (base32
 352                                 "1v7dj6bzn6m36f20gw31l99xaabq4xrhrx3gwqkhhig0mdlmr69q"))
 353                               ("mips64el-linux"
 354                                (base32
 355                                 "1x8kkhcxmfyzg1ddpz2pxs6fbdl6412r7x0nzbmi5n7mj8zw2gy7"))))))
 356                         "ld"                      ; the program to test
 357                         "Bootstrap binaries of the GNU Binutils"))
 358
 359 (define %bootstrap-glibc
 360   ;; The initial libc.
 361   (package
 362     (name "glibc-bootstrap")
 363     (version "0")
 364     (source #f)
 365     (build-system trivial-build-system)
 366     (arguments
 367      `(#:guile ,%bootstrap-guile
 368        #:modules ((guix build utils))
 369        #:builder
 370        (let ((out     (assoc-ref %outputs "out"))
 371              (tar     (assoc-ref %build-inputs "tar"))
 372              (xz      (assoc-ref %build-inputs "xz"))
 373              (tarball (assoc-ref %build-inputs "tarball")))
 374          (use-modules (guix build utils))
 375
 376          (mkdir out)
 377          (copy-file tarball "binaries.tar.xz")
 378          (system* xz "-d" "binaries.tar.xz")
 379          (let ((builddir (getcwd)))
 380            (with-directory-excursion out
 381              (system* tar "xvf"
 382                       (string-append builddir
 383                                      "/binaries.tar"))
 384              (chmod "lib" #o755)
 385
 386              ;; Patch libc.so so it refers to the right path.
 387              (substitute* "lib/libc.so"
 388                (("/[^ ]+/lib/(libc|ld)" _ prefix)
 389                 (string-append out "/lib/" prefix))))))))
 390     (inputs
 391      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 392        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 393        ("tarball" ,(bootstrap-origin
 394                     (origin
 395                      (method url-fetch)
 396                      (uri (map (cut string-append <> "/" (%current-system)
 397                                     (match (%current-system)
 398                                       ("armhf-linux"
 399                                        "/20150101/glibc-2.20.tar.xz")
 400                                       (_
 401                                        "/20131110/glibc-2.18.tar.xz")))
 402                                %bootstrap-base-urls))
 403                      (sha256
 404                       (match (%current-system)
 405                         ("x86_64-linux"
 406                          (base32
 407                           "0jlqrgavvnplj1b083s20jj9iddr4lzfvwybw5xrcis9spbfzk7v"))
 408                         ("i686-linux"
 409                          (base32
 410                           "1hgrccw1zqdc7lvgivwa54d9l3zsim5pqm0dykxg0z522h6gr05w"))
 411                         ("armhf-linux"
 412                          (base32
 413                           "18cmgvpllqfpn6khsmivqib7ys8ymnq0hdzi3qp24prik0ykz8gn"))
 414                         ("mips64el-linux"
 415                          (base32
 416                           "0k97a3whzx3apsi9n2cbsrr79ad6lh00klxph9hw4fqyp1abkdsg")))))))))
 417     (synopsis "Bootstrap binaries and headers of the GNU C Library")
 418     (description synopsis)
 419     (home-page #f)
 420     (license lgpl2.1+)))
 421
 422 (define %bootstrap-gcc
 423   ;; The initial GCC.  Uses binaries from a tarball typically built by
 424   ;; %GCC-BOOTSTRAP-TARBALL.
 425   (package
 426     (name "gcc-bootstrap")
 427     (version "0")
 428     (source #f)
 429     (build-system trivial-build-system)
 430     (arguments
 431      `(#:guile ,%bootstrap-guile
 432        #:modules ((guix build utils))
 433        #:builder
 434        (let ((out     (assoc-ref %outputs "out"))
 435              (tar     (assoc-ref %build-inputs "tar"))
 436              (xz      (assoc-ref %build-inputs "xz"))
 437              (bash    (assoc-ref %build-inputs "bash"))
 438              (libc    (assoc-ref %build-inputs "libc"))
 439              (tarball (assoc-ref %build-inputs "tarball")))
 440          (use-modules (guix build utils)
 441                       (ice-9 popen))
 442
 443          (mkdir out)
 444          (copy-file tarball "binaries.tar.xz")
 445          (system* xz "-d" "binaries.tar.xz")
 446          (let ((builddir (getcwd))
 447                (bindir   (string-append out "/bin")))
 448            (with-directory-excursion out
 449              (system* tar "xvf"
 450                       (string-append builddir "/binaries.tar")))
 451
 452            (with-directory-excursion bindir
 453              (chmod "." #o755)
 454              (rename-file "gcc" ".gcc-wrapped")
 455              (call-with-output-file "gcc"
 456                (lambda (p)
 457                  (format p "#!~a
 458 exec ~a/bin/.gcc-wrapped -B~a/lib \
 459      -Wl,-rpath -Wl,~a/lib \
 460      -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 461                          bash
 462                          out libc libc libc
 463                          ,(glibc-dynamic-linker))))
 464
 465              (chmod "gcc" #o555))))))
 466     (inputs
 467      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 468        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 469        ("bash" ,(search-bootstrap-binary "bash" (%current-system)))
 470        ("libc" ,%bootstrap-glibc)
 471        ("tarball" ,(bootstrap-origin
 472                     (origin
 473                      (method url-fetch)
 474                      (uri (map (cut string-append <> "/" (%current-system)
 475                                     (match (%current-system)
 476                                       ("armhf-linux"
 477                                        "/20150101/gcc-4.8.4.tar.xz")
 478                                       (_
 479                                        "/20131110/gcc-4.8.2.tar.xz")))
 480                                %bootstrap-base-urls))
 481                      (sha256
 482                       (match (%current-system)
 483                         ("x86_64-linux"
 484                          (base32
 485                           "17ga4m6195n4fnbzdkmik834znkhs53nkypp6557pl1ps7dgqbls"))
 486                         ("i686-linux"
 487                          (base32
 488                           "150c1arrf2k8vfy6dpxh59vcgs4p1bgiz2av5m19dynpks7rjnyw"))
 489                         ("armhf-linux"
 490                          (base32
 491                           "0ghz825yzp43fxw53kd6afm8nkz16f7dxi9xi40bfwc8x3nbbr8v"))
 492                         ("mips64el-linux"
 493                          (base32
 494                           "1m5miqkyng45l745n0sfafdpjkqv9225xf44jqkygwsipj2cv9ks")))))))))
 495     (native-search-paths
 496      (list (search-path-specification
 497             (variable "CPATH")
 498             (files '("include")))
 499            (search-path-specification
 500             (variable "LIBRARY_PATH")
 501             (files '("lib" "lib64")))))
 502     (synopsis "Bootstrap binaries of the GNU Compiler Collection")
 503     (description synopsis)
 504     (home-page #f)
 505     (license gpl3+)))
 506
 507 (define %bootstrap-inputs
 508   ;; The initial, pre-built inputs.  From now on, we can start building our
 509   ;; own packages.
 510   `(("libc" ,%bootstrap-glibc)
 511     ("gcc" ,%bootstrap-gcc)
 512     ("binutils" ,%bootstrap-binutils)
 513     ("coreutils&co" ,%bootstrap-coreutils&co)
 514
 515     ;; In gnu-build-system.scm, we rely on the availability of Bash.
 516     ("bash" ,%bootstrap-coreutils&co)))
 517
 518 ;;; bootstrap.scm ends here