gnu/packages/make-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 make-bootstrap)
  20   #:use-module (guix utils)
  21   #:use-module (guix packages)
  22   #:use-module (guix licenses)
  23   #:use-module (guix build-system trivial)
  24   #:use-module (guix build-system gnu)
  25   #:use-module ((gnu packages) #:select (search-patch))
  26   #:use-module (gnu packages base)
  27   #:use-module (gnu packages bash)
  28   #:use-module (gnu packages compression)
  29   #:use-module (gnu packages gawk)
  30   #:use-module (gnu packages guile)
  31   #:use-module (gnu packages linux)
  32   #:use-module (gnu packages multiprecision)
  33   #:use-module (ice-9 match)
  34   #:use-module (srfi srfi-1)
  35   #:export (%bootstrap-binaries-tarball
  36             %binutils-bootstrap-tarball
  37             %glibc-bootstrap-tarball
  38             %gcc-bootstrap-tarball
  39             %guile-bootstrap-tarball
  40             %bootstrap-tarballs))
  41
  42 ;;; Commentary:
  43 ;;;
  44 ;;; This modules provides tools to build tarballs of the "bootstrap binaries"
  45 ;;; used in (gnu packages bootstrap).  These statically-linked binaries are
  46 ;;; taken for granted and used as the root of the whole bootstrap procedure.
  47 ;;;
  48 ;;; Code:
  49
  50 (define %glibc-for-bootstrap
  51   ;; A libc whose `system' and `popen' functions looks for `sh' in $PATH,
  52   ;; without nscd, and with static NSS modules.
  53   (package (inherit glibc-final)
  54     (arguments
  55      (substitute-keyword-arguments (package-arguments glibc-final)
  56        ((#:patches patches)
  57         `(cons (assoc-ref %build-inputs "patch/system") ,patches))
  58        ((#:configure-flags flags)
  59         ;; Arrange so that getaddrinfo & co. do not contact the nscd,
  60         ;; and can use statically-linked NSS modules.
  61         `(cons* "--disable-nscd" "--disable-build-nscd"
  62                 "--enable-static-nss"
  63                 ,flags))))
  64     (inputs
  65      `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
  66        ,@(package-inputs glibc-final)))))
  67
  68 (define %standard-inputs-with-relocatable-glibc
  69   ;; Standard inputs with the above libc and corresponding GCC.
  70   `(("libc", %glibc-for-bootstrap)
  71     ("gcc" ,(package-with-explicit-inputs
  72              gcc-4.7
  73              `(("libc",%glibc-for-bootstrap)
  74                ,@(alist-delete "libc" %final-inputs))
  75              (current-source-location)))
  76     ,@(fold alist-delete %final-inputs '("libc" "gcc"))))
  77
  78 (define %bash-static
  79   (static-package bash-light))
  80
  81 (define %static-inputs
  82   ;; Packages that are to be used as %BOOTSTRAP-INPUTS.
  83   (let ((coreutils (package (inherit coreutils)
  84                      (arguments
  85                       `(#:configure-flags
  86                         '("--disable-nls"
  87                           "--disable-silent-rules"
  88                           "--enable-no-install-program=stdbuf,libstdbuf.so"
  89                           "CFLAGS=-Os -g0"        ; smaller, please
  90                           "LDFLAGS=-static -pthread")
  91                         #:tests? #f   ; signal-related Gnulib tests fail
  92                         ,@(package-arguments coreutils)))
  93
  94                      ;; Remove optional dependencies such as GMP.
  95                      (inputs `(,(assoc "perl" (package-inputs coreutils))))))
  96         (bzip2 (package (inherit bzip2)
  97                  (arguments
  98                   (substitute-keyword-arguments (package-arguments bzip2)
  99                     ((#:phases phases)
 100                      `(alist-cons-before
 101                        'build 'dash-static
 102                        (lambda _
 103                          (substitute* "Makefile"
 104                            (("^LDFLAGS[[:blank:]]*=.*$")
 105                             "LDFLAGS = -static")))
 106                        ,phases))))))
 107         (xz (package (inherit xz)
 108               (arguments
 109                `(#:strip-flags '("--strip-all")
 110                  #:phases (alist-cons-before
 111                            'configure 'static-executable
 112                            (lambda _
 113                              ;; Ask Libtool for a static executable.
 114                              (substitute* "src/xz/Makefile.in"
 115                                (("^xz_LDADD =")
 116                                 "xz_LDADD = -all-static")))
 117                            %standard-phases)))))
 118         (gawk (package (inherit gawk)
 119                 (arguments
 120                  `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
 121                    ,@(substitute-keyword-arguments (package-arguments gawk)
 122                        ((#:phases phases)
 123                         `(alist-cons-before
 124                           'configure 'no-export-dynamic
 125                           (lambda _
 126                             ;; Since we use `-static', remove
 127                             ;; `-export-dynamic'.
 128                             (substitute* "configure"
 129                               (("-export-dynamic") "")))
 130                           ,phases)))))
 131                 (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
 132         (finalize (lambda (p)
 133                     (static-package (package-with-explicit-inputs
 134                                      p
 135                                      %standard-inputs-with-relocatable-glibc)
 136                                     (current-source-location)))))
 137     `(,@(map (match-lambda
 138               ((name package)
 139                (list name (finalize package))))
 140              `(("tar" ,tar)
 141                ("gzip" ,gzip)
 142                ("bzip2" ,bzip2)
 143                ("xz" ,xz)
 144                ("patch" ,patch)
 145                ("coreutils" ,coreutils)
 146                ("sed" ,sed)
 147                ("grep" ,grep)
 148                ("gawk" ,gawk)))
 149       ("bash" ,%bash-static)
 150       ;; ("ld-wrapper" ,ld-wrapper)
 151       ;; ("binutils" ,binutils-final)
 152       ;; ("gcc" ,gcc-final)
 153       ;; ("libc" ,glibc-final)
 154       )))
 155
 156 (define %static-binaries
 157   (package
 158     (name "static-binaries")
 159     (version "0")
 160     (build-system trivial-build-system)
 161     (source #f)
 162     (inputs %static-inputs)
 163     (arguments
 164      `(#:modules ((guix build utils))
 165        #:builder
 166        (begin
 167          (use-modules (ice-9 ftw)
 168                       (ice-9 match)
 169                       (srfi srfi-1)
 170                       (srfi srfi-26)
 171                       (guix build utils))
 172
 173          (let ()
 174           (define (directory-contents dir)
 175             (map (cut string-append dir "/" <>)
 176                  (scandir dir (negate (cut member <> '("." ".."))))))
 177
 178           (define (copy-directory source destination)
 179             (for-each (lambda (file)
 180                         (format #t "copying ~s...~%" file)
 181                         (copy-file file
 182                                    (string-append destination "/"
 183                                                   (basename file))))
 184                       (directory-contents source)))
 185
 186           (let* ((out (assoc-ref %outputs "out"))
 187                  (bin (string-append out "/bin")))
 188             (mkdir-p bin)
 189
 190             ;; Copy Coreutils binaries.
 191             (let* ((coreutils (assoc-ref %build-inputs "coreutils"))
 192                    (source    (string-append coreutils "/bin")))
 193               (copy-directory source bin))
 194
 195             ;; For the other inputs, copy just one binary, which has the
 196             ;; same name as the input.
 197             (for-each (match-lambda
 198                        ((name . dir)
 199                         (let ((source (string-append dir "/bin/" name)))
 200                           (format #t "copying ~s...~%" source)
 201                           (copy-file source
 202                                      (string-append bin "/" name)))))
 203                       (alist-delete "coreutils" %build-inputs))
 204
 205             ;; But of course, there are exceptions to this rule.
 206             (let ((grep (assoc-ref %build-inputs "grep")))
 207               (copy-file (string-append grep "/bin/fgrep")
 208                          (string-append bin "/fgrep"))
 209               (copy-file (string-append grep "/bin/egrep")
 210                          (string-append bin "/egrep")))
 211
 212             ;; Clear references to the store path.
 213             (for-each remove-store-references
 214                       (directory-contents bin))
 215
 216             (with-directory-excursion bin
 217               ;; Programs such as Perl's build system want these aliases.
 218               (symlink "bash" "sh")
 219               (symlink "gawk" "awk"))
 220
 221             #t)))))
 222     (synopsis "Statically-linked bootstrap binaries")
 223     (description
 224      "Binaries used to bootstrap the distribution.")
 225     (license #f)
 226     (home-page #f)))
 227
 228 (define %binutils-static
 229   ;; Statically-linked Binutils.
 230   (package (inherit binutils)
 231     (name "binutils-static")
 232     (arguments
 233      `(#:configure-flags '("--disable-gold" "--with-lib-path=/no-ld-lib-path")
 234        #:strip-flags '("--strip-all")
 235        #:phases (alist-cons-before
 236                  'configure 'all-static
 237                  (lambda _
 238                    ;; The `-all-static' libtool flag can only be passed
 239                    ;; after `configure', since configure tests don't use
 240                    ;; libtool, and only for executables built with libtool.
 241                    (substitute* '("binutils/Makefile.in"
 242                                   "gas/Makefile.in"
 243                                   "ld/Makefile.in")
 244                      (("^LDFLAGS =(.*)$" line)
 245                       (string-append line
 246                                      "\nAM_LDFLAGS = -static -all-static\n"))))
 247                  %standard-phases)))))
 248
 249 (define %binutils-static-stripped
 250   ;; The subset of Binutils that we need.
 251   (package (inherit %binutils-static)
 252     (build-system trivial-build-system)
 253     (arguments
 254      `(#:modules ((guix build utils))
 255        #:builder
 256        (begin
 257          (use-modules (guix build utils))
 258
 259          (setvbuf (current-output-port) _IOLBF)
 260          (let* ((in  (assoc-ref %build-inputs "binutils"))
 261                 (out (assoc-ref %outputs "out"))
 262                 (bin (string-append out "/bin")))
 263            (mkdir-p bin)
 264            (for-each (lambda (file)
 265                        (let ((target (string-append bin "/" file)))
 266                          (format #t "copying `~a'...~%" file)
 267                          (copy-file (string-append in "/bin/" file)
 268                                     target)
 269                          (remove-store-references target)))
 270                      '("ar" "as" "ld" "nm"  "objcopy" "objdump"
 271                        "ranlib" "readelf" "size" "strings" "strip"))
 272            #t))))
 273     (inputs `(("binutils" ,%binutils-static)))))
 274
 275 (define %glibc-stripped
 276   ;; GNU libc's essential shared libraries, dynamic linker, and headers,
 277   ;; with all references to store directories stripped.  As a result,
 278   ;; libc.so is unusable and need to be patched for proper relocation.
 279   (let ((glibc %glibc-for-bootstrap))
 280     (package (inherit glibc)
 281       (name "glibc-stripped")
 282       (build-system trivial-build-system)
 283       (arguments
 284        `(#:modules ((guix build utils))
 285          #:builder
 286          (begin
 287            (use-modules (guix build utils))
 288
 289            (setvbuf (current-output-port) _IOLBF)
 290            (let* ((out    (assoc-ref %outputs "out"))
 291                   (libdir (string-append out "/lib"))
 292                   (incdir (string-append out "/include"))
 293                   (libc   (assoc-ref %build-inputs "libc"))
 294                   (linux  (assoc-ref %build-inputs "linux-headers")))
 295              (mkdir-p libdir)
 296              (for-each (lambda (file)
 297                          (let ((target (string-append libdir "/"
 298                                                       (basename file))))
 299                            (copy-file file target)
 300                            (remove-store-references target)))
 301                        (find-files (string-append libc "/lib")
 302                                    "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
 303
 304              (copy-recursively (string-append libc "/include") incdir)
 305
 306              ;; Copy some of the Linux-Libre headers that glibc headers
 307              ;; refer to.
 308              (mkdir (string-append incdir "/linux"))
 309              (for-each (lambda (file)
 310                          (copy-file (string-append linux "/include/linux/" file)
 311                                     (string-append incdir "/linux/"
 312                                                    (basename file))))
 313                        '("limits.h" "errno.h" "socket.h" "kernel.h"
 314                          "sysctl.h" "param.h" "ioctl.h" "types.h"
 315                          "posix_types.h" "stddef.h"))
 316
 317              (copy-recursively (string-append linux "/include/asm")
 318                                (string-append incdir "/asm"))
 319              (copy-recursively (string-append linux "/include/asm-generic")
 320                                (string-append incdir "/asm-generic"))
 321              #t))))
 322       (inputs `(("libc" ,glibc)
 323                 ("linux-headers" ,linux-libre-headers))))))
 324
 325 (define %gcc-static
 326   ;; A statically-linked GCC, with stripped-down functionality.
 327   (package-with-explicit-inputs
 328    (package (inherit gcc-final)
 329      (name "gcc-static")
 330      (arguments
 331       `(#:modules ((guix build utils)
 332                    (guix build gnu-build-system)
 333                    (srfi srfi-1)
 334                    (srfi srfi-26)
 335                    (ice-9 regex))
 336         ,@(substitute-keyword-arguments (package-arguments gcc-final)
 337             ((#:guile _) #f)
 338             ((#:implicit-inputs? _) #t)
 339             ((#:configure-flags flags)
 340              `(append (list
 341                        "--disable-shared"
 342                        "--disable-plugin"
 343                        "--enable-languages=c"
 344                        "--disable-libmudflap"
 345                        "--disable-libgomp"
 346                        "--disable-libssp"
 347                        "--disable-libquadmath"
 348                        "--disable-decimal-float")
 349                       (remove (cut string-match "--(.*plugin|enable-languages)" <>)
 350                               ,flags)))
 351             ((#:make-flags flags)
 352              `(cons "BOOT_LDFLAGS=-static" ,flags)))))
 353      (inputs `(("gmp-source" ,(package-source gmp))
 354                ("mpfr-source" ,(package-source mpfr))
 355                ("mpc-source" ,(package-source mpc))
 356                ("binutils" ,binutils-final)
 357                ,@(package-inputs gcc-4.7))))
 358    %standard-inputs-with-relocatable-glibc))
 359
 360 (define %gcc-stripped
 361   ;; The subset of GCC files needed for bootstrap.
 362   (package (inherit gcc-4.7)
 363     (name "gcc-stripped")
 364     (build-system trivial-build-system)
 365     (source #f)
 366     (arguments
 367      `(#:modules ((guix build utils))
 368        #:builder
 369        (begin
 370          (use-modules (srfi srfi-1)
 371                       (srfi srfi-26)
 372                       (guix build utils))
 373
 374          (setvbuf (current-output-port) _IOLBF)
 375          (let* ((out        (assoc-ref %outputs "out"))
 376                 (bindir     (string-append out "/bin"))
 377                 (libdir     (string-append out "/lib"))
 378                 (libexecdir (string-append out "/libexec"))
 379                 (gcc        (assoc-ref %build-inputs "gcc")))
 380            (copy-recursively (string-append gcc "/bin") bindir)
 381            (for-each remove-store-references
 382                      (find-files bindir ".*"))
 383
 384            (copy-recursively (string-append gcc "/lib") libdir)
 385            (for-each remove-store-references
 386                      (remove (cut string-suffix? ".h" <>)
 387                              (find-files libdir ".*")))
 388
 389            (copy-recursively (string-append gcc "/libexec")
 390                              libexecdir)
 391            (for-each remove-store-references
 392                      (find-files libexecdir ".*"))
 393            #t))))
 394     (inputs `(("gcc" ,%gcc-static)))))
 395
 396 (define %guile-static
 397   ;; A statically-linked Guile that is relocatable--i.e., it can search
 398   ;; .scm and .go files relative to its installation directory, rather
 399   ;; than in hard-coded configure-time paths.
 400   (let ((guile (package (inherit guile-2.0)
 401                  (inputs
 402                   `(("patch/relocatable"
 403                      ,(search-patch "guile-relocatable.patch"))
 404                     ("patch/utf8"
 405                      ,(search-patch "guile-default-utf8.patch"))
 406                     ,@(package-inputs guile-2.0)))
 407                  (arguments
 408                   `(;; When `configure' checks for ltdl availability, it
 409                     ;; doesn't try to link using libtool, and thus fails
 410                     ;; because of a missing -ldl.  Work around that.
 411                     #:configure-flags '("LDFLAGS=-ldl")
 412
 413                     #:phases (alist-cons-before
 414                               'configure 'static-guile
 415                               (lambda _
 416                                 (substitute* "libguile/Makefile.in"
 417                                   ;; Create a statically-linked `guile'
 418                                   ;; executable.
 419                                   (("^guile_LDFLAGS =")
 420                                    "guile_LDFLAGS = -all-static")
 421
 422                                   ;; Add `-ldl' *after* libguile-2.0.la.
 423                                   (("^guile_LDADD =(.*)$" _ ldadd)
 424                                    (string-append "guile_LDADD = "
 425                                                   (string-trim-right ldadd)
 426                                                   " -ldl\n"))))
 427                               %standard-phases)
 428
 429                     ;; Allow Guile to be relocated, as is needed during
 430                     ;; bootstrap.
 431                     #:patches
 432                     (list (assoc-ref %build-inputs "patch/relocatable")
 433                           (assoc-ref %build-inputs "patch/utf8"))
 434
 435                     ;; There are uses of `dynamic-link' in
 436                     ;; {foreign,coverage}.test that don't fly here.
 437                     #:tests? #f)))))
 438     (package-with-explicit-inputs (static-package guile)
 439                                   %standard-inputs-with-relocatable-glibc
 440                                   (current-source-location))))
 441
 442 (define %guile-static-stripped
 443   ;; A stripped static Guile binary, for use during bootstrap.
 444   (package (inherit %guile-static)
 445     (name "guile-static-stripped")
 446     (build-system trivial-build-system)
 447     (arguments
 448      `(#:modules ((guix build utils))
 449        #:builder
 450        (let ()
 451          (use-modules (guix build utils))
 452
 453          (let ((in  (assoc-ref %build-inputs "guile"))
 454                (out (assoc-ref %outputs "out")))
 455            (mkdir-p (string-append out "/share/guile/2.0"))
 456            (copy-recursively (string-append in "/share/guile/2.0")
 457                              (string-append out "/share/guile/2.0"))
 458
 459            (mkdir-p (string-append out "/lib/guile/2.0/ccache"))
 460            (copy-recursively (string-append in "/lib/guile/2.0/ccache")
 461                              (string-append out "/lib/guile/2.0/ccache"))
 462
 463            (mkdir (string-append out "/bin"))
 464            (copy-file (string-append in "/bin/guile")
 465                       (string-append out "/bin/guile"))
 466            (remove-store-references (string-append out "/bin/guile"))
 467            #t))))
 468     (inputs `(("guile" ,%guile-static)))))
 469
 470 (define (tarball-package pkg)
 471   "Return a package containing a tarball of PKG."
 472   (package (inherit pkg)
 473     (location (source-properties->location (current-source-location)))
 474     (name (string-append (package-name pkg) "-tarball"))
 475     (build-system trivial-build-system)
 476     (inputs `(("tar" ,tar)
 477               ("xz" ,xz)
 478               ("input" ,pkg)))
 479     (arguments
 480      (let ((name    (package-name pkg))
 481            (version (package-version pkg)))
 482        `(#:modules ((guix build utils))
 483          #:builder
 484          (begin
 485            (use-modules (guix build utils))
 486            (let ((out   (assoc-ref %outputs "out"))
 487                  (input (assoc-ref %build-inputs "input"))
 488                  (tar   (assoc-ref %build-inputs "tar"))
 489                  (xz    (assoc-ref %build-inputs "xz")))
 490              (mkdir out)
 491              (set-path-environment-variable "PATH" '("bin") (list tar xz))
 492              (with-directory-excursion input
 493                (zero? (system* "tar" "cJvf"
 494                                (string-append out "/"
 495                                               ,name "-" ,version
 496                                               "-" ,(%current-system)
 497                                               ".tar.xz")
 498                                "."))))))))))
 499
 500 (define %bootstrap-binaries-tarball
 501   ;; A tarball with the statically-linked bootstrap binaries.
 502   (tarball-package %static-binaries))
 503
 504 (define %binutils-bootstrap-tarball
 505   ;; A tarball with the statically-linked Binutils programs.
 506   (tarball-package %binutils-static-stripped))
 507
 508 (define %glibc-bootstrap-tarball
 509   ;; A tarball with GNU libc's shared libraries, dynamic linker, and headers.
 510   (tarball-package %glibc-stripped))
 511
 512 (define %gcc-bootstrap-tarball
 513   ;; A tarball with a dynamic-linked GCC and its headers.
 514   (tarball-package %gcc-stripped))
 515
 516 (define %guile-bootstrap-tarball
 517   ;; A tarball with the statically-linked, relocatable Guile.
 518   (tarball-package %guile-static-stripped))
 519
 520 (define %bootstrap-tarballs
 521   ;; A single derivation containing all the bootstrap tarballs, for
 522   ;; convenience.
 523   (package
 524     (name "bootstrap-tarballs")
 525     (version "0")
 526     (source #f)
 527     (build-system trivial-build-system)
 528     (arguments
 529      `(#:modules ((guix build utils))
 530        #:builder
 531        (let ((out (assoc-ref %outputs "out")))
 532          (use-modules (guix build utils)
 533                       (ice-9 match)
 534                       (srfi srfi-26))
 535
 536          (setvbuf (current-output-port) _IOLBF)
 537          (mkdir out)
 538          (chdir out)
 539          (for-each (match-lambda
 540                     ((name . directory)
 541                      (for-each (lambda (file)
 542                                  (format #t "~a -> ~a~%" file out)
 543                                  (symlink file (basename file)))
 544                                (find-files directory "\\.tar\\."))))
 545                    %build-inputs)
 546          #t)))
 547     (inputs `(("guile-tarball" ,%guile-bootstrap-tarball)
 548               ("gcc-tarball" ,%gcc-bootstrap-tarball)
 549               ("binutils-tarball" ,%binutils-bootstrap-tarball)
 550               ("glibc-tarball" ,%glibc-bootstrap-tarball)
 551               ("coreutils&co-tarball" ,%bootstrap-binaries-tarball)))
 552     (synopsis #f)
 553     (description #f)
 554     (home-page #f)
 555     (license gpl3+)))
 556
 557 ;;; make-bootstrap.scm ends here