diff options
-rw-r--r-- | distro/packages/base.scm | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/distro/packages/base.scm b/distro/packages/base.scm index 88fa1bb27c..f2a93f8601 100644 --- a/distro/packages/base.scm +++ b/distro/packages/base.scm @@ -1815,4 +1815,172 @@ store.") ("gcc" ,gcc-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 |