distro/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 (distro packages bootstrap)
  20   #:use-module (guix licenses)
  21   #:use-module (distro)
  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   (let ((orig-method (origin-method source)))
  68     (origin (inherit source)
  69       (method (cond ((eq? orig-method url-fetch)
  70                      (boot url-fetch))
  71                     (else orig-method))))))
  72
  73 (define (package-from-tarball name* source* program-to-test description*)
  74   "Return a package that correspond to the extraction of SOURCE*.
  75 PROGRAM-TO-TEST is a program to run after extraction of SOURCE*, to
  76 check whether everything is alright."
  77   (package
  78     (name name*)
  79     (version "0")
  80     (source #f)
  81     (build-system trivial-build-system)
  82     (arguments
  83      `(#:guile ,%bootstrap-guile
  84        #:modules ((guix build utils))
  85        #:builder
  86        (let ((out     (assoc-ref %outputs "out"))
  87              (tar     (assoc-ref %build-inputs "tar"))
  88              (xz      (assoc-ref %build-inputs "xz"))
  89              (tarball (assoc-ref %build-inputs "tarball")))
  90          (use-modules (guix build utils))
  91
  92          (mkdir out)
  93          (copy-file tarball "binaries.tar.xz")
  94          (system* xz "-d" "binaries.tar.xz")
  95          (let ((builddir (getcwd)))
  96            (with-directory-excursion out
  97              (and (zero? (system* tar "xvf"
  98                                   (string-append builddir "/binaries.tar")))
  99                   (zero? (system* (string-append "bin/" ,program-to-test)
 100                                   "--version"))))))))
 101     (inputs
 102      `(("tar" ,(lambda (system)
 103                  (search-bootstrap-binary "tar" system)))
 104        ("xz"  ,(lambda (system)
 105                  (search-bootstrap-binary "xz" system)))
 106        ("tarball" ,(lambda (system)
 107                      (bootstrap-origin (source* system))))))
 108     (synopsis description*)
 109     (description #f)
 110     (home-page #f)))
 111
 112 (define package-with-bootstrap-guile
 113   (memoize
 114    (lambda (p)
 115     "Return a variant of P such that all its origins are fetched with
 116 %BOOTSTRAP-GUILE."
 117     (define rewritten-input
 118       (match-lambda
 119        ((name (? origin? o))
 120         `(,name ,(bootstrap-origin o)))
 121        ((name (? package? p) sub-drvs ...)
 122         `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
 123        (x x)))
 124
 125     (package (inherit p)
 126       (source (match (package-source p)
 127                 ((? origin? o) (bootstrap-origin o))
 128                 (s s)))
 129       (inputs (map rewritten-input
 130                    (package-inputs p)))
 131       (native-inputs (map rewritten-input
 132                           (package-native-inputs p)))
 133       (propagated-inputs (map rewritten-input
 134                               (package-propagated-inputs p)))))))
 135
 136 (define (glibc-dynamic-linker system)
 137   "Return the name of Glibc's dynamic linker for SYSTEM."
 138   (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
 139         ((string=? system "i686-linux") "/lib/ld-linux.so.2")
 140         (else (error "dynamic linker name not known for this system"
 141                      system))))
 142
 143 \f
 144 ;;;
 145 ;;; Bootstrap packages.
 146 ;;;
 147
 148 (define %bootstrap-guile
 149   ;; The Guile used to run the build scripts of the initial derivations.
 150   ;; It is just unpacked from a tarball containing a pre-built binary.
 151   ;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
 152   ;;
 153   ;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
 154   ;; support (for /etc/services).
 155   (let ((raw (build-system
 156               (name "raw")
 157               (description "Raw build system with direct store access")
 158               (build (lambda* (store name source inputs #:key outputs system)
 159                        (define (->store file)
 160                          (add-to-store store file #t #t "sha256"
 161                                        (or (search-bootstrap-binary file
 162                                                                     system)
 163                                            (error "bootstrap binary not found"
 164                                                   file system))))
 165
 166                        (let* ((tar   (->store "tar"))
 167                               (xz    (->store "xz"))
 168                               (mkdir (->store "mkdir"))
 169                               (bash  (->store "bash"))
 170                               (guile (->store "guile-2.0.7.tar.xz"))
 171                               (builder
 172                                (add-text-to-store store
 173                                                   "build-bootstrap-guile.sh"
 174                                                   (format #f "
 175 echo \"unpacking bootstrap Guile to '$out'...\"
 176 ~a $out
 177 cd $out
 178 ~a -dc < ~a | ~a xv
 179
 180 # Sanity check.
 181 $out/bin/guile --version~%"
 182                                                           mkdir xz guile tar)
 183                                                   (list mkdir xz guile tar))))
 184                          (derivation store name system
 185                                      bash `(,builder) '()
 186                                      `((,bash) (,builder)))))))))
 187    (package
 188      (name "guile-bootstrap")
 189      (version "2.0")
 190      (source #f)
 191      (build-system raw)
 192      (synopsis "Bootstrap Guile")
 193      (description "Pre-built Guile for bootstrapping purposes.")
 194      (home-page #f)
 195      (license lgpl3+))))
 196
 197 (define %bootstrap-base-urls
 198   ;; This is where the initial binaries come from.
 199   '("http://alpha.gnu.org/gnu/guix/bootstrap"
 200     "http://www.fdn.fr/~lcourtes/software/guix/packages"))
 201
 202 (define %bootstrap-coreutils&co
 203   (package-from-tarball "bootstrap-binaries"
 204                         (lambda (system)
 205                           (origin
 206                            (method url-fetch)
 207                            (uri (map (cut string-append <> "/" system
 208                                           "/20130105/static-binaries.tar.xz")
 209                                      %bootstrap-base-urls))
 210                            (sha256
 211                             (match system
 212                               ("x86_64-linux"
 213                                (base32
 214                                 "0md23alzy6nc5f16pric7mkagczdzr8xbh074sb3rjzrls06j1ls"))
 215                               ("i686-linux"
 216                                (base32
 217                                 "0nzj1lmm9b94g7k737cr4w1dv282w5nmhb53238ikax9r6pkc0yb"))))))
 218                         "true"                    ; the program to test
 219                         "Bootstrap binaries of Coreutils, Awk, etc."))
 220
 221 (define %bootstrap-binutils
 222   (package-from-tarball "binutils-bootstrap"
 223                         (lambda (system)
 224                           (origin
 225                            (method url-fetch)
 226                            (uri (map (cut string-append <> "/" system
 227                                           "/20130105/binutils-2.22.tar.xz")
 228                                      %bootstrap-base-urls))
 229                            (sha256
 230                             (match system
 231                               ("x86_64-linux"
 232                                (base32
 233                                 "1ffmk2yy2pxvkqgzrkzp3s4jpn4qaaksyk3b5nsc5cjwfm7qkgzh"))
 234                               ("i686-linux"
 235                                (base32
 236                                 "1rafk6aq4sayvv3r3d2khn93nkyzf002xzh0xadlyci4mznr6b0a"))))))
 237                         "ld"                      ; the program to test
 238                         "Bootstrap binaries of the GNU Binutils"))
 239
 240 (define %bootstrap-glibc
 241   ;; The initial libc.
 242   (package
 243     (name "glibc-bootstrap")
 244     (version "0")
 245     (source #f)
 246     (build-system trivial-build-system)
 247     (arguments
 248      `(#:guile ,%bootstrap-guile
 249        #:modules ((guix build utils))
 250        #:builder
 251        (let ((out     (assoc-ref %outputs "out"))
 252              (tar     (assoc-ref %build-inputs "tar"))
 253              (xz      (assoc-ref %build-inputs "xz"))
 254              (tarball (assoc-ref %build-inputs "tarball")))
 255          (use-modules (guix build utils))
 256
 257          (mkdir out)
 258          (copy-file tarball "binaries.tar.xz")
 259          (system* xz "-d" "binaries.tar.xz")
 260          (let ((builddir (getcwd)))
 261            (with-directory-excursion out
 262              (system* tar "xvf"
 263                       (string-append builddir
 264                                      "/binaries.tar"))
 265              (chmod "lib" #o755)
 266
 267              ;; Patch libc.so so it refers to the right path.
 268              (substitute* "lib/libc.so"
 269                (("/[^ ]+/lib/(libc|ld)" _ prefix)
 270                 (string-append out "/lib/" prefix))))))))
 271     (inputs
 272      `(("tar" ,(lambda (system)
 273                  (search-bootstrap-binary "tar" system)))
 274        ("xz"  ,(lambda (system)
 275                  (search-bootstrap-binary "xz" system)))
 276        ("tarball" ,(lambda (system)
 277                      (bootstrap-origin
 278                       (origin
 279                        (method url-fetch)
 280                        (uri (map (cut string-append <> "/" system
 281                                       "/20130105/glibc-2.17.tar.xz")
 282                                  %bootstrap-base-urls))
 283                        (sha256
 284                         (match system
 285                           ("x86_64-linux"
 286                            (base32
 287                             "18kv1z9d8dr1j3hm9w7663kchqw9p6rsx11n1m143jgba2jz6jy3"))
 288                           ("i686-linux"
 289                            (base32
 290                             "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88"))))))))))
 291     (synopsis "Bootstrap binaries and headers of the GNU C Library")
 292     (description #f)
 293     (home-page #f)))
 294
 295 (define %bootstrap-gcc
 296   ;; The initial GCC.  Uses binaries from a tarball typically built by
 297   ;; %GCC-BOOTSTRAP-TARBALL.
 298   (package
 299     (name "gcc-bootstrap")
 300     (version "0")
 301     (source #f)
 302     (build-system trivial-build-system)
 303     (arguments
 304      (lambda (system)
 305        `(#:guile ,%bootstrap-guile
 306          #:modules ((guix build utils))
 307          #:builder
 308          (let ((out     (assoc-ref %outputs "out"))
 309                (tar     (assoc-ref %build-inputs "tar"))
 310                (xz      (assoc-ref %build-inputs "xz"))
 311                (bash    (assoc-ref %build-inputs "bash"))
 312                (libc    (assoc-ref %build-inputs "libc"))
 313                (tarball (assoc-ref %build-inputs "tarball")))
 314            (use-modules (guix build utils)
 315                         (ice-9 popen))
 316
 317            (mkdir out)
 318            (copy-file tarball "binaries.tar.xz")
 319            (system* xz "-d" "binaries.tar.xz")
 320            (let ((builddir (getcwd))
 321                  (bindir   (string-append out "/bin")))
 322              (with-directory-excursion out
 323                (system* tar "xvf"
 324                         (string-append builddir "/binaries.tar")))
 325
 326              (with-directory-excursion bindir
 327                (chmod "." #o755)
 328                (rename-file "gcc" ".gcc-wrapped")
 329                (call-with-output-file "gcc"
 330                  (lambda (p)
 331                    (format p "#!~a
 332 exec ~a/bin/.gcc-wrapped -B~a/lib \
 333      -Wl,-rpath -Wl,~a/lib \
 334      -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 335                            bash
 336                            out libc libc libc
 337                            ,(glibc-dynamic-linker system))))
 338
 339                (chmod "gcc" #o555)))))))
 340     (inputs
 341      `(("tar" ,(lambda (system)
 342                  (search-bootstrap-binary "tar" system)))
 343        ("xz"  ,(lambda (system)
 344                  (search-bootstrap-binary "xz" system)))
 345        ("bash" ,(lambda (system)
 346                   (search-bootstrap-binary "bash" system)))
 347        ("libc" ,%bootstrap-glibc)
 348        ("tarball" ,(lambda (system)
 349                      (bootstrap-origin
 350                       (origin
 351                        (method url-fetch)
 352                        (uri (map (cut string-append <> "/" system
 353                                       "/20130105/gcc-4.7.2.tar.xz")
 354                                  %bootstrap-base-urls))
 355                        (sha256
 356                         (match system
 357                           ("x86_64-linux"
 358                            (base32
 359                             "1x1p7han5crnbw906iwdifykr6grzm0w27dy9gz75j0q1b32i4px"))
 360                           ("i686-linux"
 361                            (base32
 362                             "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2"))))))))))
 363     (synopsis "Bootstrap binaries of the GNU Compiler Collection")
 364     (description #f)
 365     (home-page #f)))
 366
 367 (define %bootstrap-inputs
 368   ;; The initial, pre-built inputs.  From now on, we can start building our
 369   ;; own packages.
 370   `(("libc" ,%bootstrap-glibc)
 371     ("gcc" ,%bootstrap-gcc)
 372     ("binutils" ,%bootstrap-binutils)
 373     ("coreutils&co" ,%bootstrap-coreutils&co)
 374
 375     ;; In gnu-build-system.scm, we rely on the availability of Bash.
 376     ("bash" ,%bootstrap-coreutils&co)))
 377
 378 ;;; bootstrap.scm ends here