gnu/packages/bootstrap.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu packages bootstrap)
  20   #:use-module (guix licenses)
  21   #:use-module (gnu packages)
  22   #:use-module (guix packages)
  23   #:use-module (guix download)
  24   #:use-module (guix build-system)
  25   #:use-module (guix build-system gnu)
  26   #:use-module (guix build-system trivial)
  27   #:use-module ((guix store) #:select (add-to-store add-text-to-store))
  28   #:use-module ((guix derivations) #:select (derivation))
  29   #:use-module (guix utils)
  30   #:use-module (srfi srfi-1)
  31   #:use-module (srfi srfi-26)
  32   #:use-module (ice-9 match)
  33   #:export (bootstrap-origin
  34             package-with-bootstrap-guile
  35             glibc-dynamic-linker
  36
  37             %bootstrap-guile
  38             %bootstrap-coreutils&co
  39             %bootstrap-binutils
  40             %bootstrap-gcc
  41             %bootstrap-glibc
  42             %bootstrap-inputs))
  43
  44 ;;; Commentary:
  45 ;;;
  46 ;;; Pre-built packages that are used to bootstrap the
  47 ;;; distribution--i.e., to build all the core packages from scratch.
  48 ;;;
  49 ;;; Code:
  50
  51
  52 \f
  53 ;;;
  54 ;;; Helper procedures.
  55 ;;;
  56
  57 (define (bootstrap-origin source)
  58   "Return a variant of SOURCE, an <origin> instance, whose method uses
  59 %BOOTSTRAP-GUILE to do its job."
  60   (define (boot fetch)
  61     (lambda* (store url hash-algo hash
  62               #:optional name #:key system)
  63       (fetch store url hash-algo hash
  64              #:guile %bootstrap-guile
  65              #:system system)))
  66
  67   (define %bootstrap-patch-inputs
  68     ;; Packages used when an <origin> has a non-empty 'patches' field.
  69     `(("tar"   ,%bootstrap-coreutils&co)
  70       ("xz"    ,%bootstrap-coreutils&co)
  71       ("bzip2" ,%bootstrap-coreutils&co)
  72       ("gzip"  ,%bootstrap-coreutils&co)
  73       ("patch" ,%bootstrap-coreutils&co)))
  74
  75   (let ((orig-method (origin-method source)))
  76     (origin (inherit source)
  77       (method (cond ((eq? orig-method url-fetch)
  78                      (boot url-fetch))
  79                     (else orig-method)))
  80       (patch-guile %bootstrap-guile)
  81       (patch-inputs %bootstrap-patch-inputs))))
  82
  83 (define (package-from-tarball name source program-to-test description)
  84   "Return a package that correspond to the extraction of SOURCE.
  85 PROGRAM-TO-TEST is a program to run after extraction of SOURCE, to
  86 check whether everything is alright."
  87   (package
  88     (name name)
  89     (version "0")
  90     (build-system trivial-build-system)
  91     (arguments
  92      `(#:guile ,%bootstrap-guile
  93        #:modules ((guix build utils))
  94        #:builder
  95        (let ((out     (assoc-ref %outputs "out"))
  96              (tar     (assoc-ref %build-inputs "tar"))
  97              (xz      (assoc-ref %build-inputs "xz"))
  98              (tarball (assoc-ref %build-inputs "tarball")))
  99          (use-modules (guix build utils))
 100
 101          (mkdir out)
 102          (copy-file tarball "binaries.tar.xz")
 103          (system* xz "-d" "binaries.tar.xz")
 104          (let ((builddir (getcwd)))
 105            (with-directory-excursion out
 106              (and (zero? (system* tar "xvf"
 107                                   (string-append builddir "/binaries.tar")))
 108                   (zero? (system* (string-append "bin/" ,program-to-test)
 109                                   "--version"))))))))
 110     (inputs
 111      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 112        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 113        ("tarball" ,(bootstrap-origin (source (%current-system))))))
 114     (source #f)
 115     (synopsis description)
 116     (description #f)
 117     (home-page #f)
 118     (license #f)))
 119
 120 (define package-with-bootstrap-guile
 121   (memoize
 122    (lambda (p)
 123     "Return a variant of P such that all its origins are fetched with
 124 %BOOTSTRAP-GUILE."
 125     (define rewritten-input
 126       (match-lambda
 127        ((name (? origin? o))
 128         `(,name ,(bootstrap-origin o)))
 129        ((name (? package? p) sub-drvs ...)
 130         `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
 131        (x x)))
 132
 133     (package (inherit p)
 134       (source (match (package-source p)
 135                 ((? origin? o) (bootstrap-origin o))
 136                 (s s)))
 137       (inputs (map rewritten-input
 138                    (package-inputs p)))
 139       (native-inputs (map rewritten-input
 140                           (package-native-inputs p)))
 141       (propagated-inputs (map rewritten-input
 142                               (package-propagated-inputs p)))))))
 143
 144 (define* (glibc-dynamic-linker
 145           #:optional (system (or (and=> (%current-target-system)
 146                                         gnu-triplet->nix-system)
 147                                  (%current-system))))
 148   "Return the name of Glibc's dynamic linker for SYSTEM."
 149   (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
 150         ((string=? system "i686-linux") "/lib/ld-linux.so.2")
 151         ((string=? system "mips64el-linux") "/lib/ld.so.1")
 152         (else (error "dynamic linker name not known for this system"
 153                      system))))
 154
 155 \f
 156 ;;;
 157 ;;; Bootstrap packages.
 158 ;;;
 159
 160 (define %bootstrap-guile
 161   ;; The Guile used to run the build scripts of the initial derivations.
 162   ;; It is just unpacked from a tarball containing a pre-built binary.
 163   ;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
 164   ;;
 165   ;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
 166   ;; support (for /etc/services).
 167   (let ((raw (build-system
 168               (name "raw")
 169               (description "Raw build system with direct store access")
 170               (build (lambda* (store name source inputs
 171                                      #:key outputs system search-paths)
 172                        (define (->store file)
 173                          (add-to-store store file #t "sha256"
 174                                        (or (search-bootstrap-binary file
 175                                                                     system)
 176                                            (error "bootstrap binary not found"
 177                                                   file system))))
 178
 179                        (let* ((tar   (->store "tar"))
 180                               (xz    (->store "xz"))
 181                               (mkdir (->store "mkdir"))
 182                               (bash  (->store "bash"))
 183                               (guile (->store "guile-2.0.9.tar.xz"))
 184                               (builder
 185                                (add-text-to-store store
 186                                                   "build-bootstrap-guile.sh"
 187                                                   (format #f "
 188 echo \"unpacking bootstrap Guile to '$out'...\"
 189 ~a $out
 190 cd $out
 191 ~a -dc < ~a | ~a xv
 192
 193 # Sanity check.
 194 $out/bin/guile --version~%"
 195                                                           mkdir xz guile tar)
 196                                                   (list mkdir xz guile tar))))
 197                          (derivation store name
 198                                      bash `(,builder)
 199                                      #:system system
 200                                      #:inputs `((,bash) (,builder)))))))))
 201    (package
 202      (name "guile-bootstrap")
 203      (version "2.0")
 204      (source #f)
 205      (build-system raw)
 206      (synopsis "Bootstrap Guile")
 207      (description "Pre-built Guile for bootstrapping purposes.")
 208      (home-page #f)
 209      (license lgpl3+))))
 210
 211 (define %bootstrap-base-urls
 212   ;; This is where the initial binaries come from.
 213   '("http://alpha.gnu.org/gnu/guix/bootstrap"
 214     "http://www.fdn.fr/~lcourtes/software/guix/packages"))
 215
 216 (define %bootstrap-coreutils&co
 217   (package-from-tarball "bootstrap-binaries"
 218                         (lambda (system)
 219                           (origin
 220                            (method url-fetch)
 221                            (uri (map (cut string-append <> "/" system
 222                                           "/20131110/static-binaries.tar.xz")
 223                                      %bootstrap-base-urls))
 224                            (sha256
 225                             (match system
 226                               ("x86_64-linux"
 227                                (base32
 228                                 "0c533p9dhczzcsa1117gmfq3pc8w362g4mx84ik36srpr7cx2bg4"))
 229                               ("i686-linux"
 230                                (base32
 231                                 "0s5b3jb315n13m1k8095l0a5hfrsz8g0fv1b6riyc5hnxqyphlak"))
 232                               ("mips64el-linux"
 233                                (base32
 234                                 "072y4wyfsj1bs80r6vbybbafy8ya4vfy7qj25dklwk97m6g71753"))))))
 235                         "true"                    ; the program to test
 236                         "Bootstrap binaries of Coreutils, Awk, etc."))
 237
 238 (define %bootstrap-binutils
 239   (package-from-tarball "binutils-bootstrap"
 240                         (lambda (system)
 241                           (origin
 242                            (method url-fetch)
 243                            (uri (map (cut string-append <> "/" system
 244                                           "/20131110/binutils-2.23.2.tar.xz")
 245                                      %bootstrap-base-urls))
 246                            (sha256
 247                             (match system
 248                               ("x86_64-linux"
 249                                (base32
 250                                 "1j5yivz7zkjqfsfmxzrrrffwyayjqyfxgpi89df0w4qziqs2dg20"))
 251                               ("i686-linux"
 252                                (base32
 253                                 "14jgwf9gscd7l2pnz610b1zia06dvcm2qyzvni31b8zpgmcai2v9"))
 254                               ("mips64el-linux"
 255                                (base32
 256                                 "1x8kkhcxmfyzg1ddpz2pxs6fbdl6412r7x0nzbmi5n7mj8zw2gy7"))))))
 257                         "ld"                      ; the program to test
 258                         "Bootstrap binaries of the GNU Binutils"))
 259
 260 (define %bootstrap-glibc
 261   ;; The initial libc.
 262   (package
 263     (name "glibc-bootstrap")
 264     (version "0")
 265     (source #f)
 266     (build-system trivial-build-system)
 267     (arguments
 268      `(#:guile ,%bootstrap-guile
 269        #:modules ((guix build utils))
 270        #:builder
 271        (let ((out     (assoc-ref %outputs "out"))
 272              (tar     (assoc-ref %build-inputs "tar"))
 273              (xz      (assoc-ref %build-inputs "xz"))
 274              (tarball (assoc-ref %build-inputs "tarball")))
 275          (use-modules (guix build utils))
 276
 277          (mkdir out)
 278          (copy-file tarball "binaries.tar.xz")
 279          (system* xz "-d" "binaries.tar.xz")
 280          (let ((builddir (getcwd)))
 281            (with-directory-excursion out
 282              (system* tar "xvf"
 283                       (string-append builddir
 284                                      "/binaries.tar"))
 285              (chmod "lib" #o755)
 286
 287              ;; Patch libc.so so it refers to the right path.
 288              (substitute* "lib/libc.so"
 289                (("/[^ ]+/lib/(libc|ld)" _ prefix)
 290                 (string-append out "/lib/" prefix))))))))
 291     (inputs
 292      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 293        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 294        ("tarball" ,(bootstrap-origin
 295                     (origin
 296                      (method url-fetch)
 297                      (uri (map (cut string-append <> "/" (%current-system)
 298                                     "/20131110/glibc-2.18.tar.xz")
 299                                %bootstrap-base-urls))
 300                      (sha256
 301                       (match (%current-system)
 302                         ("x86_64-linux"
 303                          (base32
 304                           "0jlqrgavvnplj1b083s20jj9iddr4lzfvwybw5xrcis9spbfzk7v"))
 305                         ("i686-linux"
 306                          (base32
 307                           "1hgrccw1zqdc7lvgivwa54d9l3zsim5pqm0dykxg0z522h6gr05w"))
 308                         ("mips64el-linux"
 309                          (base32
 310                           "0k97a3whzx3apsi9n2cbsrr79ad6lh00klxph9hw4fqyp1abkdsg")))))))))
 311     (synopsis "Bootstrap binaries and headers of the GNU C Library")
 312     (description #f)
 313     (home-page #f)
 314     (license lgpl2.1+)))
 315
 316 (define %bootstrap-gcc
 317   ;; The initial GCC.  Uses binaries from a tarball typically built by
 318   ;; %GCC-BOOTSTRAP-TARBALL.
 319   (package
 320     (name "gcc-bootstrap")
 321     (version "0")
 322     (source #f)
 323     (build-system trivial-build-system)
 324     (arguments
 325      `(#:guile ,%bootstrap-guile
 326        #:modules ((guix build utils))
 327        #:builder
 328        (let ((out     (assoc-ref %outputs "out"))
 329              (tar     (assoc-ref %build-inputs "tar"))
 330              (xz      (assoc-ref %build-inputs "xz"))
 331              (bash    (assoc-ref %build-inputs "bash"))
 332              (libc    (assoc-ref %build-inputs "libc"))
 333              (tarball (assoc-ref %build-inputs "tarball")))
 334          (use-modules (guix build utils)
 335                       (ice-9 popen))
 336
 337          (mkdir out)
 338          (copy-file tarball "binaries.tar.xz")
 339          (system* xz "-d" "binaries.tar.xz")
 340          (let ((builddir (getcwd))
 341                (bindir   (string-append out "/bin")))
 342            (with-directory-excursion out
 343              (system* tar "xvf"
 344                       (string-append builddir "/binaries.tar")))
 345
 346            (with-directory-excursion bindir
 347              (chmod "." #o755)
 348              (rename-file "gcc" ".gcc-wrapped")
 349              (call-with-output-file "gcc"
 350                (lambda (p)
 351                  (format p "#!~a
 352 exec ~a/bin/.gcc-wrapped -B~a/lib \
 353      -Wl,-rpath -Wl,~a/lib \
 354      -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 355                          bash
 356                          out libc libc libc
 357                          ,(glibc-dynamic-linker))))
 358
 359              (chmod "gcc" #o555))))))
 360     (inputs
 361      `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
 362        ("xz"  ,(search-bootstrap-binary "xz" (%current-system)))
 363        ("bash" ,(search-bootstrap-binary "bash" (%current-system)))
 364        ("libc" ,%bootstrap-glibc)
 365        ("tarball" ,(bootstrap-origin
 366                     (origin
 367                      (method url-fetch)
 368                      (uri (map (cut string-append <> "/" (%current-system)
 369                                     "/20131110/gcc-4.8.2.tar.xz")
 370                                %bootstrap-base-urls))
 371                      (sha256
 372                       (match (%current-system)
 373                         ("x86_64-linux"
 374                          (base32
 375                           "17ga4m6195n4fnbzdkmik834znkhs53nkypp6557pl1ps7dgqbls"))
 376                         ("i686-linux"
 377                          (base32
 378                           "150c1arrf2k8vfy6dpxh59vcgs4p1bgiz2av5m19dynpks7rjnyw"))
 379                         ("mips64el-linux"
 380                          (base32
 381                           "1m5miqkyng45l745n0sfafdpjkqv9225xf44jqkygwsipj2cv9ks")))))))))
 382     (native-search-paths
 383      (list (search-path-specification
 384             (variable "CPATH")
 385             (directories '("include")))
 386            (search-path-specification
 387             (variable "LIBRARY_PATH")
 388             (directories '("lib" "lib64")))))
 389     (synopsis "Bootstrap binaries of the GNU Compiler Collection")
 390     (description #f)
 391     (home-page #f)
 392     (license gpl3+)))
 393
 394 (define %bootstrap-inputs
 395   ;; The initial, pre-built inputs.  From now on, we can start building our
 396   ;; own packages.
 397   `(("libc" ,%bootstrap-glibc)
 398     ("gcc" ,%bootstrap-gcc)
 399     ("binutils" ,%bootstrap-binutils)
 400     ("coreutils&co" ,%bootstrap-coreutils&co)
 401
 402     ;; In gnu-build-system.scm, we rely on the availability of Bash.
 403     ("bash" ,%bootstrap-coreutils&co)))
 404
 405 ;;; bootstrap.scm ends here