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