distro/packages/bootstrap.scm

   1 ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
   2 ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of Guix.
   5 ;;;
   6 ;;; 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 ;;; 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 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-bootstrap-2.0.6.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-url
 198   ;; This is where the initial binaries come from.
 199   "http://www.fdn.fr/~lcourtes/software/guix/packages")
 200
 201 (define %bootstrap-coreutils&co
 202   (package-from-tarball "bootstrap-binaries"
 203                         (lambda (system)
 204                           (origin
 205                            (method url-fetch)
 206                            (uri (string-append
 207                                  %bootstrap-base-url "/"
 208                                  system "/20121115/static-binaries.tar.xz"))
 209                            (sha256
 210                             (match system
 211                               ("x86_64-linux"
 212                                (base32
 213                                 "0azisn8l2b3cvgni9k0ahzsxs5cxrj0hmf38zgpq3k6pggk3zbfm"))
 214                               ("i686-linux"
 215                                (base32
 216                                 "16v60frbh0naccanwxcxz0z3444dd8salbg8p7cp7vwz8245nhfk"))))))
 217                         "true"                    ; the program to test
 218                         "Bootstrap binaries of Coreutils, Awk, etc."))
 219
 220 (define %bootstrap-binutils
 221   (package-from-tarball "binutils-bootstrap"
 222                         (lambda (system)
 223                           (origin
 224                            (method url-fetch)
 225                            (uri (string-append
 226                                  %bootstrap-base-url "/"
 227                                  system "/20121115/binutils-2.22.tar.xz"))
 228                            (sha256
 229                             (match system
 230                               ("x86_64-linux"
 231                                (base32
 232                                 "0ms6i035v40n7mhi91n4b8ivwv2qni3mcd5dj9sj9qmvgqb50r84"))
 233                               ("i686-linux"
 234                                (base32
 235                                 "193x62ach4l4x16rbzglrqa1d0a825z2as6czdiv9xjiizmcr0ad"))))))
 236                         "ld"                      ; the program to test
 237                         "Bootstrap binaries of the GNU Binutils"))
 238
 239 (define %bootstrap-glibc
 240   ;; The initial libc.
 241   (package
 242     (name "glibc-bootstrap")
 243     (version "0")
 244     (source #f)
 245     (build-system trivial-build-system)
 246     (arguments
 247      `(#:guile ,%bootstrap-guile
 248        #:modules ((guix build utils))
 249        #:builder
 250        (let ((out     (assoc-ref %outputs "out"))
 251              (tar     (assoc-ref %build-inputs "tar"))
 252              (xz      (assoc-ref %build-inputs "xz"))
 253              (tarball (assoc-ref %build-inputs "tarball")))
 254          (use-modules (guix build utils))
 255
 256          (mkdir out)
 257          (copy-file tarball "binaries.tar.xz")
 258          (system* xz "-d" "binaries.tar.xz")
 259          (let ((builddir (getcwd)))
 260            (with-directory-excursion out
 261              (system* tar "xvf"
 262                       (string-append builddir
 263                                      "/binaries.tar"))
 264              (chmod "lib" #o755)
 265
 266              ;; Patch libc.so so it refers to the right path.
 267              (substitute* "lib/libc.so"
 268                (("/[^ ]+/lib/(libc|ld)" _ prefix)
 269                 (string-append out "/lib/" prefix))))))))
 270     (inputs
 271      `(("tar" ,(lambda (system)
 272                  (search-bootstrap-binary "tar" system)))
 273        ("xz"  ,(lambda (system)
 274                  (search-bootstrap-binary "xz" system)))
 275        ("tarball" ,(lambda (system)
 276                      (bootstrap-origin
 277                       (origin
 278                        (method url-fetch)
 279                        (uri (string-append %bootstrap-base-url "/" system
 280                                            "/20121115/glibc-2.16.0.tar.xz"))
 281                        (sha256
 282                         (match system
 283                           ("x86_64-linux"
 284                            (base32
 285                             "1cz587p3scrrx0zgqnmp4nnfj0vvf01zdqdgkz445dnbfh64nl0v"))
 286                           ("i686-linux"
 287                            (base32
 288                             "0vzybz1577vflm0p0zg1slqj32carj5102b45k7iskkj46viy14z"))))))))))
 289     (synopsis "Bootstrap binaries and headers of the GNU C Library")
 290     (description #f)
 291     (home-page #f)))
 292
 293 (define %bootstrap-gcc
 294   ;; The initial GCC.  Uses binaries from a tarball typically built by
 295   ;; %GCC-BOOTSTRAP-TARBALL.
 296   (package
 297     (name "gcc-bootstrap")
 298     (version "0")
 299     (source #f)
 300     (build-system trivial-build-system)
 301     (arguments
 302      (lambda (system)
 303        `(#:guile ,%bootstrap-guile
 304          #:modules ((guix build utils))
 305          #:builder
 306          (let ((out     (assoc-ref %outputs "out"))
 307                (tar     (assoc-ref %build-inputs "tar"))
 308                (xz      (assoc-ref %build-inputs "xz"))
 309                (bash    (assoc-ref %build-inputs "bash"))
 310                (libc    (assoc-ref %build-inputs "libc"))
 311                (tarball (assoc-ref %build-inputs "tarball")))
 312            (use-modules (guix build utils)
 313                         (ice-9 popen))
 314
 315            (mkdir out)
 316            (copy-file tarball "binaries.tar.xz")
 317            (system* xz "-d" "binaries.tar.xz")
 318            (let ((builddir (getcwd))
 319                  (bindir   (string-append out "/bin")))
 320              (with-directory-excursion out
 321                (system* tar "xvf"
 322                         (string-append builddir "/binaries.tar")))
 323
 324              (with-directory-excursion bindir
 325                (chmod "." #o755)
 326                (rename-file "gcc" ".gcc-wrapped")
 327                (call-with-output-file "gcc"
 328                  (lambda (p)
 329                    (format p "#!~a
 330 exec ~a/bin/.gcc-wrapped -B~a/lib \
 331      -Wl,-rpath -Wl,~a/lib \
 332      -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 333                            bash
 334                            out libc libc libc
 335                            ,(glibc-dynamic-linker system))))
 336
 337                (chmod "gcc" #o555)))))))
 338     (inputs
 339      `(("tar" ,(lambda (system)
 340                  (search-bootstrap-binary "tar" system)))
 341        ("xz"  ,(lambda (system)
 342                  (search-bootstrap-binary "xz" system)))
 343        ("bash" ,(lambda (system)
 344                   (search-bootstrap-binary "bash" system)))
 345        ("libc" ,%bootstrap-glibc)
 346        ("tarball" ,(lambda (system)
 347                      (bootstrap-origin
 348                       (origin
 349                        (method url-fetch)
 350                        (uri (string-append %bootstrap-base-url "/" system
 351                                            "/20121115/gcc-4.7.2.tar.xz"))
 352                        (sha256
 353                         (match system
 354                           ("x86_64-linux"
 355                            (base32
 356                             "0fg65i2qcym8ls5ig3g1cc9ida5cxwwsd6zi95xi1d8dnfrja4zz"))
 357                           ("i686-linux"
 358                            (base32
 359                             "01hlz98qmc8yhqrxqajpg5kbkhpvqq6wjnbfvplys32n895avzxg"))))))))))
 360     (synopsis "Bootstrap binaries of the GNU Compiler Collection")
 361     (description #f)
 362     (home-page #f)))
 363
 364 (define %bootstrap-inputs
 365   ;; The initial, pre-built inputs.  From now on, we can start building our
 366   ;; own packages.
 367   `(("libc" ,%bootstrap-glibc)
 368     ("gcc" ,%bootstrap-gcc)
 369     ("binutils" ,%bootstrap-binutils)
 370     ("coreutils&co" ,%bootstrap-coreutils&co)
 371
 372     ;; In gnu-build-system.scm, we rely on the availability of Bash.
 373     ("bash" ,%bootstrap-coreutils&co)))
 374
 375 ;;; bootstrap.scm ends here