1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (distro 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 ((distro) #:select (search-patch))
26 #:use-module (distro packages base)
27 #:use-module (distro packages bash)
28 #:use-module (distro packages compression)
29 #:use-module (distro packages gawk)
30 #:use-module (distro packages guile)
31 #:use-module (distro packages linux)
32 #:use-module (distro 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
44 ;;; This modules provides tools to build tarballs of the "bootstrap binaries"
45 ;;; used in (distro packages bootstrap). These statically-linked binaries are
46 ;;; taken for granted and used as the root of the whole bootstrap procedure.
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)
56 (substitute-keyword-arguments ((package-arguments glibc-final) system)
58 `(cons (assoc-ref %build-inputs "patch/system")
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"
67 `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
68 ,@(package-inputs glibc-final)))))
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
75 `(("libc",%glibc-for-bootstrap)
76 ,@(alist-delete "libc" %final-inputs))
77 (current-source-location)))
78 ,@(fold alist-delete %final-inputs '("libc" "gcc"))))
81 (static-package bash-light))
83 (define %static-inputs
84 ;; Packages that are to be used as %BOOTSTRAP-INPUTS.
85 (let ((coreutils (package (inherit coreutils)
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)))
96 ;; Remove optional dependencies such as GMP.
97 (inputs `(,(assoc "perl" (package-inputs coreutils))))))
98 (bzip2 (package (inherit bzip2)
100 (substitute-keyword-arguments (package-arguments bzip2)
105 (substitute* "Makefile"
106 (("^LDFLAGS[[:blank:]]*=.*$")
107 "LDFLAGS = -static")))
109 (xz (package (inherit xz)
111 `(#:strip-flags '("--strip-all")
112 #:phases (alist-cons-before
113 'configure 'static-executable
115 ;; Ask Libtool for a static executable.
116 (substitute* "src/xz/Makefile.in"
118 "xz_LDADD = -all-static")))
119 %standard-phases)))))
120 (gawk (package (inherit gawk)
123 `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
124 ,@(substitute-keyword-arguments
125 ((package-arguments gawk) system)
128 'configure 'no-export-dynamic
130 ;; Since we use `-static', remove
131 ;; `-export-dynamic'.
132 (substitute* "configure"
133 (("-export-dynamic") "")))
135 (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
136 (finalize (lambda (p)
137 (static-package (package-with-explicit-inputs
139 %standard-inputs-with-relocatable-glibc)
140 (current-source-location)))))
141 `(,@(map (match-lambda
143 (list name (finalize package))))
149 ("coreutils" ,coreutils)
153 ("bash" ,%bash-static)
154 ;; ("ld-wrapper" ,ld-wrapper)
155 ;; ("binutils" ,binutils-final)
156 ;; ("gcc" ,gcc-final)
157 ;; ("libc" ,glibc-final)
160 (define %static-binaries
162 (name "static-binaries")
164 (build-system trivial-build-system)
166 (inputs %static-inputs)
168 `(#:modules ((guix build utils))
171 (use-modules (ice-9 ftw)
178 (define (directory-contents dir)
179 (map (cut string-append dir "/" <>)
180 (scandir dir (negate (cut member <> '("." ".."))))))
182 (define (copy-directory source destination)
183 (for-each (lambda (file)
184 (format #t "copying ~s...~%" file)
186 (string-append destination "/"
188 (directory-contents source)))
190 (let* ((out (assoc-ref %outputs "out"))
191 (bin (string-append out "/bin")))
194 ;; Copy Coreutils binaries.
195 (let* ((coreutils (assoc-ref %build-inputs "coreutils"))
196 (source (string-append coreutils "/bin")))
197 (copy-directory source bin))
199 ;; For the other inputs, copy just one binary, which has the
200 ;; same name as the input.
201 (for-each (match-lambda
203 (let ((source (string-append dir "/bin/" name)))
204 (format #t "copying ~s...~%" source)
206 (string-append bin "/" name)))))
207 (alist-delete "coreutils" %build-inputs))
209 ;; But of course, there are exceptions to this rule.
210 (let ((grep (assoc-ref %build-inputs "grep")))
211 (copy-file (string-append grep "/bin/fgrep")
212 (string-append bin "/fgrep"))
213 (copy-file (string-append grep "/bin/egrep")
214 (string-append bin "/egrep")))
216 ;; Clear references to the store path.
217 (for-each remove-store-references
218 (directory-contents bin))
220 (with-directory-excursion bin
221 ;; Programs such as Perl's build system want these aliases.
222 (symlink "bash" "sh")
223 (symlink "gawk" "awk"))
226 (synopsis "Statically-linked bootstrap binaries")
228 "Binaries used to bootstrap the distribution.")
232 (define %binutils-static
233 ;; Statically-linked Binutils.
234 (package (inherit binutils)
235 (name "binutils-static")
237 `(#:configure-flags '("--disable-gold" "--with-lib-path=/no-ld-lib-path")
238 #:strip-flags '("--strip-all")
239 #:phases (alist-cons-before
240 'configure 'all-static
242 ;; The `-all-static' libtool flag can only be passed
243 ;; after `configure', since configure tests don't use
244 ;; libtool, and only for executables built with libtool.
245 (substitute* '("binutils/Makefile.in"
248 (("^LDFLAGS =(.*)$" line)
250 "\nAM_LDFLAGS = -static -all-static\n"))))
251 %standard-phases)))))
253 (define %binutils-static-stripped
254 ;; The subset of Binutils that we need.
255 (package (inherit %binutils-static)
256 (build-system trivial-build-system)
258 `(#:modules ((guix build utils))
261 (use-modules (guix build utils))
263 (setvbuf (current-output-port) _IOLBF)
264 (let* ((in (assoc-ref %build-inputs "binutils"))
265 (out (assoc-ref %outputs "out"))
266 (bin (string-append out "/bin")))
268 (for-each (lambda (file)
269 (let ((target (string-append bin "/" file)))
270 (format #t "copying `~a'...~%" file)
271 (copy-file (string-append in "/bin/" file)
273 (remove-store-references target)))
274 '("ar" "as" "ld" "nm" "objcopy" "objdump"
275 "ranlib" "readelf" "size" "strings" "strip"))
277 (inputs `(("binutils" ,%binutils-static)))))
279 (define %glibc-stripped
280 ;; GNU libc's essential shared libraries, dynamic linker, and headers,
281 ;; with all references to store directories stripped. As a result,
282 ;; libc.so is unusable and need to be patched for proper relocation.
283 (let ((glibc %glibc-for-bootstrap))
284 (package (inherit glibc)
285 (name "glibc-stripped")
286 (build-system trivial-build-system)
288 `(#:modules ((guix build utils))
291 (use-modules (guix build utils))
293 (setvbuf (current-output-port) _IOLBF)
294 (let* ((out (assoc-ref %outputs "out"))
295 (libdir (string-append out "/lib"))
296 (incdir (string-append out "/include"))
297 (libc (assoc-ref %build-inputs "libc"))
298 (linux (assoc-ref %build-inputs "linux-headers")))
300 (for-each (lambda (file)
301 (let ((target (string-append libdir "/"
303 (copy-file file target)
304 (remove-store-references target)))
305 (find-files (string-append libc "/lib")
306 "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
308 (copy-recursively (string-append libc "/include") incdir)
310 ;; Copy some of the Linux-Libre headers that glibc headers
312 (mkdir (string-append incdir "/linux"))
313 (for-each (lambda (file)
314 (copy-file (string-append linux "/include/linux/" file)
315 (string-append incdir "/linux/"
317 '("limits.h" "errno.h" "socket.h" "kernel.h"
318 "sysctl.h" "param.h" "ioctl.h" "types.h"
319 "posix_types.h" "stddef.h"))
321 (copy-recursively (string-append linux "/include/asm")
322 (string-append incdir "/asm"))
323 (copy-recursively (string-append linux "/include/asm-generic")
324 (string-append incdir "/asm-generic"))
326 (inputs `(("libc" ,glibc)
327 ("linux-headers" ,linux-libre-headers))))))
330 ;; A statically-linked GCC, with stripped-down functionality.
331 (package-with-explicit-inputs
332 (package (inherit gcc-final)
336 `(#:modules ((guix build utils)
337 (guix build gnu-build-system)
341 ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
343 ((#:implicit-inputs? _) #t)
344 ((#:configure-flags flags)
348 "--enable-languages=c"
349 "--disable-libmudflap"
352 "--disable-libquadmath"
353 "--disable-decimal-float")
354 (remove (cut string-match "--(.*plugin|enable-languages)" <>)
356 ((#:make-flags flags)
357 `(cons "BOOT_LDFLAGS=-static" ,flags))))))
358 (inputs `(("gmp-source" ,(package-source gmp))
359 ("mpfr-source" ,(package-source mpfr))
360 ("mpc-source" ,(package-source mpc))
361 ("binutils" ,binutils-final)
362 ,@(package-inputs gcc-4.7))))
363 %standard-inputs-with-relocatable-glibc))
365 (define %gcc-stripped
366 ;; The subset of GCC files needed for bootstrap.
367 (package (inherit gcc-4.7)
368 (name "gcc-stripped")
369 (build-system trivial-build-system)
372 `(#:modules ((guix build utils))
375 (use-modules (srfi srfi-1)
379 (setvbuf (current-output-port) _IOLBF)
380 (let* ((out (assoc-ref %outputs "out"))
381 (bindir (string-append out "/bin"))
382 (libdir (string-append out "/lib"))
383 (libexecdir (string-append out "/libexec"))
384 (gcc (assoc-ref %build-inputs "gcc")))
385 (copy-recursively (string-append gcc "/bin") bindir)
386 (for-each remove-store-references
387 (find-files bindir ".*"))
389 (copy-recursively (string-append gcc "/lib") libdir)
390 (for-each remove-store-references
391 (remove (cut string-suffix? ".h" <>)
392 (find-files libdir ".*")))
394 (copy-recursively (string-append gcc "/libexec")
396 (for-each remove-store-references
397 (find-files libexecdir ".*"))
399 (inputs `(("gcc" ,%gcc-static)))))
401 (define %guile-static
402 ;; A statically-linked Guile that is relocatable--i.e., it can search
403 ;; .scm and .go files relative to its installation directory, rather
404 ;; than in hard-coded configure-time paths.
405 (let ((guile (package (inherit guile-2.0)
407 `(("patch/relocatable"
408 ,(search-patch "guile-relocatable.patch"))
410 ,(search-patch "guile-default-utf8.patch"))
411 ,@(package-inputs guile-2.0)))
413 `(;; When `configure' checks for ltdl availability, it
414 ;; doesn't try to link using libtool, and thus fails
415 ;; because of a missing -ldl. Work around that.
416 #:configure-flags '("LDFLAGS=-ldl")
418 #:phases (alist-cons-before
419 'configure 'static-guile
421 (substitute* "libguile/Makefile.in"
422 ;; Create a statically-linked `guile'
424 (("^guile_LDFLAGS =")
425 "guile_LDFLAGS = -all-static")
427 ;; Add `-ldl' *after* libguile-2.0.la.
428 (("^guile_LDADD =(.*)$" _ ldadd)
429 (string-append "guile_LDADD = "
430 (string-trim-right ldadd)
434 ;; Allow Guile to be relocated, as is needed during
437 (list (assoc-ref %build-inputs "patch/relocatable")
438 (assoc-ref %build-inputs "patch/utf8"))
440 ;; There are uses of `dynamic-link' in
441 ;; {foreign,coverage}.test that don't fly here.
443 (package-with-explicit-inputs (static-package guile)
444 %standard-inputs-with-relocatable-glibc
445 (current-source-location))))
447 (define %guile-static-stripped
448 ;; A stripped static Guile binary, for use during bootstrap.
449 (package (inherit %guile-static)
450 (name "guile-static-stripped")
451 (build-system trivial-build-system)
453 `(#:modules ((guix build utils))
456 (use-modules (guix build utils))
458 (let ((in (assoc-ref %build-inputs "guile"))
459 (out (assoc-ref %outputs "out")))
460 (mkdir-p (string-append out "/share/guile/2.0"))
461 (copy-recursively (string-append in "/share/guile/2.0")
462 (string-append out "/share/guile/2.0"))
464 (mkdir-p (string-append out "/lib/guile/2.0/ccache"))
465 (copy-recursively (string-append in "/lib/guile/2.0/ccache")
466 (string-append out "/lib/guile/2.0/ccache"))
468 (mkdir (string-append out "/bin"))
469 (copy-file (string-append in "/bin/guile")
470 (string-append out "/bin/guile"))
471 (remove-store-references (string-append out "/bin/guile"))
473 (inputs `(("guile" ,%guile-static)))))
475 (define (tarball-package pkg)
476 "Return a package containing a tarball of PKG."
477 (package (inherit pkg)
478 (location (source-properties->location (current-source-location)))
479 (name (string-append (package-name pkg) "-tarball"))
480 (build-system trivial-build-system)
481 (inputs `(("tar" ,tar)
486 (let ((name (package-name pkg))
487 (version (package-version pkg)))
488 `(#:modules ((guix build utils))
491 (use-modules (guix build utils))
492 (let ((out (assoc-ref %outputs "out"))
493 (input (assoc-ref %build-inputs "input"))
494 (tar (assoc-ref %build-inputs "tar"))
495 (xz (assoc-ref %build-inputs "xz")))
497 (set-path-environment-variable "PATH" '("bin") (list tar xz))
498 (with-directory-excursion input
499 (zero? (system* "tar" "cJvf"
500 (string-append out "/"
502 "-" ,system ".tar.xz")
505 (define %bootstrap-binaries-tarball
506 ;; A tarball with the statically-linked bootstrap binaries.
507 (tarball-package %static-binaries))
509 (define %binutils-bootstrap-tarball
510 ;; A tarball with the statically-linked Binutils programs.
511 (tarball-package %binutils-static-stripped))
513 (define %glibc-bootstrap-tarball
514 ;; A tarball with GNU libc's shared libraries, dynamic linker, and headers.
515 (tarball-package %glibc-stripped))
517 (define %gcc-bootstrap-tarball
518 ;; A tarball with a dynamic-linked GCC and its headers.
519 (tarball-package %gcc-stripped))
521 (define %guile-bootstrap-tarball
522 ;; A tarball with the statically-linked, relocatable Guile.
523 (tarball-package %guile-static-stripped))
525 (define %bootstrap-tarballs
526 ;; A single derivation containing all the bootstrap tarballs, for
529 (name "bootstrap-tarballs")
532 (build-system trivial-build-system)
534 `(#:modules ((guix build utils))
536 (let ((out (assoc-ref %outputs "out")))
537 (use-modules (guix build utils)
541 (setvbuf (current-output-port) _IOLBF)
544 (for-each (match-lambda
546 (for-each (lambda (file)
547 (format #t "~a -> ~a~%" file out)
548 (symlink file (basename file)))
549 (find-files directory "\\.tar\\."))))
552 (inputs `(("guile-tarball" ,%guile-bootstrap-tarball)
553 ("gcc-tarball" ,%gcc-bootstrap-tarball)
554 ("binutils-tarball" ,%binutils-bootstrap-tarball)
555 ("glibc-tarball" ,%glibc-bootstrap-tarball)
556 ("coreutils&co-tarball" ,%bootstrap-binaries-tarball)))
562 ;;; make-bootstrap.scm ends here