distro: First stab at building statically-linked bootstrap binaries.

* distro/packages/base.scm (static-package): New procedure.
  (%bash-static, %static-inputs, %static-binaries): New variables.
This commit is contained in:
Ludovic Courtès 2012-10-11 00:03:31 +02:00
parent ad8526466c
commit a3f75312ec

View file

@ -1815,4 +1815,172 @@ (define-public %final-inputs
("gcc" ,gcc-final) ("gcc" ,gcc-final)
("libc" ,glibc-final)))) ("libc" ,glibc-final))))
;;;
;;; Bootstrap binaries.
;;;
;;; These are the binaries that are taken for granted and used as the
;;; root of the whole bootstrap procedure.
;;;
(define* (static-package p #:optional (loc (current-source-location)))
"Return a statically-linked version of package P."
;; TODO: Move to (guix build-system gnu).
(let ((args (package-arguments p)))
(package (inherit p)
(location (source-properties->location loc))
(arguments
(let ((augment (lambda (args)
(let ((a (default-keyword-arguments args
'(#:configure-flags '()
#:strip-flags #f))))
(substitute-keyword-arguments a
((#:configure-flags flags)
`(cons* "--disable-shared"
"LDFLAGS=-static"
,flags))
((#:strip-flags _)
''("--strip-all")))))))
(if (procedure? args)
(lambda x
(augment (apply args x)))
(augment args)))))))
(define %bash-static
(let ((bash-light (package (inherit bash-final)
(inputs '()) ; no readline, no curses
(arguments
(let ((args `(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1)
(srfi srfi-26))
,@(package-arguments bash))))
(substitute-keyword-arguments args
((#:configure-flags flags)
`(list "--without-bash-malloc"
"--disable-readline"
"--disable-history"
"--disable-help-builtin"
"--disable-progcomp"
"--disable-net-redirections"
"--disable-nls"))))))))
(static-package bash-light)))
(define %static-inputs
;; Packages that are to be used as %BOOTSTRAP-INPUTS.
(let ((coreutils (package (inherit coreutils)
(arguments
`(#:configure-flags
'("--disable-nls"
"--disable-silent-rules"
"--enable-no-install-program=stdbuf,libstdbuf.so"
"LDFLAGS=-static -pthread")
,@(package-arguments coreutils)))))
(bzip2 (package (inherit bzip2)
(arguments
(substitute-keyword-arguments (package-arguments bzip2)
((#:phases phases)
`(alist-cons-before
'build 'dash-static
(lambda _
(substitute* "Makefile"
(("^LDFLAGS[[:blank:]]*=.*$")
"LDFLAGS = -static")))
,phases))))))
(xz (package (inherit xz)
(arguments
`(#:strip-flags '("--strip-all")
#:phases (alist-cons-before
'configure 'static-executable
(lambda _
;; Ask Libtool for a static executable.
(substitute* "src/xz/Makefile.in"
(("^xz_LDADD =")
"xz_LDADD = -all-static")))
%standard-phases)))))
(gawk (package (inherit gawk)
(arguments
(lambda (system)
`(#:phases (alist-cons-before
'build 'no-export-dynamic
(lambda* (#:key outputs #:allow-other-keys)
;; Since we use `-static', remove
;; `-export-dynamic'.
(substitute* "configure"
(("-export-dynamic") "")))
%standard-phases)
,@((package-arguments gawk) system)))))))
`(,@(map (match-lambda
((name package)
(list name (static-package package (current-source-location)))))
`(("tar" ,tar)
("gzip" ,gzip)
("bzip2" ,bzip2)
("xz" ,xz)
("patch" ,patch)
("coreutils" ,coreutils)
("sed" ,sed)
("grep" ,grep)
("gawk" ,gawk)))
("bash" ,%bash-static)
;; ("ld-wrapper" ,ld-wrapper)
;; ("binutils" ,binutils-final)
;; ("gcc" ,gcc-final)
;; ("libc" ,glibc-final)
)))
(define %static-binaries
(package
(name "static-binaries")
(version "0")
(build-system trivial-build-system)
(source #f)
(inputs %static-inputs)
(arguments
`(#:builder
(begin
(use-modules (ice-9 ftw)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-26))
(let ()
(define (directory-contents dir)
(map (cut string-append dir "/" <>)
(scandir dir (negate (cut member <> '("." ".."))))))
(define (copy-directory source destination)
(for-each (lambda (file)
(format #t "copying ~s...~%" file)
(copy-file file
(string-append destination "/"
(basename file))))
(directory-contents source)))
(let* ((out (assoc-ref %outputs "out"))
(bin (string-append out "/bin")))
(mkdir out) (mkdir bin)
;; Copy Coreutils binaries.
(let* ((coreutils (assoc-ref %build-inputs "coreutils"))
(source (string-append coreutils "/bin")))
(copy-directory source bin))
;; For the other inputs, copy just one binary, which has the
;; same name as the input.
(for-each (match-lambda
((name . dir)
(let ((source (string-append dir "/bin/" name)))
(format #t "copying ~s...~%" source)
(copy-file source
(string-append bin "/" name)))))
(alist-delete "coreutils" %build-inputs))
#t)))))
(description "Statically-linked bootstrap binaries")
(long-description
"Binaries used to bootstrap the distribution.")
(license #f)
(home-page #f)))
;;; base.scm ends here ;;; base.scm ends here