diff --git a/HACKING b/HACKING
index 3ff60406234e73fd1bd30b2fde28c741d7c894f1..79697a141c0ff11adfb5ae1671c3635a509effdc 100644
--- a/HACKING
+++ b/HACKING
@@ -2,7 +2,7 @@
#+TITLE: Hacking GNU Guix and its incredible distro
-Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
@@ -106,26 +106,10 @@ GCC, libc, etc. need to be built. To that end, run the following
commands:
#+BEGIN_SRC sh
- ./pre-inst-env guix-build \
- -e '(@@ (distro packages base) %guile-bootstrap-tarball)' \
+ ./pre-inst-env guix-build \
+ -e '(@ (distro packages make-bootstrap) bootstrap-tarballs)' \
--system=i686-linux
-
- ./pre-inst-env guix-build \
- -e '(@@ (distro packages base) %bootstrap-binaries-tarball)' \
- --system=i686-linux
-
- ./pre-inst-env guix-build \
- -e '(@@ (distro packages base) %binutils-bootstrap-tarball)' \
- --system=i686-linux
-
- ./pre-inst-env guix-build \
- -e '(@@ (distro packages base) %glibc-bootstrap-tarball)' \
- --system=i686-linux
-
- ./pre-inst-env guix-build \
- -e '(@@ (distro packages base) %gcc-bootstrap-tarball)' \
- --system=i686-linux
-
+
#+END_SRC
These should build tarballs containing statically-linked tools usable on
@@ -135,12 +119,11 @@ In the source tree, you need to install binaries for ‘mkdir’, ‘bash’,
‘tar’, and ‘xz’ under ‘distro/packages/bootstrap/i686-linux’. These
binaries can be extracted from the static-binaries tarball built above.
-A rule for
-‘distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz’
+A rule for ‘distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz’
needs to be added in ‘Makefile.am’, with the appropriate hexadecimal
vrepresentation of its SHA256 hash.
-You may then revert your changes to ‘base.scm’. For the variables
+You may then revert your changes to ‘bootstrap.scm’. For the variables
‘%bootstrap-coreutils&co’, ‘%bootstrap-binutils’, ‘%bootstrap-glibc’,
and ‘%bootstrap-gcc’, the expected SHA256 of the corresponding tarballs
for ‘i686-linux’ (built above) must be added.
diff --git a/Makefile.am b/Makefile.am
index 57452374543ff50bb60cff7ff8333d95af0d7860..487ac05ec4533cb27666ed50011345b7847431be 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -90,6 +90,7 @@ MODULES = \
distro/packages/nano.scm \
distro/packages/ncurses.scm \
distro/packages/nettle.scm \
+ distro/packages/openssl.scm \
distro/packages/perl.scm \
distro/packages/pkg-config.scm \
distro/packages/pth.scm \
@@ -116,7 +117,9 @@ dist_patch_DATA = \
distro/packages/patches/cpio-gets-undeclared.patch \
distro/packages/patches/diffutils-gets-undeclared.patch \
distro/packages/patches/flex-bison-tests.patch \
+ distro/packages/patches/gawk-shell.patch \
distro/packages/patches/gettext-gets-undeclared.patch \
+ distro/packages/patches/glibc-bootstrap-system.patch \
distro/packages/patches/glibc-no-ld-so-cache.patch \
distro/packages/patches/guile-1.8-cpp-4.5.patch \
distro/packages/patches/guile-default-utf8.patch \
@@ -154,9 +157,9 @@ dist_bootstrap_i686_linux_DATA = \
# Big bootstrap binaries are not included in the tarball. Instead, they
# are downloaded.
nodist_bootstrap_x86_64_linux_DATA = \
- distro/packages/bootstrap/x86_64-linux/guile-bootstrap-2.0.6.tar.xz
+ distro/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz
nodist_bootstrap_i686_linux_DATA = \
- distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz
+ distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz
# Those files must remain executable, so they remain executable once
# imported into the store.
@@ -173,12 +176,12 @@ DOWNLOAD_FILE = \
$(GUILE) --no-auto-compile -L "$(top_builddir)" -L "$(top_srcdir)" \
"$(top_srcdir)/build-aux/download.scm"
-distro/packages/bootstrap/x86_64-linux/guile-bootstrap-2.0.6.tar.xz:
+distro/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz:
$(MKDIR_P) `dirname "$@"`
- $(DOWNLOAD_FILE) "$@" "0467a82cbe4136f60a79eb4176011bf88cf28ea19c9ad9defa365811ff8e11cf"
-distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz:
+ $(DOWNLOAD_FILE) "$@" "bc43210dcd146d242bef4d354b0aeac12c4ef3118c07502d17ffa8d49e15aa2c"
+distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz:
$(MKDIR_P) `dirname "$@"`
- $(DOWNLOAD_FILE) "$@" "93b537766dfab3ad287143523751e3ec02dd32d3ccaf88ad2d31c63158f342ee"
+ $(DOWNLOAD_FILE) "$@" "f9a7c6f4c556eaafa2a69bcf07d4ffbb6682ea831d4c9da9ba095aca3ccd217c"
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
diff --git a/build-aux/download.scm b/build-aux/download.scm
index 1d5f22cf18ff1253ca3a0a4fc5a1b365b6dee6a4..97a74b123ade8d02eefe576756443641960495ed 100644
--- a/build-aux/download.scm
+++ b/build-aux/download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,7 +35,7 @@ (define (file-name->uri file)
(match (string-tokenize file (char-set-complement (char-set #\/)))
((_ ... system basename)
(string->uri (string-append %url-base "/" system
- "/20121115/" basename)))))
+ "/20130105/" basename)))))
(match (command-line)
((_ file expected-hash)
diff --git a/distro/packages/acl.scm b/distro/packages/acl.scm
index 4f425be253144cae3d3d8d442a9c8201d66bee12..068789b5620d19a0c51de16aff18f13259d96512 100644
--- a/distro/packages/acl.scm
+++ b/distro/packages/acl.scm
@@ -41,15 +41,19 @@ (define-public acl
(build-system gnu-build-system)
(arguments
`(#:phases
- (alist-replace 'check
- (lambda _
- (patch-shebang "test/run")
- (system* "make" "tests" "-C" "test")
+ (alist-cons-after
+ 'configure 'patch-makefile-SHELL
+ (lambda _
+ (patch-makefile-SHELL "include/buildmacros"))
+ (alist-replace
+ 'check
+ (lambda _
+ (system* "make" "tests" "-C" "test")
- ;; XXX: Ignore the test result since this is
- ;; dependent on the underlying file system.
- #t)
- %standard-phases)))
+ ;; XXX: Ignore the test result since this is
+ ;; dependent on the underlying file system.
+ #t)
+ %standard-phases))))
(inputs `(("attr" ,attr)
("gettext" ,guix:gettext)
("perl" ,perl)))
diff --git a/distro/packages/attr.scm b/distro/packages/attr.scm
index 8326754261ba1ac352cf1306521d2c0f79eb6031..ae0d257dbe98401879bc1940fe20c7b07ee1e179 100644
--- a/distro/packages/attr.scm
+++ b/distro/packages/attr.scm
@@ -41,23 +41,31 @@ (define-public attr
(build-system gnu-build-system)
(arguments
`(#:phases
- (alist-replace 'install
- (lambda _
- (zero? (system* "make"
- "install"
- "install-lib"
- "install-dev")))
- (alist-replace 'check
- (lambda _
- (for-each patch-shebang
- (find-files "test" ".*"))
- (system* "make" "tests" "-C" "test")
+ (alist-cons-after
+ 'configure 'patch-makefile-SHELL
+ (lambda _
+ (patch-makefile-SHELL "include/buildmacros"))
+ (alist-replace
+ 'install
+ (lambda _
+ (zero? (system* "make"
+ "install"
+ "install-lib"
+ "install-dev")))
+ (alist-replace
+ 'check
+ (lambda _
+ ;; Use the right shell.
+ (substitute* "test/run"
+ (("/bin/sh")
+ (which "bash")))
- ;; XXX: Ignore the test result since
- ;; this is dependent on the underlying
- ;; file system.
- #t)
- %standard-phases))))
+ (system* "make" "tests" "-C" "test")
+
+ ;; XXX: Ignore the test result since this is dependent on the
+ ;; underlying file system.
+ #t)
+ %standard-phases)))))
(inputs `(("perl" ,perl)
("gettext" ,guix:gettext)))
(home-page
diff --git a/distro/packages/autotools.scm b/distro/packages/autotools.scm
index a472ce13ddea48f93db2dd6de8d4f568dc9cddc5..06568b2224dd66fb9ecdea888e9d0931aa6189bc 100644
--- a/distro/packages/autotools.scm
+++ b/distro/packages/autotools.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -99,9 +99,37 @@ (define-public libtool
(build-system gnu-build-system)
(native-inputs `(("m4" ,m4)
("perl" ,perl)))
+
+ ;; Separate binaries from the rest. During bootstrap, only ltdl is
+ ;; used; not depending on the binaries allows us to avoid retaining
+ ;; a reference to the bootstrap bash.
+ (outputs '("bin" ; libtoolize, libtool, etc.
+ "out")) ; libltdl.so, ltdl.h, etc.
+
(arguments
- ;; TODO: Use `TESTSUITEFLAGS=-jN' for tests.
- `(#:patches (list (assoc-ref %build-inputs "patch/skip-tests"))))
+ `(#:patches (list (assoc-ref %build-inputs "patch/skip-tests"))
+ #:phases (alist-cons-before
+ 'check 'pre-check
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Run the test suite in parallel, if possible.
+ (let ((ncores
+ (cond
+ ((getenv "NIX_BUILD_CORES")
+ =>
+ (lambda (n)
+ (if (zero? (string->number n))
+ (number->string (current-processor-count))
+ n)))
+ (else "1"))))
+ (setenv "TESTSUITEFLAGS"
+ (string-append "-j" ncores)))
+
+ ;; Path references to /bin/sh.
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* "tests/testsuite"
+ (("/bin/sh")
+ (string-append bash "/bin/bash")))))
+ %standard-phases)))
(inputs `(("patch/skip-tests"
,(search-patch "libtool-skip-tests.patch"))))
(synopsis "GNU Libtool, a generic library support script")
diff --git a/distro/packages/base.scm b/distro/packages/base.scm
index 0f60e983bcf659cec6a5e34f9b4ab309c5d8245f..bc705f16e78a1fa8ac5dffaab9f001f9e6cab569 100644
--- a/distro/packages/base.scm
+++ b/distro/packages/base.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
@@ -20,6 +20,7 @@
(define-module (distro packages base)
#:use-module (guix licenses)
#:use-module (distro)
+ #:use-module (distro packages acl)
#:use-module (distro packages bash)
#:use-module (distro packages bootstrap)
#:use-module (distro packages compression)
@@ -97,6 +98,17 @@ (define-public sed
"13wlsb4sf5d5a82xjhxqmdvrrn36rmw5f0pl9qyb9zkvldnb7hra"))))
(build-system gnu-build-system)
(synopsis "GNU sed, a batch stream editor")
+ (arguments
+ `(#:phases (alist-cons-before
+ 'patch-source-shebangs 'patch-test-suite
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((bash (assoc-ref inputs "bash")))
+ (patch-makefile-SHELL "testsuite/Makefile.tests")
+ (substitute* '("testsuite/bsd.sh"
+ "testsuite/bug-regex9.c")
+ (("/bin/sh")
+ (string-append bash "/bin/bash")))))
+ %standard-phases)))
(description
"Sed (stream editor) isn't really a true text editor or text processor.
Instead, it is used to filter text, i.e., it takes text input and performs
@@ -252,19 +264,33 @@ (define-public findutils
(define-public coreutils
(package
(name "coreutils")
- (version "8.19")
+ (version "8.20")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/coreutils/coreutils-"
version ".tar.xz"))
(sha256
(base32
- "1rx9x3fp848w4nny7irdkcpkan9fcx24d99v5dkwgkyq7wc76f5d"))))
+ "1cly97xdy3v4nbbx631k43smqw0nnpn651kkprs0yyl2cj3pkjyv"))))
(build-system gnu-build-system)
- (inputs `()) ; TODO: optional deps: SELinux, ACL, GMP
+ (inputs `(("acl" ,acl)
+ ("gmp" ,gmp)
+ ("perl" ,perl))) ; TODO: add SELinux
(arguments
- '(;; Perl is missing, and some tests are failing.
- #:tests? #f))
+ `(#:parallel-build? #f ; help2man may be called too early
+ #:phases (alist-cons-before
+ 'build 'patch-shell-references
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* (cons "src/split.c"
+ (find-files "gnulib-tests"
+ "\\.c$"))
+ (("/bin/sh")
+ (format #f "~a/bin/sh" bash)))
+ (substitute* (find-files "tests" "\\.sh$")
+ (("#!/bin/sh")
+ (format #f "#!~a/bin/bash" bash)))))
+ %standard-phases)))
(synopsis
"The basic file, shell and text manipulation utilities of the GNU
operating system")
@@ -289,8 +315,18 @@ (define-public gnu-make
(build-system gnu-build-system)
(native-inputs
`(("patch/impure-dirs" ,(search-patch "make-impure-dirs.patch"))))
- (arguments `(#:patches (list (assoc-ref %build-inputs
- "patch/impure-dirs"))))
+ (arguments
+ '(#:patches (list (assoc-ref %build-inputs "patch/impure-dirs"))
+ #:phases (alist-cons-before
+ 'build 'set-default-shell
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Change the default shell from /bin/sh.
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* "job.c"
+ (("default_shell\\[\\] =.*$")
+ (format #f "default_shell[] = \"~a/bin/bash\";\n"
+ bash)))))
+ %standard-phases)))
(synopsis "GNU Make, a program controlling the generation of non-source
files from sources")
(description
@@ -317,6 +353,11 @@ (define-public binutils
"1a9w66v5dwvbnawshjwqcgz7km6kw6ihkzp6sswv9ycc3knzhykc"))))
(build-system gnu-build-system)
+ ;; Split Binutils in several outputs, mostly to avoid collisions in
+ ;; user profiles with GCC---e.g., libiberty.a.
+ (outputs '("out" ; ar, ld, binutils.info, etc.
+ "lib")) ; libbfd.a, bfd.h, etc.
+
;; TODO: Add dependency on zlib + those for Gold.
(native-inputs
`(("patch/new-dtags" ,(search-patch "binutils-ld-new-dtags.patch"))))
@@ -455,14 +496,14 @@ (define-public gcc-4.7
(define-public glibc
(package
(name "glibc")
- (version "2.16.0")
+ (version "2.17")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz"))
(sha256
(base32
- "092rdm49zh6l1pqkxbcpcaawgsgzxhpf1s7wf5wi5dvc5am3dp0y"))))
+ "0gmjnn4kma9vgizccw1jv979xw55a8n1nkk94gg0l3hy80vy6539"))))
(build-system gnu-build-system)
;; Glibc's <limits.h> refers to <linux/limit.h>, for instance, so glibc
@@ -485,13 +526,20 @@ (define-public glibc
;; GNU libc for details.
"--enable-kernel=2.6.30"
+ ;; Use our Bash instead of /bin/sh.
+ (string-append "BASH_SHELL="
+ (assoc-ref %build-inputs "bash")
+ "/bin/bash")
+
;; XXX: Work around "undefined reference to `__stack_chk_guard'".
"libc_cv_ssp=no")
+
#:tests? #f ; XXX
#:phases (alist-cons-before
'configure 'pre-configure
- (lambda* (#:key outputs #:allow-other-keys)
- (let ((out (assoc-ref outputs "out")))
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin")))
;; Use `pwd', not `/bin/pwd'.
(substitute* "configure"
(("/bin/pwd") "pwd"))
@@ -509,10 +557,35 @@ (define-public glibc
;; <http://www.linuxfromscratch.org/lfs/view/stable/chapter05/glibc.html>,
;; linking against libgcc_s is not needed with GCC
;; 4.7.1.
- ((" -lgcc_s") ""))))
+ ((" -lgcc_s") ""))
+
+ ;; Copy a statically-linked Bash in the output, with
+ ;; no references to other store paths.
+ (mkdir-p bin)
+ (copy-file (string-append (assoc-ref inputs "static-bash")
+ "/bin/bash")
+ (string-append bin "/bash"))
+ (remove-store-references (string-append bin "/bash"))
+ (chmod (string-append bin "/bash") #o555)
+
+ ;; Keep a symlink, for `patch-shebang' resolution.
+ (with-directory-excursion bin
+ (symlink "bash" "sh"))
+
+ ;; Have `system' use that Bash.
+ (substitute* "sysdeps/posix/system.c"
+ (("#define[[:blank:]]+SHELL_PATH.*$")
+ (format #f "#define SHELL_PATH \"~a/bin/bash\"\n"
+ out)))
+
+ ;; Same for `popen'.
+ (substitute* "libio/iopopen.c"
+ (("/bin/sh")
+ (string-append out "/bin/bash")))))
%standard-phases)))
(inputs `(("patch/ld.so.cache"
- ,(search-patch "glibc-no-ld-so-cache.patch"))))
+ ,(search-patch "glibc-no-ld-so-cache.patch"))
+ ("static-bash" ,(static-package bash-light))))
(synopsis "The GNU C Library")
(description
"Any Unix-like operating system needs a C library: the library which
@@ -534,21 +607,23 @@ (define gnu-make-boot0
(package (inherit gnu-make)
(name "make-boot0")
(location (source-properties->location (current-source-location)))
- (arguments `(#:guile ,%bootstrap-guile
- #:implicit-inputs? #f
- #:tests? #f ; cannot run "make check"
- #:phases
- (alist-replace
- 'build (lambda _
- (zero? (system* "./build.sh")))
- (alist-replace
- 'install (lambda* (#:key outputs #:allow-other-keys)
- (let* ((out (assoc-ref outputs "out"))
- (bin (string-append out "/bin")))
- (mkdir-p bin)
- (copy-file "make"
- (string-append bin "/make"))))
- %standard-phases))))
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:implicit-inputs? #f
+ #:tests? #f ; cannot run "make check"
+ ,@(substitute-keyword-arguments (package-arguments gnu-make)
+ ((#:phases phases)
+ `(alist-replace
+ 'build (lambda _
+ (zero? (system* "./build.sh")))
+ (alist-replace
+ 'install (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin")))
+ (mkdir-p bin)
+ (copy-file "make"
+ (string-append bin "/make"))))
+ ,phases))))))
(inputs %bootstrap-inputs))))
(define diffutils-boot0
@@ -728,82 +803,125 @@ (define %boot1-inputs
;; cross-`as'.
,@%boot0-inputs))
-(define-public glibc-final
+(define glibc-final-with-bootstrap-bash
;; The final libc, "cross-built". If everything went well, the resulting
- ;; store path has no dependencies.
+ ;; store path has no dependencies. Actually, the really-final libc is
+ ;; built just below; the only difference is that this one uses the
+ ;; bootstrap Bash.
(package-with-bootstrap-guile
(package (inherit glibc)
+ (name "glibc-intermediate")
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
- ;; Leave /bin/sh as the interpreter for `ldd', `sotruss', etc. to
- ;; avoid keeping a reference to the bootstrap Bash.
- #:patch-shebangs? #f
,@(substitute-keyword-arguments (package-arguments glibc)
((#:configure-flags flags)
`(append (list ,(string-append "--host=" (boot-triplet system))
,(string-append "--build="
(nix-system->gnu-triplet system))
- "BASH_SHELL=/bin/sh"
;; Build Sun/ONC RPC support. In particular,
;; install rpc/*.h.
"--enable-obsolete-rpc")
,flags))))))
(propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0)))
- (inputs `( ;; A native GCC is needed to build `cross-rpcgen'.
- ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
- ,@%boot1-inputs
- ,@(package-inputs glibc)))))) ; patches
+ (inputs
+ `( ;; A native GCC is needed to build `cross-rpcgen'.
+ ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
-(define gcc-boot0-wrapped
- ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
- ;; non-cross names.
+ ;; Here, we use the bootstrap Bash, which is not satisfactory
+ ;; because we don't want to depend on bootstrap tools.
+ ("static-bash" ,@(assoc-ref %boot0-inputs "bash"))
+
+ ,@%boot1-inputs
+ ,@(alist-delete "static-bash"
+ (package-inputs glibc))))))) ; patches
+
+(define (cross-gcc-wrapper gcc binutils glibc bash)
+ "Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
+that makes it available under the native tool names."
(package (inherit gcc-4.7)
- (name (string-append (package-name gcc-boot0) "-wrapped"))
+ (name (string-append (package-name gcc) "-wrapped"))
(source #f)
(build-system trivial-build-system)
(arguments
(lambda (system)
- `(#:guile ,%bootstrap-guile
- #:modules ((guix build utils))
- #:builder (begin
- (use-modules (guix build utils))
-
- (let* ((binutils (assoc-ref %build-inputs "binutils"))
- (gcc (assoc-ref %build-inputs "gcc"))
- (libc (assoc-ref %build-inputs "libc"))
- (out (assoc-ref %outputs "out"))
- (bindir (string-append out "/bin"))
- (triplet ,(boot-triplet system)))
- (mkdir-p bindir)
- (with-directory-excursion bindir
- (for-each (lambda (tool)
- (symlink (string-append binutils "/bin/"
- triplet "-" tool)
- tool))
- '("ar" "ranlib"))
-
- ;; GCC-BOOT0 is a libc-less cross-compiler, so it
- ;; needs to be told where to find the crt files and
- ;; the dynamic linker.
- (call-with-output-file "gcc"
- (lambda (p)
- (format p "#!/bin/sh
+ `(#:guile ,%bootstrap-guile
+ #:modules ((guix build utils))
+ #:builder (begin
+ (use-modules (guix build utils))
+
+ (let* ((binutils (assoc-ref %build-inputs "binutils"))
+ (gcc (assoc-ref %build-inputs "gcc"))
+ (libc (assoc-ref %build-inputs "libc"))
+ (bash (assoc-ref %build-inputs "bash"))
+ (out (assoc-ref %outputs "out"))
+ (bindir (string-append out "/bin"))
+ (triplet ,(boot-triplet system)))
+ (mkdir-p bindir)
+ (with-directory-excursion bindir
+ (for-each (lambda (tool)
+ (symlink (string-append binutils "/bin/"
+ triplet "-" tool)
+ tool))
+ '("ar" "ranlib"))
+
+ ;; GCC-BOOT0 is a libc-less cross-compiler, so it
+ ;; needs to be told where to find the crt files and
+ ;; the dynamic linker.
+ (call-with-output-file "gcc"
+ (lambda (p)
+ (format p "#!~a/bin/bash
exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
- gcc triplet
- libc libc
- ,(glibc-dynamic-linker system))))
+ bash
+ gcc triplet
+ libc libc
+ ,(glibc-dynamic-linker system))))
- (chmod "gcc" #o555)))))))
+ (chmod "gcc" #o555)))))))
(native-inputs
- `(("binutils" ,binutils-boot0)
- ("gcc" ,gcc-boot0)
- ("libc" ,glibc-final)))
+ `(("binutils" ,binutils)
+ ("gcc" ,gcc)
+ ("libc" ,glibc)
+ ("bash" ,bash)))
(inputs '())))
+(define static-bash-for-glibc
+ ;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by
+ ;; system(3) & co.
+ (let* ((gcc (cross-gcc-wrapper gcc-boot0 binutils-boot0
+ glibc-final-with-bootstrap-bash
+ (car (assoc-ref %boot1-inputs "bash"))))
+ (bash (package (inherit bash-light)
+ (arguments
+ (lambda (system)
+ `(#:guile ,%bootstrap-guile
+ ,@(package-arguments bash-light)))))))
+ (package-with-bootstrap-guile
+ (package-with-explicit-inputs (static-package bash)
+ `(("gcc" ,gcc)
+ ("libc" ,glibc-final-with-bootstrap-bash)
+ ,@(fold alist-delete %boot1-inputs
+ '("gcc" "libc")))
+ (current-source-location)))))
+
+(define-public glibc-final
+ ;; The final glibc, which embeds the statically-linked Bash built above.
+ (package (inherit glibc-final-with-bootstrap-bash)
+ (name "glibc")
+ (inputs `(("static-bash" ,static-bash-for-glibc)
+ ,@(alist-delete
+ "static-bash"
+ (package-inputs glibc-final-with-bootstrap-bash))))))
+
+(define gcc-boot0-wrapped
+ ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
+ ;; non-cross names.
+ (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
+ (car (assoc-ref %boot1-inputs "bash"))))
+
(define %boot2-inputs
;; 3rd stage inputs.
`(("libc" ,glibc-final)
@@ -857,9 +975,10 @@ (define ld-wrapper-boot3
(source #f)
(build-system trivial-build-system)
(inputs `(("binutils" ,binutils-final)
- ("guile" ,%bootstrap-guile)
- ("wrapper" ,(search-path %load-path
- "distro/packages/ld-wrapper.scm"))))
+ ("guile" ,%bootstrap-guile)
+ ("bash" ,@(assoc-ref %boot2-inputs "bash"))
+ ("wrapper" ,(search-path %load-path
+ "distro/packages/ld-wrapper.scm"))))
(arguments
`(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
@@ -883,6 +1002,9 @@ (define ld-wrapper-boot3
(("@GUILE@")
(string-append (assoc-ref %build-inputs "guile")
"/bin/guile"))
+ (("@BASH@")
+ (string-append (assoc-ref %build-inputs "bash")
+ "/bin/bash"))
(("@LD@")
(string-append (assoc-ref %build-inputs "binutils")
"/bin/ld")))
@@ -917,9 +1039,6 @@ (define %boot4-inputs
,@(alist-delete "bash" %boot3-inputs)))
(define-public guile-final
- ;; FIXME: The Libtool used here, specifically its `bin/libtool' script,
- ;; holds a dependency on the bootstrap Binutils. Use multiple outputs for
- ;; Libtool, so that that dependency is isolated in the "bin" output.
(package-with-bootstrap-guile
(package-with-explicit-inputs guile-2.0/fixed
%boot4-inputs
@@ -931,7 +1050,9 @@ (define-public ld-wrapper
(package (inherit ld-wrapper-boot3)
(name "ld-wrapper")
(inputs `(("guile" ,guile-final)
- ,@(alist-delete "guile" (package-inputs ld-wrapper-boot3))))))
+ ("bash" ,bash-final)
+ ,@(fold alist-delete (package-inputs ld-wrapper-boot3)
+ '("guile" "bash"))))))
(define-public %final-inputs
;; Final derivations used as implicit inputs by `gnu-build-system'.
diff --git a/distro/packages/bash.scm b/distro/packages/bash.scm
index 32a72d23471482a0d6412e79621bfccc0fabd79a..0306c7197ef315bbbc1882c4f5edcef23e8dd4ab 100644
--- a/distro/packages/bash.scm
+++ b/distro/packages/bash.scm
@@ -32,7 +32,13 @@ (define-public bash
"-DSTANDARD_UTILS_PATH='\"/no-such-path\"'"
"-DNON_INTERACTIVE_LOGIN_SHELLS"
"-DSSH_SOURCE_BASHRC")
- " ")))
+ " "))
+ (post-install-phase
+ '(lambda* (#:key outputs #:allow-other-keys)
+ ;; Add a `bash' -> `sh' link.
+ (let ((out (assoc-ref outputs "out")))
+ (with-directory-excursion (string-append out "/bin")
+ (symlink "bash" "sh"))))))
(package
(name "bash")
(version "4.2")
@@ -67,15 +73,9 @@ (define-public bash
;; for now.
#:tests? #f
- #:phases
- (alist-cons-after 'install 'post-install
- (lambda* (#:key outputs #:allow-other-keys)
- ;; Add a `bash' -> `sh' link.
- (let ((out (assoc-ref outputs "out")))
- (with-directory-excursion
- (string-append out "/bin")
- (symlink "bash" "sh"))))
- %standard-phases)))
+ #:phases (alist-cons-after 'install 'post-install
+ ,post-install-phase
+ %standard-phases)))
(synopsis "GNU Bourne-Again Shell")
(description
"Bash is the shell, or command language interpreter, that will appear in
@@ -87,3 +87,24 @@ (define-public bash
modification.")
(license gpl3+)
(home-page "http://www.gnu.org/software/bash/"))))
+
+(define-public bash-light
+ ;; A stripped-down Bash for non-interactive use.
+ (package (inherit bash)
+ (name "bash-light")
+ (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")))))))
diff --git a/distro/packages/bdb.scm b/distro/packages/bdb.scm
index 6d6adc000cc0b32f8555af0b5633b66a9657e354..93bf2902311b14e51cbcab39e453b0900ae3e253 100644
--- a/distro/packages/bdb.scm
+++ b/distro/packages/bdb.scm
@@ -44,7 +44,9 @@ (define-public bdb
(let ((out (assoc-ref outputs "out")))
(zero?
(system* "./dist/configure"
- (string-append "--prefix=" out)))))
+ (string-append "--prefix=" out)
+ (string-append "CONFIG_SHELL=" (which "bash"))
+ (string-append "SHELL=" (which "bash"))))))
%standard-phases))))
(synopsis "db, the Berkeley database")
(description
diff --git a/distro/packages/bootstrap.scm b/distro/packages/bootstrap.scm
index 8d1d1e989d0ff3fd8e8cdae6840702b690446ec0..9bf815b2d75e047d5cb062f8a46cb0223ebaaa5e 100644
--- a/distro/packages/bootstrap.scm
+++ b/distro/packages/bootstrap.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -167,7 +167,7 @@ (define (->store file)
(xz (->store "xz"))
(mkdir (->store "mkdir"))
(bash (->store "bash"))
- (guile (->store "guile-bootstrap-2.0.6.tar.xz"))
+ (guile (->store "guile-2.0.7.tar.xz"))
(builder
(add-text-to-store store
"build-bootstrap-guile.sh"
@@ -205,15 +205,15 @@ (define %bootstrap-coreutils&co
(method url-fetch)
(uri (string-append
%bootstrap-base-url "/"
- system "/20121115/static-binaries.tar.xz"))
+ system "/20130105/static-binaries.tar.xz"))
(sha256
(match system
("x86_64-linux"
(base32
- "0azisn8l2b3cvgni9k0ahzsxs5cxrj0hmf38zgpq3k6pggk3zbfm"))
+ "0md23alzy6nc5f16pric7mkagczdzr8xbh074sb3rjzrls06j1ls"))
("i686-linux"
(base32
- "16v60frbh0naccanwxcxz0z3444dd8salbg8p7cp7vwz8245nhfk"))))))
+ "0nzj1lmm9b94g7k737cr4w1dv282w5nmhb53238ikax9r6pkc0yb"))))))
"true" ; the program to test
"Bootstrap binaries of Coreutils, Awk, etc."))
@@ -224,15 +224,15 @@ (define %bootstrap-binutils
(method url-fetch)
(uri (string-append
%bootstrap-base-url "/"
- system "/20121115/binutils-2.22.tar.xz"))
+ system "/20130105/binutils-2.22.tar.xz"))
(sha256
(match system
("x86_64-linux"
(base32
- "0ms6i035v40n7mhi91n4b8ivwv2qni3mcd5dj9sj9qmvgqb50r84"))
+ "1ffmk2yy2pxvkqgzrkzp3s4jpn4qaaksyk3b5nsc5cjwfm7qkgzh"))
("i686-linux"
(base32
- "193x62ach4l4x16rbzglrqa1d0a825z2as6czdiv9xjiizmcr0ad"))))))
+ "1rafk6aq4sayvv3r3d2khn93nkyzf002xzh0xadlyci4mznr6b0a"))))))
"ld" ; the program to test
"Bootstrap binaries of the GNU Binutils"))
@@ -277,15 +277,15 @@ (define %bootstrap-glibc
(origin
(method url-fetch)
(uri (string-append %bootstrap-base-url "/" system
- "/20121115/glibc-2.16.0.tar.xz"))
+ "/20130105/glibc-2.17.tar.xz"))
(sha256
(match system
("x86_64-linux"
(base32
- "1cz587p3scrrx0zgqnmp4nnfj0vvf01zdqdgkz445dnbfh64nl0v"))
+ "18kv1z9d8dr1j3hm9w7663kchqw9p6rsx11n1m143jgba2jz6jy3"))
("i686-linux"
(base32
- "0vzybz1577vflm0p0zg1slqj32carj5102b45k7iskkj46viy14z"))))))))))
+ "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88"))))))))))
(synopsis "Bootstrap binaries and headers of the GNU C Library")
(description #f)
(home-page #f)))
@@ -348,15 +348,15 @@ (define %bootstrap-gcc
(origin
(method url-fetch)
(uri (string-append %bootstrap-base-url "/" system
- "/20121115/gcc-4.7.2.tar.xz"))
+ "/20130105/gcc-4.7.2.tar.xz"))
(sha256
(match system
("x86_64-linux"
(base32
- "0fg65i2qcym8ls5ig3g1cc9ida5cxwwsd6zi95xi1d8dnfrja4zz"))
+ "1x1p7han5crnbw906iwdifykr6grzm0w27dy9gz75j0q1b32i4px"))
("i686-linux"
(base32
- "01hlz98qmc8yhqrxqajpg5kbkhpvqq6wjnbfvplys32n895avzxg"))))))))))
+ "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2"))))))))))
(synopsis "Bootstrap binaries of the GNU Compiler Collection")
(description #f)
(home-page #f)))
@@ -367,6 +367,9 @@ (define %bootstrap-inputs
`(("libc" ,%bootstrap-glibc)
("gcc" ,%bootstrap-gcc)
("binutils" ,%bootstrap-binutils)
- ("coreutils&co" ,%bootstrap-coreutils&co)))
+ ("coreutils&co" ,%bootstrap-coreutils&co)
+
+ ;; In gnu-build-system.scm, we rely on the availability of Bash.
+ ("bash" ,%bootstrap-coreutils&co)))
;;; bootstrap.scm ends here
diff --git a/distro/packages/compression.scm b/distro/packages/compression.scm
index 06bb4ffe862f37c0021e94196db81df8918e1a92..51a2d70e2d8e9944e020b48bc41e7a1547578b30 100644
--- a/distro/packages/compression.scm
+++ b/distro/packages/compression.scm
@@ -98,6 +98,7 @@ (define-public bzip2
(build-shared-lib
;; Build a shared library.
'(lambda* (#:key inputs #:allow-other-keys)
+ (patch-makefile-SHELL "Makefile-libbz2_so")
(zero? (system* "make" "-f" "Makefile-libbz2_so"))))
(install-shared-lib
'(lambda* (#:key outputs #:allow-other-keys)
diff --git a/distro/packages/gawk.scm b/distro/packages/gawk.scm
index 3bc4a8d8f17eb0457e61ff149563bc58cb1cdbb6..6fed7f8b70d46d5e674a9311e6714185e4d20668 100644
--- a/distro/packages/gawk.scm
+++ b/distro/packages/gawk.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,15 +35,26 @@ (define-public gawk
(sha256
(base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0"))))
(build-system gnu-build-system)
- (arguments (case-lambda
- ((system)
- (if (string=? system "i686-cygwin")
- '(#:tests? #f) ; work around test failure on Cygwin
- '(#:parallel-tests? #f))) ; test suite fails in parallel
- ((system cross-system)
- '(#:parallel-tests? #f))))
- (inputs `(("libsigsegv" ,libsigsegv) ; headers
- ("libsigsegv/lib" ,libsigsegv "lib"))) ; library
+ (arguments
+ (case-lambda
+ ((system)
+ `(#:parallel-tests? #f ; test suite fails in parallel
+
+ ;; Work around test failure on Cygwin.
+ #:tests? ,(not (string=? system "i686-cygwin"))
+
+ #:phases (alist-cons-before
+ 'configure 'set-shell-file-name
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Refer to the right shell.
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* "io.c"
+ (("/bin/sh")
+ (string-append bash "/bin/bash")))))
+ %standard-phases)))
+ ((system cross-system)
+ '(#:parallel-tests? #f))))
+ (inputs `(("libsigsegv" ,libsigsegv)))
(home-page "http://www.gnu.org/software/gawk/")
(synopsis "GNU implementation of the Awk programming language")
(description
diff --git a/distro/packages/gettext.scm b/distro/packages/gettext.scm
index dfc3a13066b8c094a9775104211af442990c2496..e4d4acc615d11fd8f04a477f7e339b9b109449bf 100644
--- a/distro/packages/gettext.scm
+++ b/distro/packages/gettext.scm
@@ -37,7 +37,20 @@ (define-public gettext
"1sa3ch12qxa4h3ya6hkz119yclcccmincl9j20dhrdx5mykp3b4k"))))
(build-system gnu-build-system)
(arguments
- `(#:patches (list (assoc-ref %build-inputs "patch/gets"))))
+ `(#:patches (list (assoc-ref %build-inputs "patch/gets"))
+ #:phases (alist-cons-before
+ 'check 'patch-tests
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* (find-files "gettext-tools/tests"
+ "^msgexec-[0-9]")
+ (("#![[:blank:]]/bin/sh")
+ (format #f "#!~a/bin/sh" bash)))
+ (substitute* (find-files "gettext-tools/gnulib-tests"
+ "posix_spawn")
+ (("/bin/sh")
+ (format #f "~a/bin/bash" bash)))))
+ %standard-phases)))
(inputs
`(("patch/gets"
,(search-patch "gettext-gets-undeclared.patch"))))
diff --git a/distro/packages/guile.scm b/distro/packages/guile.scm
index 84ba80841eaabff2ddb09ac25cd2162e07253926..9964f9d9f05273c68c92cef0b68da08a62b4ed4c 100644
--- a/distro/packages/guile.scm
+++ b/distro/packages/guile.scm
@@ -120,6 +120,16 @@ (define-public guile-2.0
(self-native-input? #t)
+ (arguments
+ '(#:phases (alist-cons-before
+ 'configure 'pre-configure
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* "module/ice-9/popen.scm"
+ (("/bin/sh")
+ (string-append bash "/bin/bash")))))
+ %standard-phases)))
+
(synopsis "GNU Guile 2.0, an embeddable Scheme implementation")
(description
"GNU Guile is an implementation of the Scheme programming language, with
@@ -134,15 +144,7 @@ (define-public guile-2.0
(define-public guile-2.0/fixed
;; A package of Guile 2.0 that's rarely changed. It is the one used
;; in the `base' module, and thus changing it entails a full rebuild.
- (package (inherit guile-2.0)
- (version "2.0.6")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://gnu/guile/guile-" version
- ".tar.xz"))
- (sha256
- (base32
- "000ng5qsq3cl1k35jvzvhwxj92wx4q87745n2fppkd4irh58vv5l"))))))
+ guile-2.0)
;;;
diff --git a/distro/packages/ld-wrapper.scm b/distro/packages/ld-wrapper.scm
index 9b8a09f067607096088c71d7d65f0a276a937207..fd5a4cbd0ccd0bb5e75b3079abd95a7d2ee709f3 100644
--- a/distro/packages/ld-wrapper.scm
+++ b/distro/packages/ld-wrapper.scm
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!@BASH@
# -*- mode: scheme; coding: utf-8; -*-
# XXX: We have to go through Bash because there's no command-line switch to
@@ -7,28 +7,28 @@
# Use `load-compiled' because `load' (and `-l') doesn't otherwise load our
# .go file (see <http://bugs.gnu.org/12519>).
-main="(@ (distro packages ld-wrapper) ld-wrapper)"
+main="(@ (gnu build-support ld-wrapper) ld-wrapper)"
exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "$@"
!#
-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (distro packages ld-wrapper)
+(define-module (gnu build-support ld-wrapper)
#:use-module (srfi srfi-1)
#:export (ld-wrapper))
diff --git a/distro/packages/libsigsegv.scm b/distro/packages/libsigsegv.scm
index 07185186a5f8387d8888c7427005ddcf5ae90096..a21e2064c7975cf22e67383e8b9b03717f552f10 100644
--- a/distro/packages/libsigsegv.scm
+++ b/distro/packages/libsigsegv.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,7 +35,6 @@ (define-public libsigsegv
(sha256
(base32 "16hrs8k3nmc7a8jam5j1fpspd6sdpkamskvsdpcw6m29vnis8q44"))))
(build-system gnu-build-system)
- (outputs '("out" "lib")) ; separate libdir from the rest
(home-page "http://www.gnu.org/software/libsigsegv/")
(synopsis "GNU libsigsegv, a library to handle page faults in user mode")
(description
diff --git a/distro/packages/linux.scm b/distro/packages/linux.scm
index 62bdefb1da5e2a1fbf56d591f3313877d55b1cf6..a40cc27c3ebd714fb4b4ac75b761c770d2f09e64 100644
--- a/distro/packages/linux.scm
+++ b/distro/packages/linux.scm
@@ -33,8 +33,13 @@ (define-module (distro packages linux)
(define-public linux-libre-headers
(let* ((version* "3.3.8")
(build-phase
- '(lambda* (#:key outputs #:allow-other-keys)
- (setenv "ARCH" "x86_64") ; XXX
+ '(lambda* (#:key system #:allow-other-keys)
+ (let ((arch (car (string-split system #\-))))
+ (setenv "ARCH"
+ (cond ((string=? arch "i686") "i386")
+ (else arch)))
+ (format #t "`ARCH' set to `~a'~%" (getenv "ARCH")))
+
(and (zero? (system* "make" "defconfig"))
(zero? (system* "make" "mrproper" "headers_check")))))
(install-phase
@@ -193,4 +198,4 @@ (define-public usbutils
"Tools for working with USB devices, such as lsusb")
(description
"Tools for working with USB devices, such as lsusb.")
- (license gpl2+)))
\ No newline at end of file
+ (license gpl2+)))
diff --git a/distro/packages/lsh.scm b/distro/packages/lsh.scm
index fa19d3e1c54f748cf2509e52ed2726bd27862729..d2c2d9082d9f8ce6d647f49fbe161d62c49977b9 100644
--- a/distro/packages/lsh.scm
+++ b/distro/packages/lsh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -114,8 +114,7 @@ (define-public lsh
(substitute* "src/testsuite/login-auth-test"
(("/bin/cat")
;; Use the right path to `cat'.
- (search-path (search-path-as-string->list (getenv "PATH"))
- "cat"))))
+ (which "cat"))))
%standard-phases)))
(home-page "http://www.lysator.liu.se/~nisse/lsh/")
(synopsis
diff --git a/distro/packages/m4.scm b/distro/packages/m4.scm
index 6f52f962c6de3f4dfd937c6876a12a3e0a38c615..7f2bed3ab7b07cbf608bbe78b3b6da0ec313f1fc 100644
--- a/distro/packages/m4.scm
+++ b/distro/packages/m4.scm
@@ -46,7 +46,19 @@ (define-public m4
#:patches (list (assoc-ref %build-inputs "patch/s_isdir")
(assoc-ref %build-inputs
"patch/readlink-EINVAL")
- (assoc-ref %build-inputs "patch/gets"))))
+ (assoc-ref %build-inputs "patch/gets"))
+ #:phases (alist-cons-before
+ 'check 'pre-check
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Fix references to /bin/sh.
+ (let ((bash (assoc-ref inputs "bash")))
+ (for-each patch-shebang
+ (find-files "tests" "\\.sh$"))
+ (substitute* (find-files "tests"
+ "posix_spawn")
+ (("/bin/sh")
+ (format #f "~a/bin/bash" bash)))))
+ %standard-phases)))
((system cross-system)
`(#:patches (list (assoc-ref %build-inputs "patch/s_isdir")
(assoc-ref %build-inputs
diff --git a/distro/packages/make-bootstrap.scm b/distro/packages/make-bootstrap.scm
index 09b8c69dec53b10a73a82bab25ed284d2e9241ce..b1d74ec5d60ea185c8ca35f8254c0414bc36d2c1 100644
--- a/distro/packages/make-bootstrap.scm
+++ b/distro/packages/make-bootstrap.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,7 +19,9 @@
(define-module (distro packages make-bootstrap)
#:use-module (guix utils)
#:use-module (guix packages)
+ #:use-module (guix licenses)
#:use-module (guix build-system trivial)
+ #:use-module (guix build-system gnu)
#:use-module ((distro) #:select (search-patch))
#:use-module (distro packages base)
#:use-module (distro packages bash)
@@ -29,11 +31,13 @@ (define-module (distro packages make-bootstrap)
#:use-module (distro packages linux)
#:use-module (distro packages multiprecision)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
#:export (%bootstrap-binaries-tarball
%binutils-bootstrap-tarball
%glibc-bootstrap-tarball
%gcc-bootstrap-tarball
- %guile-bootstrap-tarball))
+ %guile-bootstrap-tarball
+ %bootstrap-tarballs))
;;; Commentary:
;;;
@@ -43,48 +47,38 @@ (define-module (distro packages make-bootstrap)
;;;
;;; Code:
-(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 %glibc-for-bootstrap
+ ;; A libc whose `system' and `popen' functions looks for `sh' in $PATH,
+ ;; without nscd, and with static NSS modules.
+ (package (inherit glibc-final)
+ (arguments
+ (lambda (system)
+ (substitute-keyword-arguments ((package-arguments glibc-final) system)
+ ((#:patches patches)
+ `(cons (assoc-ref %build-inputs "patch/system")
+ ,patches))
+ ((#:configure-flags flags)
+ ;; Arrange so that getaddrinfo & co. do not contact the nscd,
+ ;; and can use statically-linked NSS modules.
+ `(cons* "--disable-nscd" "--disable-build-nscd"
+ "--enable-static-nss"
+ ,flags)))))
+ (inputs
+ `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
+ ,@(package-inputs glibc-final)))))
+
+(define %standard-inputs-with-relocatable-glibc
+ ;; Standard inputs with the above libc and corresponding GCC.
+ `(("libc", %glibc-for-bootstrap)
+ ("gcc" ,(package-with-explicit-inputs
+ gcc-4.7
+ `(("libc",%glibc-for-bootstrap)
+ ,@(alist-delete "libc" %final-inputs))
+ (current-source-location)))
+ ,@(fold alist-delete %final-inputs '("libc" "gcc"))))
(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)))
+ (static-package bash-light))
(define %static-inputs
;; Packages that are to be used as %BOOTSTRAP-INPUTS.
@@ -94,8 +88,13 @@ (define %static-inputs
'("--disable-nls"
"--disable-silent-rules"
"--enable-no-install-program=stdbuf,libstdbuf.so"
+ "CFLAGS=-Os -g0" ; smaller, please
"LDFLAGS=-static -pthread")
- ,@(package-arguments coreutils)))))
+ #:tests? #f ; signal-related Gnulib tests fail
+ ,@(package-arguments coreutils)))
+
+ ;; Remove optional dependencies such as GMP.
+ (inputs `(,(assoc "perl" (package-inputs coreutils))))))
(bzip2 (package (inherit bzip2)
(arguments
(substitute-keyword-arguments (package-arguments bzip2)
@@ -121,18 +120,27 @@ (define %static-inputs
(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)))))))
+ `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
+ ,@(substitute-keyword-arguments
+ ((package-arguments gawk) system)
+ ((#:phases phases)
+ `(alist-cons-before
+ 'configure 'no-export-dynamic
+ (lambda _
+ ;; Since we use `-static', remove
+ ;; `-export-dynamic'.
+ (substitute* "configure"
+ (("-export-dynamic") "")))
+ ,phases))))))
+ (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
+ (finalize (lambda (p)
+ (static-package (package-with-explicit-inputs
+ p
+ %standard-inputs-with-relocatable-glibc)
+ (current-source-location)))))
`(,@(map (match-lambda
((name package)
- (list name (static-package package (current-source-location)))))
+ (list name (finalize package))))
`(("tar" ,tar)
("gzip" ,gzip)
("bzip2" ,bzip2)
@@ -272,84 +280,87 @@ (define %glibc-stripped
;; GNU libc's essential shared libraries, dynamic linker, and headers,
;; with all references to store directories stripped. As a result,
;; libc.so is unusable and need to be patched for proper relocation.
- (package (inherit glibc-final)
- (name "glibc-stripped")
- (build-system trivial-build-system)
- (arguments
- `(#:modules ((guix build utils))
- #:builder
- (begin
- (use-modules (guix build utils))
-
- (setvbuf (current-output-port) _IOLBF)
- (let* ((out (assoc-ref %outputs "out"))
- (libdir (string-append out "/lib"))
- (incdir (string-append out "/include"))
- (libc (assoc-ref %build-inputs "libc"))
- (linux (assoc-ref %build-inputs "linux-headers")))
- (mkdir-p libdir)
- (for-each (lambda (file)
- (let ((target (string-append libdir "/"
- (basename file))))
- (copy-file file target)
- (remove-store-references target)))
- (find-files (string-append libc "/lib")
- "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
-
- (copy-recursively (string-append libc "/include") incdir)
-
- ;; Copy some of the Linux-Libre headers that glibc headers
- ;; refer to.
- (mkdir (string-append incdir "/linux"))
- (for-each (lambda (file)
- (copy-file (string-append linux "/include/linux/" file)
- (string-append incdir "/linux/"
- (basename file))))
- '("limits.h" "errno.h" "socket.h" "kernel.h"
- "sysctl.h" "param.h" "ioctl.h" "types.h"
- "posix_types.h" "stddef.h"))
-
- (copy-recursively (string-append linux "/include/asm")
- (string-append incdir "/asm"))
- (copy-recursively (string-append linux "/include/asm-generic")
- (string-append incdir "/asm-generic"))
- #t))))
- (inputs `(("libc" ,glibc-final)
- ("linux-headers" ,linux-libre-headers)))))
+ (let ((glibc %glibc-for-bootstrap))
+ (package (inherit glibc)
+ (name "glibc-stripped")
+ (build-system trivial-build-system)
+ (arguments
+ `(#:modules ((guix build utils))
+ #:builder
+ (begin
+ (use-modules (guix build utils))
+
+ (setvbuf (current-output-port) _IOLBF)
+ (let* ((out (assoc-ref %outputs "out"))
+ (libdir (string-append out "/lib"))
+ (incdir (string-append out "/include"))
+ (libc (assoc-ref %build-inputs "libc"))
+ (linux (assoc-ref %build-inputs "linux-headers")))
+ (mkdir-p libdir)
+ (for-each (lambda (file)
+ (let ((target (string-append libdir "/"
+ (basename file))))
+ (copy-file file target)
+ (remove-store-references target)))
+ (find-files (string-append libc "/lib")
+ "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
+
+ (copy-recursively (string-append libc "/include") incdir)
+
+ ;; Copy some of the Linux-Libre headers that glibc headers
+ ;; refer to.
+ (mkdir (string-append incdir "/linux"))
+ (for-each (lambda (file)
+ (copy-file (string-append linux "/include/linux/" file)
+ (string-append incdir "/linux/"
+ (basename file))))
+ '("limits.h" "errno.h" "socket.h" "kernel.h"
+ "sysctl.h" "param.h" "ioctl.h" "types.h"
+ "posix_types.h" "stddef.h"))
+
+ (copy-recursively (string-append linux "/include/asm")
+ (string-append incdir "/asm"))
+ (copy-recursively (string-append linux "/include/asm-generic")
+ (string-append incdir "/asm-generic"))
+ #t))))
+ (inputs `(("libc" ,glibc)
+ ("linux-headers" ,linux-libre-headers))))))
(define %gcc-static
;; A statically-linked GCC, with stripped-down functionality.
- (package (inherit gcc-final)
- (name "gcc-static")
- (arguments
- (lambda (system)
- `(#:modules ((guix build utils)
- (guix build gnu-build-system)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 regex))
- ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
- ((#:guile _) #f)
- ((#:implicit-inputs? _) #t)
- ((#:configure-flags flags)
- `(append (list
- "--disable-shared"
- "--disable-plugin"
- "--enable-languages=c"
- "--disable-libmudflap"
- "--disable-libgomp"
- "--disable-libssp"
- "--disable-libquadmath"
- "--disable-decimal-float")
- (remove (cut string-match "--(.*plugin|enable-languages)" <>)
- ,flags)))
- ((#:make-flags flags)
- `(cons "BOOT_LDFLAGS=-static" ,flags))))))
- (inputs `(("gmp-source" ,(package-source gmp))
- ("mpfr-source" ,(package-source mpfr))
- ("mpc-source" ,(package-source mpc))
- ("binutils" ,binutils-final)
- ,@(package-inputs gcc-4.7)))))
+ (package-with-explicit-inputs
+ (package (inherit gcc-final)
+ (name "gcc-static")
+ (arguments
+ (lambda (system)
+ `(#:modules ((guix build utils)
+ (guix build gnu-build-system)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 regex))
+ ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
+ ((#:guile _) #f)
+ ((#:implicit-inputs? _) #t)
+ ((#:configure-flags flags)
+ `(append (list
+ "--disable-shared"
+ "--disable-plugin"
+ "--enable-languages=c"
+ "--disable-libmudflap"
+ "--disable-libgomp"
+ "--disable-libssp"
+ "--disable-libquadmath"
+ "--disable-decimal-float")
+ (remove (cut string-match "--(.*plugin|enable-languages)" <>)
+ ,flags)))
+ ((#:make-flags flags)
+ `(cons "BOOT_LDFLAGS=-static" ,flags))))))
+ (inputs `(("gmp-source" ,(package-source gmp))
+ ("mpfr-source" ,(package-source mpfr))
+ ("mpc-source" ,(package-source mpc))
+ ("binutils" ,binutils-final)
+ ,@(package-inputs gcc-4.7))))
+ %standard-inputs-with-relocatable-glibc))
(define %gcc-stripped
;; The subset of GCC files needed for bootstrap.
@@ -429,7 +440,9 @@ (define %guile-static
;; There are uses of `dynamic-link' in
;; {foreign,coverage}.test that don't fly here.
#:tests? #f)))))
- (static-package guile (current-source-location))))
+ (package-with-explicit-inputs (static-package guile)
+ %standard-inputs-with-relocatable-glibc
+ (current-source-location))))
(define %guile-static-stripped
;; A stripped static Guile binary, for use during bootstrap.
@@ -509,4 +522,41 @@ (define %guile-bootstrap-tarball
;; A tarball with the statically-linked, relocatable Guile.
(tarball-package %guile-static-stripped))
+(define %bootstrap-tarballs
+ ;; A single derivation containing all the bootstrap tarballs, for
+ ;; convenience.
+ (package
+ (name "bootstrap-tarballs")
+ (version "0")
+ (source #f)
+ (build-system trivial-build-system)
+ (arguments
+ `(#:modules ((guix build utils))
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (use-modules (guix build utils)
+ (ice-9 match)
+ (srfi srfi-26))
+
+ (setvbuf (current-output-port) _IOLBF)
+ (mkdir out)
+ (chdir out)
+ (for-each (match-lambda
+ ((name . directory)
+ (for-each (lambda (file)
+ (format #t "~a -> ~a~%" file out)
+ (symlink file (basename file)))
+ (find-files directory "\\.tar\\."))))
+ %build-inputs)
+ #t)))
+ (inputs `(("guile-tarball" ,%guile-bootstrap-tarball)
+ ("gcc-tarball" ,%gcc-bootstrap-tarball)
+ ("binutils-tarball" ,%binutils-bootstrap-tarball)
+ ("glibc-tarball" ,%glibc-bootstrap-tarball)
+ ("coreutils&co-tarball" ,%bootstrap-binaries-tarball)))
+ (synopsis #f)
+ (description #f)
+ (home-page #f)
+ (license gpl3+)))
+
;;; make-bootstrap.scm ends here
diff --git a/distro/packages/multiprecision.scm b/distro/packages/multiprecision.scm
index 453f756d8741cd7eabfebc284daaad691547c7da..444c6103eb817788a7a6e951c1e475bf0c59a456 100644
--- a/distro/packages/multiprecision.scm
+++ b/distro/packages/multiprecision.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,14 +28,18 @@ (define-module (distro packages multiprecision)
(define-public gmp
(package
(name "gmp")
- (version "5.0.5")
+ (version "5.1.0")
(source (origin
(method url-fetch)
- (uri (string-append "mirror://gnu/gmp/gmp-" version
- ".tar.bz2"))
+ (uri
+ ;; Note: this version is not available from GNU mirrors
+ ;; because it was made with an Automake affected by
+ ;; CVE-2012-3386.
+ (string-append "ftp://ftp.gmplib.org/pub/gmp-"
+ version "/gmp-" version ".tar.bz2"))
(sha256
(base32
- "1jfymbr90mpn0zw5sg001llqnvf2462y77vgjknrmfs1rjn8ln0z"))))
+ "15n7xxgasbxdch8ii8z9ic6fxc2ysk3q8iavf55abjp5iylspnfz"))))
(build-system gnu-build-system)
(native-inputs `(("m4" ,m4)))
(arguments `(#:configure-flags
@@ -96,14 +100,13 @@ (define-public mpfr
(define-public mpc
(package
(name "mpc")
- (version "1.0")
+ (version "1.0.1")
(source (origin
(method url-fetch)
(uri (string-append
- "http://www.multiprecision.org/mpc/download/mpc-"
- version ".tar.gz"))
+ "mirror://gnu/mpc/mpc-" version ".tar.gz"))
(sha256 (base32
- "00rxjmkpqnv6zzcyw9aa5w6rzaav32ys87km25zgfcv9i32km5cw"))))
+ "1zq0fidp1jii2j5k5n9hmx55a6wwid33gjzhimvxq9d5zrf82npd"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("mpfr" ,mpfr)))
@@ -111,7 +114,11 @@ (define-public mpc
with exact rounding")
(description
"GNU MPC is a C library for the arithmetic of complex numbers with
-arbitrarily high precision and correct rounding of the result. It is built
-upon and follows the same principles as GNU MPFR.")
+arbitrarily high precision and correct rounding of the result. It extends
+the principles of the IEEE-754 standard for fixed precision real floating
+point numbers to complex numbers, providing well-defined semantics for
+every operation. At the same time, speed of operation at high precision
+is a major design goal. The library is built upon and follows the same
+principles as GNU MPFR.")
(license lgpl3+)
(home-page "http://mpc.multiprecision.org/")))
diff --git a/distro/packages/ncurses.scm b/distro/packages/ncurses.scm
index f8641c72f92a8cd2972ff1503f8692a76c8ecce5..938d1dc2c404d162a3b677830de8ec775781eb8a 100644
--- a/distro/packages/ncurses.scm
+++ b/distro/packages/ncurses.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,7 +24,26 @@ (define-module (distro packages ncurses)
#:use-module (guix build-system gnu))
(define-public ncurses
- (let ((post-install-phase
+ (let ((patch-makefile-phase
+ '(lambda _
+ (for-each patch-makefile-SHELL
+ (find-files "." "Makefile.in"))))
+ (configure-phase
+ '(lambda* (#:key inputs outputs configure-flags
+ #:allow-other-keys)
+ ;; The `ncursesw5-config' has a #!/bin/sh. We want to patch
+ ;; it to point to libc's embedded Bash, to avoid retaining a
+ ;; reference to the bootstrap Bash.
+ (let* ((libc (assoc-ref inputs "libc"))
+ (bash (string-append libc "/bin/bash"))
+ (out (assoc-ref outputs "out")))
+ (format #t "configure flags: ~s~%" configure-flags)
+ (zero? (apply system* bash "./configure"
+ (string-append "SHELL=" bash)
+ (string-append "CONFIG_SHELL=" bash)
+ (string-append "--prefix=" out)
+ configure-flags)))))
+ (post-install-phase
'(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; When building a wide-character (Unicode) build, create backward
@@ -81,13 +100,15 @@ (define lib.so
'("--without-cxx-binding")
'()))
#:tests? #f ; no "check" target
- #:phases (alist-cons-after 'install 'post-install
- ,post-install-phase
- %standard-phases)
-
- ;; The `ncursesw5-config' has a #!/bin/sh that we don't want to
- ;; patch, to avoid retaining a reference to the build-time Bash.
- #:patch-shebangs? #f))
+ #:phases (alist-cons-after
+ 'install 'post-install ,post-install-phase
+ (alist-cons-before
+ 'configure 'patch-makefile-SHELL
+ ,patch-makefile-phase
+ (alist-replace
+ 'configure
+ ,configure-phase
+ %standard-phases)))))
((system cross-system)
(arguments cross-system))))
(self-native-input? #t)
diff --git a/distro/packages/openssl.scm b/distro/packages/openssl.scm
new file mode 100644
index 0000000000000000000000000000000000000000..4018e46a497b556f7e7dddc3a7e8f32cdf5f7fd4
--- /dev/null
+++ b/distro/packages/openssl.scm
@@ -0,0 +1,68 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (distro packages openssl)
+ #:use-module (distro)
+ #:use-module (distro packages perl)
+ #:use-module (guix licenses)
+ #:use-module (guix packages)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu))
+
+(define-public openssl
+ (package
+ (name "openssl")
+ (version "1.0.1c")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
+ ".tar.gz"))
+ (sha256 (base32
+ "1gjy6a7d8nszi9wq8jdzx3cffn0nss23h3cw2ywlw4cb9v6v77ia"))))
+ (build-system gnu-build-system)
+ (inputs `(("perl" ,perl)))
+ (arguments
+ (lambda (system)
+ `(#:parallel-build? #f
+ #:parallel-tests? #f
+ #:test-target "test"
+ #:phases
+ (alist-replace
+ 'configure
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((out (assoc-ref outputs "out")))
+ (zero?
+ (system* "./config"
+ "shared" ; build shared libraries
+ "--libdir=lib"
+ (string-append "--prefix=" out)))))
+ (alist-cons-before
+ 'patch-source-shebangs 'patch-tests
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let ((bash (assoc-ref inputs "bash")))
+ (substitute* (find-files "test" ".*")
+ (("/bin/sh")
+ (string-append bash "/bin/bash"))
+ (("/bin/rm")
+ "rm"))))
+ %standard-phases)))))
+ (synopsis "OpenSSL, an SSL/TLS implementation")
+ (description
+ "OpenSSL is an implementation of SSL/TLS")
+ (license openssl)
+ (home-page "http://www.openssl.org/")))
diff --git a/distro/packages/patches/gawk-shell.patch b/distro/packages/patches/gawk-shell.patch
new file mode 100644
index 0000000000000000000000000000000000000000..89b8540a8ddc6920921012786825d8b14b3bc980
--- /dev/null
+++ b/distro/packages/patches/gawk-shell.patch
@@ -0,0 +1,34 @@
+As for libc's `system', change Awk to look for `sh' in $PATH. This patch is
+only meant to be used during bootstrapping, where we don't know in advance the
+absolute file name of `sh'.
+
+--- gawk-4.0.0/io.c 2011-05-18 20:47:29.000000000 +0200
++++ gawk-4.0.0/io.c 2012-12-18 15:56:06.000000000 +0100
+@@ -1759,7 +1759,7 @@ two_way_open(const char *str, struct red
+
+ signal(SIGPIPE, SIG_DFL);
+
+- execl("/bin/sh", "sh", "-c", str, NULL);
++ execlp("sh", "sh", "-c", str, NULL);
+ _exit(errno == ENOENT ? 127 : 126);
+
+ case -1:
+@@ -1924,7 +1924,7 @@ use_pipes:
+ || close(ctop[0]) == -1 || close(ctop[1]) == -1)
+ fatal(_("close of pipe failed (%s)"), strerror(errno));
+ /* stderr does NOT get dup'ed onto child's stdout */
+- execl("/bin/sh", "sh", "-c", str, NULL);
++ execlp("sh", "sh", "-c", str, NULL);
+ _exit(errno == ENOENT ? 127 : 126);
+ }
+ #endif /* NOT __EMX__ */
+@@ -2074,7 +2074,7 @@ gawk_popen(const char *cmd, struct redir
+ fatal(_("moving pipe to stdout in child failed (dup: %s)"), strerror(errno));
+ if (close(p[0]) == -1 || close(p[1]) == -1)
+ fatal(_("close of pipe failed (%s)"), strerror(errno));
+- execl("/bin/sh", "sh", "-c", cmd, NULL);
++ execlp("sh", "sh", "-c", cmd, NULL);
+ _exit(errno == ENOENT ? 127 : 126);
+ }
+ #endif /* NOT __EMX__ */
+
diff --git a/distro/packages/patches/glibc-bootstrap-system.patch b/distro/packages/patches/glibc-bootstrap-system.patch
new file mode 100644
index 0000000000000000000000000000000000000000..7208cce3f41aa11292532582c89e510aec982dc2
--- /dev/null
+++ b/distro/packages/patches/glibc-bootstrap-system.patch
@@ -0,0 +1,28 @@
+We want to allow builds in chroots that lack /bin/sh. Thus, system(3)
+and popen(3) need to be tweaked to use the right shell. For the bootstrap
+glibc, we just use whatever `sh' can be found in $PATH. The final glibc
+instead uses the hard-coded absolute file name of `bash'.
+
+--- a/sysdeps/posix/system.c
++++ b/sysdeps/posix/system.c
+@@ -134,7 +134,7 @@ do_system (const char *line)
+ INIT_LOCK ();
+
+ /* Exec the shell. */
+- (void) __execve (SHELL_PATH, (char *const *) new_argv, __environ);
++ (void) __execvpe (SHELL_NAME, (char *const *) new_argv, __environ);
+ _exit (127);
+ }
+ else if (pid < (pid_t) 0)
+
+--- b/libio/iopopen.c 2012-06-30 21:12:34.000000000 +0200
++++ b/libio/iopopen.c 2012-12-19 12:52:29.000000000 +0100
+@@ -226,7 +226,7 @@ _IO_new_proc_open (fp, command, mode)
+ _IO_close (fd);
+ }
+
+- _IO_execl ("/bin/sh", "sh", "-c", command, (char *) 0);
++ execlp ("sh", "sh", "-c", command, (char *) 0);
+ _IO__exit (127);
+ }
+ _IO_close (child_end);
diff --git a/distro/packages/perl.scm b/distro/packages/perl.scm
index 9f8de3d84f283c67c0c51c52ab4e327f6be64cb0..b6357875b6452647329d1983600985c6a8416fdd 100644
--- a/distro/packages/perl.scm
+++ b/distro/packages/perl.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -46,16 +46,14 @@ (define-public perl
'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
- (libc (assoc-ref inputs "libc"))
- (pwd (search-path (search-path-as-string->list
- (getenv "PATH"))
- "pwd")))
+ (libc (assoc-ref inputs "libc")))
;; Use the right path for `pwd'.
(substitute* "dist/Cwd/Cwd.pm"
- (("/bin/pwd") pwd))
+ (("/bin/pwd")
+ (which "pwd")))
(zero?
- (system* "/bin/sh" "./Configure"
+ (system* "./Configure"
(string-append "-Dprefix=" out)
(string-append "-Dman1dir=" out "/share/man/man1")
(string-append "-Dman3dir=" out "/share/man/man3")
diff --git a/distro/packages/readline.scm b/distro/packages/readline.scm
index 9b1b0d16b43babffb0f1a395ebd912daa6b2953d..5498f15b52c0a34edb88510d2aad18f1fc2ed1fe 100644
--- a/distro/packages/readline.scm
+++ b/distro/packages/readline.scm
@@ -26,44 +26,46 @@ (define-module (distro packages readline)
#:use-module (guix build-system gnu))
(define-public readline
- (package
- (name "readline")
- (version "6.2")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://gnu/readline/readline-"
- version ".tar.gz"))
- (sha256
- (base32
- "10ckm2bd2rkxhvdmj7nmbsylmihw0abwcsnxf8y27305183rd9kr"))))
- (build-system gnu-build-system)
- (propagated-inputs `(("ncurses" ,ncurses)))
- (inputs `(("patch/link-ncurses"
- ,(search-patch "readline-link-ncurses.patch"))))
- (arguments `(#:patches (list (assoc-ref %build-inputs
- "patch/link-ncurses"))
- #:patch-flags '("-p0")
- #:configure-flags
- (list (string-append "LDFLAGS=-Wl,-rpath -Wl,"
- (assoc-ref %build-inputs "ncurses")
- "/lib"))
+ (let ((post-install-phase
+ '(lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (lib (string-append out "/lib")))
+ ;; Make libraries writable so that `strip' can work.
+ ;; Failing to do that, it bails out with "Permission
+ ;; denied".
+ (for-each (lambda (f) (chmod f #o755))
+ (find-files lib "\\.so"))
+ (for-each (lambda (f) (chmod f #o644))
+ (find-files lib "\\.a"))))))
+ (package
+ (name "readline")
+ (version "6.2")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/readline/readline-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "10ckm2bd2rkxhvdmj7nmbsylmihw0abwcsnxf8y27305183rd9kr"))))
+ (build-system gnu-build-system)
+ (propagated-inputs `(("ncurses" ,ncurses)))
+ (inputs `(("patch/link-ncurses"
+ ,(search-patch "readline-link-ncurses.patch"))))
+ (arguments `(#:patches (list (assoc-ref %build-inputs
+ "patch/link-ncurses"))
+ #:patch-flags '("-p0")
+ #:configure-flags
+ (list (string-append "LDFLAGS=-Wl,-rpath -Wl,"
+ (assoc-ref %build-inputs "ncurses")
+ "/lib"))
- #:phases (alist-cons-after
- 'install 'post-install
- (lambda* (#:key outputs #:allow-other-keys)
- (let* ((out (assoc-ref outputs "out"))
- (lib (string-append out "/lib")))
- ;; Make libraries writable so that `strip' can
- ;; work. Failing to do that, it bails out with
- ;; "Permission denied".
- (for-each (lambda (f) (chmod f #o755))
- (find-files lib "\\.so"))
- (for-each (lambda (f) (chmod f #o644))
- (find-files lib "\\.a"))))
- %standard-phases)))
- (synopsis "GNU Readline, a library for interactive line editing")
- (description
- "The GNU Readline library provides a set of functions for use by
+ #:phases (alist-cons-after
+ 'install 'post-install
+ ,post-install-phase
+ %standard-phases)))
+ (synopsis "GNU Readline, a library for interactive line editing")
+ (description
+ "The GNU Readline library provides a set of functions for use by
applications that allow users to edit command lines as they are typed in.
Both Emacs and vi editing modes are available. The Readline library includes
additional functions to maintain a list of previously-entered command lines,
@@ -73,5 +75,5 @@ (define-public readline
The history facilites are also placed into a separate library, the History
library, as part of the build process. The History library may be used
without Readline in applications which desire its capabilities.")
- (license gpl3+)
- (home-page "http://savannah.gnu.org/projects/readline/")))
+ (license gpl3+)
+ (home-page "http://savannah.gnu.org/projects/readline/"))))
diff --git a/distro/packages/time.scm b/distro/packages/time.scm
index b7eaec0c2178e52c06dbcfd6ec3ea7b2a063826e..0b7bde9a1b4fcafdf2318acd8a426c8f3c38095b 100644
--- a/distro/packages/time.scm
+++ b/distro/packages/time.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,18 @@ (define-public time
(base32
"0va9063fcn7xykv658v2s9gilj2fq4rcdxx2mn2mmy1v4ndafzp3"))))
(build-system gnu-build-system)
+ (arguments
+ '(#:phases
+ (alist-replace 'configure
+ (lambda* (#:key outputs #:allow-other-keys)
+ ;; This old `configure' script doesn't support
+ ;; variables passed as arguments.
+ (let ((out (assoc-ref outputs "out")))
+ (setenv "CONFIG_SHELL" (which "bash"))
+ (zero?
+ (system* "./configure"
+ (string-append "--prefix=" out)))))
+ %standard-phases)))
(home-page "http://www.gnu.org/software/time/")
(synopsis
"GNU Time, a tool that runs programs and summarizes the system
@@ -49,6 +62,5 @@ (define-public time
The resources that 'time' can report on fall into the general categories
of time, memory, and I/O and IPC calls. Some systems do not provide
much information about program resource use; 'time' reports unavailable
-information as zero values.
-")
- (license gpl2+)))
\ No newline at end of file
+information as zero values.")
+ (license gpl2+)))
diff --git a/doc/guix.texi b/doc/guix.texi
index 60b1534ad429b4dbc0d524d59f5d984e2ec79d01..2af0c88133430d18a7393e4077a8d8e1204410a0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -444,7 +444,7 @@ Install @var{package}.
@code{guile}, or a package name followed by a hyphen and version number,
such as @code{guile-1.8.8}. In addition, @var{package} may contain a
colon, followed by the name of one of the outputs of the package, as in
-@code{gcc:doc} or @code{libsigsegv-2.10:lib}.
+@code{gcc:doc} or @code{binutils-2.22:lib}.
@item --remove=@var{package}
@itemx -r @var{package}
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 4d247b04e103bb580ff0b6abf5ffa1687e3266c7..a3a770f631ea2d4f3e7a2a1d4aea51978e5ec0ba 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -21,6 +21,7 @@ (define-module (guix build-system gnu)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix build-system)
+ #:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-39)
@@ -29,7 +30,8 @@ (define-module (guix build-system gnu)
gnu-build-system
package-with-explicit-inputs
package-with-extra-configure-variable
- static-libgcc-package))
+ static-libgcc-package
+ static-package))
;; Commentary:
;;
@@ -117,6 +119,28 @@ (define (static-libgcc-package p)
"A version of P linked with `-static-gcc'."
(package-with-extra-configure-variable p "LDFLAGS" "-static-libgcc"))
+(define* (static-package p #:optional (loc (current-source-location)))
+ "Return a statically-linked version of package P."
+ (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 %store
;; Store passed to STANDARD-INPUTS.
@@ -152,6 +176,7 @@ (define* (gnu-build store name source inputs
(out-of-source? #f)
(path-exclusions ''())
(tests? #t)
+ (test-target "check")
(parallel-build? #t) (parallel-tests? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
@@ -193,6 +218,7 @@ (define builder
#:out-of-source? ,out-of-source?
#:path-exclusions ,path-exclusions
#:tests? ,tests?
+ #:test-target ,test-target
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 074315cc9fc87a8eaa16f83d66b9a7d257ab766d..09c62541de966b7e3024b6c9b78dc7a6a2c485a5 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,20 +1,20 @@
-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build download)
#:use-module (web uri)
@@ -27,6 +27,7 @@ (define-module (guix build download)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:export (url-fetch))
;;; Commentary:
@@ -35,17 +36,58 @@ (define-module (guix build download)
;;;
;;; Code:
+(define* (progress-proc file size #:optional (log-port (current-output-port)))
+ "Return a procedure to show the progress of FILE's download, which is
+SIZE byte long. The returned procedure is suitable for use as an
+argument to `dump-port'. The progress report is written to LOG-PORT."
+ (if (number? size)
+ (lambda (transferred cont)
+ (let ((% (* 100.0 (/ transferred size))))
+ (display #\cr log-port)
+ (format log-port "~a\t~5,1f% of ~,1f KiB"
+ file % (/ size 1024.0))
+ (flush-output-port log-port)
+ (cont)))
+ (lambda (transferred cont)
+ (display #\cr log-port)
+ (format log-port "~a\t~6,1f KiB transferred"
+ file (/ transferred 1024.0))
+ (flush-output-port log-port)
+ (cont))))
+
+(define* (uri-abbreviation uri #:optional (max-length 42))
+ "If URI's string representation is larger than MAX-LENGTH, return an
+abbreviation of URI showing the scheme, host, and basename of the file."
+ (define uri-as-string
+ (uri->string uri))
+
+ (define (elide-path)
+ (let ((path (uri-path uri)))
+ (string-append (symbol->string (uri-scheme uri))
+ "://" (uri-host uri)
+ (string-append "/.../" (basename path)))))
+
+ (if (> (string-length uri-as-string) max-length)
+ (let ((short (elide-path)))
+ (if (< (string-length short) (string-length uri-as-string))
+ short
+ uri-as-string))
+ uri-as-string))
+
(define (ftp-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success."
(let* ((conn (ftp-open (uri-host uri)))
+ (size (false-if-exception (ftp-size conn (uri-path uri))))
(in (ftp-retr conn (basename (uri-path uri))
(dirname (uri-path uri)))))
(call-with-output-file file
(lambda (out)
- ;; TODO: Show a progress bar.
- (dump-port in out)))
+ (dump-port in out
+ #:buffer-size 65536 ; don't flood the log
+ #:progress (progress-proc (uri-abbreviation uri) size))))
(ftp-close conn))
+ (newline)
file)
(define (open-connection-for-uri uri)
@@ -103,20 +145,34 @@ (define addresses
(define (http-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success."
- ;; FIXME: Use a variant of `http-get' that returns a port instead of
- ;; loading everything in memory.
(let*-values (((connection)
(open-connection-for-uri uri))
- ((resp bv)
- (http-get uri #:port connection #:decode-body? #f))
+ ((resp bv-or-port)
+ ;; XXX: `http-get*' was introduced in 2.0.7. We know
+ ;; we're using it within the chroot, but
+ ;; `guix-download' might be using a different version.
+ ;; So keep this compatibility hack for now.
+ (if (module-defined? (resolve-interface '(web client))
+ 'http-get*)
+ (http-get* uri #:port connection #:decode-body? #f)
+ (http-get uri #:port connection #:decode-body? #f)))
((code)
- (response-code resp)))
+ (response-code resp))
+ ((size)
+ (response-content-length resp)))
(case code
((200) ; OK
(begin
(call-with-output-file file
(lambda (p)
- (put-bytevector p bv)))
+ (if (port? bv-or-port)
+ (begin
+ (dump-port bv-or-port p
+ #:buffer-size 65536 ; don't flood the log
+ #:progress (progress-proc (uri-abbreviation uri)
+ size))
+ (newline))
+ (put-bytevector p bv-or-port))))
file))
((302) ; found (redirection)
(let ((uri (response-location resp)))
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 2b7d1c180ea6271e223a51fa94dae8384bef9ee4..b7b9fdac954e5dad60873d14e5d0b1dd4da42bb1 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -1,25 +1,26 @@
-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build gnu-build-system)
#:use-module (guix build utils)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
@@ -82,6 +83,28 @@ (define* (unpack #:key source #:allow-other-keys)
(and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory "."))))
+(define* (patch-source-shebangs #:key source #:allow-other-keys)
+ "Patch shebangs in all source files; this includes non-executable
+files such as `.in' templates. Most scripts honor $SHELL and
+$CONFIG_SHELL, but some don't, such as `mkinstalldirs' or Automake's
+`missing' script."
+ (for-each patch-shebang
+ (remove file-is-directory? (find-files "." ".*"))))
+
+(define (patch-generated-file-shebangs . rest)
+ "Patch shebangs in generated files, including `SHELL' variables in
+makefiles."
+ ;; Patch executable files, some of which might have been generated by
+ ;; `configure'.
+ (for-each patch-shebang
+ (filter (lambda (file)
+ (and (executable-file? file)
+ (not (file-is-directory? file))))
+ (find-files "." ".*")))
+
+ ;; Patch `SHELL' in generated makefiles.
+ (for-each patch-makefile-SHELL (find-files "." "^(GNU)?[mM]akefile$")))
+
(define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
#:allow-other-keys)
(every (lambda (p)
@@ -90,23 +113,51 @@ (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
(append patch-flags (list "--input" p)))))
patches))
-(define* (configure #:key outputs (configure-flags '()) out-of-source?
+(define* (configure #:key inputs outputs (configure-flags '()) out-of-source?
#:allow-other-keys)
+ (define (package-name)
+ (let* ((out (assoc-ref outputs "out"))
+ (base (basename out))
+ (dash (string-rindex base #\-)))
+ ;; XXX: We'd rather use `package-name->name+version' or similar.
+ (if dash
+ (substring base 0 dash)
+ base)))
+
(let* ((prefix (assoc-ref outputs "out"))
+ (bindir (assoc-ref outputs "bin"))
(libdir (assoc-ref outputs "lib"))
(includedir (assoc-ref outputs "include"))
- (flags `(,(string-append "--prefix=" prefix)
+ (docdir (assoc-ref outputs "doc"))
+ (bash (or (and=> (assoc-ref inputs "bash")
+ (cut string-append <> "/bin/bash"))
+ "/bin/sh"))
+ (flags `(,(string-append "CONFIG_SHELL=" bash)
+ ,(string-append "SHELL=" bash)
+ ,(string-append "--prefix=" prefix)
"--enable-fast-install" ; when using Libtool
;; Produce multiple outputs when specific output names
;; are recognized.
+ ,@(if bindir
+ (list (string-append "--bindir=" bindir "/bin"))
+ '())
,@(if libdir
- (list (string-append "--libdir=" libdir "/lib"))
+ (cons (string-append "--libdir=" libdir "/lib")
+ (if includedir
+ '()
+ (list
+ (string-append "--includedir="
+ libdir "/include"))))
'())
,@(if includedir
(list (string-append "--includedir="
includedir "/include"))
'())
+ ,@(if docdir
+ (list (string-append "--docdir=" docdir
+ "/doc/" (package-name)))
+ '())
,@configure-flags))
(abs-srcdir (getcwd))
(srcdir (if out-of-source?
@@ -121,10 +172,15 @@ (define* (configure #:key outputs (configure-flags '()) out-of-source?
(format #t "build directory: ~s~%" (getcwd))
(format #t "configure flags: ~s~%" flags)
+ ;; Use BASH to reduce reliance on /bin/sh since it may not always be
+ ;; reliable (see
+ ;; <http://thread.gmane.org/gmane.linux.distributions.nixos/9748>
+ ;; for a summary of the situation.)
+ ;;
;; Call `configure' with a relative path. Otherwise, GCC's build system
;; (for instance) records absolute source file names, which typically
;; contain the hash part of the `.drv' file, leading to a reference leak.
- (zero? (apply system*
+ (zero? (apply system* bash
(string-append srcdir "/configure")
flags))))
@@ -221,7 +277,9 @@ (define %standard-phases
;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...)))))
- (phases set-paths unpack patch configure build check install
+ (phases set-paths unpack patch
+ patch-source-shebangs configure patch-generated-file-shebangs
+ build check install
patch-shebangs strip)))
@@ -232,11 +290,17 @@ (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)
"Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
in order. Return #t if all the PHASES succeeded, #f otherwise."
(setvbuf (current-output-port) _IOLBF)
+ (setvbuf (current-error-port) _IOLBF)
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
;; PHASES can pick the keyword arguments it's interested in.
(every (match-lambda
((name . proc)
- (format #t "starting phase `~a'~%" name)
- (apply proc args)))
+ (let ((start (gettimeofday)))
+ (format #t "starting phase `~a'~%" name)
+ (let ((result (apply proc args))
+ (end (gettimeofday)))
+ (format #t "phase `~a' ~:[failed~;succeeded~] after ~a seconds~%"
+ name result (- (car end) (car start)))
+ result))))
phases))
diff --git a/guix/build/union.scm b/guix/build/union.scm
index d1578a6ef53377d231365be41b029801d6a71da6..234964dba5524526c4650e177aa7e41d38fc6793 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,20 +1,20 @@
-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build union)
#:use-module (ice-9 ftw)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 8ae190f6561d1462ce4980a0d86b3661c586859e..6921e31bdd0d0c4e00b094917fb9a332ce8156c5 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,20 +1,20 @@
-;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
-;;; This file is part of Guix.
+;;; This file is part of GNU Guix.
;;;
-;;; Guix is free software; you can redistribute it and/or modify it
+;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
-;;; Guix is distributed in the hope that it will be useful, but
+;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build utils)
#:use-module (srfi srfi-1)
@@ -26,6 +26,8 @@ (define-module (guix build utils)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:export (directory-exists?
+ executable-file?
+ call-with-ascii-input-file
with-directory-excursion
mkdir-p
copy-recursively
@@ -34,6 +36,8 @@ (define-module (guix build utils)
set-path-environment-variable
search-path-as-string->list
list->search-path-as-string
+ which
+
alist-cons-before
alist-cons-after
alist-replace
@@ -41,7 +45,9 @@ (define-module (guix build utils)
substitute
substitute*
dump-port
+ set-file-time
patch-shebang
+ patch-makefile-SHELL
fold-port-matches
remove-store-references))
@@ -56,6 +62,27 @@ (define (directory-exists? dir)
(and s
(eq? 'directory (stat:type s)))))
+(define (executable-file? file)
+ "Return #t if FILE exists and is executable."
+ (let ((s (stat file #f)))
+ (and s
+ (not (zero? (logand (stat:mode s) #o100))))))
+
+(define (call-with-ascii-input-file file proc)
+ "Open FILE as an ASCII or binary file, and pass the resulting port to
+PROC. FILE is closed when PROC's dynamic extent is left. Return the
+return values of applying PROC to the port."
+ (let ((port (with-fluids ((%default-port-encoding #f))
+ ;; Use "b" so that `open-file' ignores `coding:' cookies.
+ (open-file file "rb"))))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (proc port))
+ (lambda ()
+ (close-input-port port)))))
+
(define-syntax-rule (with-directory-excursion dir body ...)
"Run BODY with DIR as the process's current directory."
(let ((init (getcwd)))
@@ -189,6 +216,12 @@ (define* (set-path-environment-variable env-var sub-directories input-dirs
(format #t "environment variable `~a' set to `~a'~%"
env-var value)))
+(define (which program)
+ "Return the complete file name for PROGRAM as found in $PATH, or #f if
+PROGRAM could not be found."
+ (search-path (search-path-as-string->list (getenv "PATH"))
+ program))
+
;;;
;;; Phases.
@@ -364,29 +397,49 @@ (define (substitute-one-file file-name)
;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh.
;;;
-(define (dump-port in out)
- "Read as much data as possible from IN and write it to OUT."
- (define buffer-size 4096)
+(define* (dump-port in out
+ #:key (buffer-size 16384)
+ (progress (lambda (t k) (k))))
+ "Read as much data as possible from IN and write it to OUT, using
+chunks of BUFFER-SIZE bytes. Call PROGRESS after each successful
+transfer of BUFFER-SIZE bytes or less, passing it the total number of
+bytes transferred and the continuation of the transfer as a thunk."
(define buffer
(make-bytevector buffer-size))
- (let loop ((bytes (get-bytevector-n! in buffer 0 buffer-size)))
+ (let loop ((total 0)
+ (bytes (get-bytevector-n! in buffer 0 buffer-size)))
(or (eof-object? bytes)
- (begin
+ (let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes)
- (loop (get-bytevector-n! in buffer 0 buffer-size))))))
+ (progress total
+ (lambda ()
+ (loop total
+ (get-bytevector-n! in buffer 0 buffer-size))))))))
+
+(define (set-file-time file stat)
+ "Set the atime/mtime of FILE to that specified by STAT."
+ (utime file
+ (stat:atime stat)
+ (stat:mtime stat)
+ (stat:atimensec stat)
+ (stat:mtimensec stat)))
(define patch-shebang
(let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$")))
(lambda* (file
- #:optional (path (search-path-as-string->list (getenv "PATH"))))
+ #:optional
+ (path (search-path-as-string->list (getenv "PATH")))
+ #:key (keep-mtime? #t))
"Replace the #! interpreter file name in FILE by a valid one found in
PATH, when FILE actually starts with a shebang. Return #t when FILE was
-patched, #f otherwise."
+patched, #f otherwise. When KEEP-MTIME? is true, the atime/mtime of
+FILE are kept unchanged."
(define (patch p interpreter rest-of-line)
(let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template))
- (mode (stat:mode (stat file))))
+ (st (stat file))
+ (mode (stat:mode st)))
(with-throw-handler #t
(lambda ()
(format out "#!~a~a~%"
@@ -395,6 +448,8 @@ (define (patch p interpreter rest-of-line)
(close out)
(chmod template mode)
(rename-file template file)
+ (when keep-mtime?
+ (set-file-time file st))
#t)
(lambda (key . args)
(format (current-error-port)
@@ -403,30 +458,60 @@ (define (patch p interpreter rest-of-line)
(false-if-exception (delete-file template))
#f))))
- (with-fluids ((%default-port-encoding #f)) ; ASCII
- (call-with-input-file file
- (lambda (p)
- (and (eq? #\# (read-char p))
- (eq? #\! (read-char p))
- (let ((line (false-if-exception (read-line p))))
- (and=> (and line (regexp-exec shebang-rx line))
- (lambda (m)
- (let* ((cmd (match:substring m 1))
- (bin (search-path path
- (basename cmd))))
- (if bin
- (if (string=? bin cmd)
- #f ; nothing to do
- (begin
- (format (current-error-port)
- "patch-shebang: ~a: changing `~a' to `~a'~%"
- file cmd bin)
- (patch p bin (match:substring m 2))))
- (begin
- (format (current-error-port)
- "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
- file (basename cmd))
- #f)))))))))))))
+ (call-with-ascii-input-file file
+ (lambda (p)
+ (and (eq? #\# (read-char p))
+ (eq? #\! (read-char p))
+ (let ((line (false-if-exception (read-line p))))
+ (and=> (and line (regexp-exec shebang-rx line))
+ (lambda (m)
+ (let* ((cmd (match:substring m 1))
+ (bin (search-path path (basename cmd))))
+ (if bin
+ (if (string=? bin cmd)
+ #f ; nothing to do
+ (begin
+ (format (current-error-port)
+ "patch-shebang: ~a: changing `~a' to `~a'~%"
+ file cmd bin)
+ (patch p bin (match:substring m 2))))
+ (begin
+ (format (current-error-port)
+ "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
+ file (basename cmd))
+ #f))))))))))))
+
+(define* (patch-makefile-SHELL file #:key (keep-mtime? #t))
+ "Patch the `SHELL' variable in FILE, which is supposedly a makefile.
+When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
+
+ ;; For instance, Gettext-generated po/Makefile.in.in do not honor $SHELL.
+
+ ;; XXX: Unlike with `patch-shebang', FILE is always touched.
+
+ (define (find-shell name)
+ (let ((shell
+ (search-path (search-path-as-string->list (getenv "PATH"))
+ name)))
+ (unless shell
+ (format (current-error-port)
+ "patch-makefile-SHELL: warning: no binary for shell `~a' found in $PATH~%"
+ name))
+ shell))
+
+ (let ((st (stat file)))
+ (substitute* file
+ (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell)
+ (let* ((old (string-append dir shell))
+ (new (or (find-shell shell) old)))
+ (unless (string=? new old)
+ (format (current-error-port)
+ "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
+ file old new))
+ (string-append "SHELL = " new "\n"))))
+
+ (when keep-mtime?
+ (set-file-time file st))))
(define* (fold-port-matches proc init pattern port
#:optional (unmatched (lambda (_ r) r)))
@@ -440,6 +525,14 @@ (define initial-pattern
(map char-set (string->list pattern))
pattern))
+ (define (get-char p)
+ ;; We call it `get-char', but that's really a binary version
+ ;; thereof. (The real `get-char' cannot be used here because our
+ ;; bootstrap Guile is hacked to always use UTF-8.)
+ (match (get-u8 p)
+ ((? integer? x) (integer->char x))
+ (x x)))
+
;; Note: we're not really striving for performance here...
(let loop ((chars '())
(pattern initial-pattern)
@@ -499,16 +592,17 @@ (define pattern
(setvbuf in _IOFBF 65536)
(setvbuf out _IOFBF 65536)
(fold-port-matches (lambda (match result)
- (put-string out store)
- (put-char out #\/)
- (put-string out
- "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-")
+ (put-bytevector out (string->utf8 store))
+ (put-u8 out (char->integer #\/))
+ (put-bytevector out
+ (string->utf8
+ "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-"))
#t)
#f
pattern
in
(lambda (char result)
- (put-char out char)
+ (put-u8 out (char->integer char))
result))))))
;;; Local Variables:
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 7e241f37b265cece334375270865ed7c6b8f0bbe..e3bacc37204b77354a109d72a80eae3bfc73eb96 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,6 +33,7 @@ (define-module (guix ftp-client)
ftp-open
ftp-close
ftp-chdir
+ ftp-size
ftp-list
ftp-retr))
@@ -133,6 +134,12 @@ (define (ftp-chdir conn dir)
(%ftp-command (string-append "CWD " dir) 250
(ftp-connection-socket conn)))
+(define (ftp-size conn file)
+ "Return the size in bytes of FILE."
+ (let ((message (%ftp-command (string-append "SIZE " file) 213
+ (ftp-connection-socket conn))))
+ (string->number (string-trim-both message))))
+
(define (ftp-pasv conn)
(define %pasv-rx
(make-regexp "([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)"))
diff --git a/m4/guix.m4 b/m4/guix.m4
index 7d7d7381a0d52d7082030640ae9c314d9bd9d815..6cf1b01c905091246c80f26b5f15cb2191fca761 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -1,20 +1,20 @@
-dnl Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-dnl Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+dnl GNU Guix --- Functional package management for GNU
+dnl Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
dnl
-dnl This file is part of Guix.
+dnl This file is part of GNU Guix.
dnl
-dnl Guix is free software; you can redistribute it and/or modify it
+dnl GNU Guix is free software; you can redistribute it and/or modify it
dnl under the terms of the GNU General Public License as published by
dnl the Free Software Foundation; either version 3 of the License, or (at
dnl your option) any later version.
dnl
-dnl Guix is distributed in the hope that it will be useful, but
+dnl GNU Guix is distributed in the hope that it will be useful, but
dnl WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
dnl GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public License
-dnl along with Guix. If not, see <http://www.gnu.org/licenses/>.
+dnl along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
dnl GUIX_ASSERT_LIBGCRYPT_USABLE
dnl
@@ -61,5 +61,9 @@ AC_DEFUN([GUIX_SYSTEM_TYPE], [
# `darwin10.2.0', etc.
guix_system="$machine_name-`echo $host_os | "$SED" -e's/@<:@0-9.@:>@*$//g'`";;
esac])
+
+ AC_MSG_CHECKING([for the Guix system type])
+ AC_MSG_RESULT([$guix_system])
+
AC_SUBST([guix_system])
])
diff --git a/nix/sync-with-upstream b/nix/sync-with-upstream
index 1f11fd7d4751d955412830a9bf4d337dd94a93b8..66a315a643301dd4eeaf854a7f2006dc0f32c546 100755
--- a/nix/sync-with-upstream
+++ b/nix/sync-with-upstream
@@ -1,21 +1,21 @@
#!/bin/sh
-# Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
-# Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
#
-# This file is part of Guix.
+# This file is part of GNU Guix.
#
-# Guix is free software; you can redistribute it and/or modify it
+# GNU Guix is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
-# Guix is distributed in the hope that it will be useful, but
+# GNU Guix is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with Guix. If not, see <http://www.gnu.org/licenses/>.
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
#
# Update the local copy of Nix source code needed to build the daemon.
diff --git a/release.nix b/release.nix
index cd69d46402320444f0cf7f427735198caf4fd942..369d54ed9686984ad31d5eb9152b53fb0320fa50 100644
--- a/release.nix
+++ b/release.nix
@@ -32,13 +32,13 @@ let
bootstrap_guile =
let pkgs = import nixpkgs {}; in {
i686 = pkgs.fetchurl {
- url = http://www.fdn.fr/~lcourtes/software/guix/packages/i686-linux/guile-bootstrap-2.0.6.tar.xz;
- sha256 = "93b537766dfab3ad287143523751e3ec02dd32d3ccaf88ad2d31c63158f342ee";
+ url = http://www.fdn.fr/~lcourtes/software/guix/packages/i686-linux/20121219/guile-2.0.7.tar.xz;
+ sha256 = "45d1f9bfb9e4531a8f1c5a105f7ab094cd481b8a179ccc63cbabb73ce6b8437f";
};
x86_64 = pkgs.fetchurl {
- url = http://www.fdn.fr/~lcourtes/software/guix/packages/x86_64-linux/guile-bootstrap-2.0.6.tar.xz;
- sha256 = "0467a82cbe4136f60a79eb4176011bf88cf28ea19c9ad9defa365811ff8e11cf";
+ url = http://www.fdn.fr/~lcourtes/software/guix/packages/x86_64-linux/20121219/guile-2.0.7.tar.xz;
+ sha256 = "953fbcc8db6e310626be79b67319cf4141dc23b296447952a99d95425b3a4dc1";
};
};
@@ -76,9 +76,9 @@ let
# the build system download it over and over again.
'' mkdir -p distro/packages/bootstrap/{i686,x86_64}-linux
cp -v "${bootstrap_guile.i686}" \
- distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz
+ distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz
cp -v "${bootstrap_guile.x86_64}" \
- distro/packages/bootstrap/x86_64-linux/guile-bootstrap-2.0.6.tar.xz
+ distro/packages/bootstrap/x86_64-linux/guile-2.0.7.tar.xz
'';
inherit succeedOnFailure keepBuildDirectory
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 119edfcb86ffaa1f6fde321a315f49af4767be68..166a91749006f7de9bf66dd0bcc25ae295d869eb 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -23,6 +23,7 @@ (define-module (test-derivations)
#:use-module (guix utils)
#:use-module (guix base32)
#:use-module ((guix packages) #:select (package-derivation))
+ #:use-module ((distro) #:select (search-bootstrap-binary))
#:use-module (distro packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -47,6 +48,11 @@ (define %store
(let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv)))
+(define %bash
+ (let ((bash (search-bootstrap-binary "bash" (%current-system))))
+ (and %store
+ (add-to-store %store "bash" #t #t "sha256" bash))))
+
(define (directory-contents dir)
"Return an alist representing the contents of DIR."
(define prefix-len (string-length dir))
@@ -96,10 +102,11 @@ (define prefix-len (string-length dir))
(test-assert "derivation with no inputs"
(let* ((builder (add-text-to-store %store "my-builder.sh"
- "#!/bin/sh\necho hello, world\n"
+ "echo hello, world\n"
'()))
- (drv-path (derivation %store "foo" (%current-system) builder
- '() '(("HOME" . "/homeless")) '())))
+ (drv-path (derivation %store "foo" (%current-system)
+ %bash `("-e" ,builder)
+ '(("HOME" . "/homeless")) '())))
(and (store-path? drv-path)
(valid-path? %store drv-path))))
@@ -110,7 +117,7 @@ (define prefix-len (string-length dir))
'()))
((drv-path drv)
(derivation %store "foo" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
@@ -132,7 +139,7 @@ (define prefix-len (string-length dir))
(input (search-path %load-path "ice-9/boot-9.scm"))
(drv-path (derivation %store "derivation-with-input-file"
(%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
`(("in"
;; Cheat to pass the actual file
;; name to the builder.
@@ -152,7 +159,7 @@ (define prefix-len (string-length dir))
"echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(drv-path (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'()
`((,builder)) ; optional
#:hash hash #:hash-algo 'sha256))
@@ -170,11 +177,11 @@ (define prefix-len (string-length dir))
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(drv-path1 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(drv-path2 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store
@@ -193,11 +200,11 @@ (define prefix-len (string-length dir))
"echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed2 (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
'() `()
#:hash hash #:hash-algo 'sha256))
(fixed-out (derivation-path->output-path fixed1))
@@ -206,11 +213,11 @@ (define prefix-len (string-length dir))
;; Use Bash hackery to avoid Coreutils.
"echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
(final1 (derivation %store "final" (%current-system)
- "/bin/sh" `(,builder3)
+ %bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed1))))
(final2 (derivation %store "final" (%current-system)
- "/bin/sh" `(,builder3)
+ %bash `(,builder3)
`(("in" . ,fixed-out))
`((,builder3) (,fixed2))))
(succeeded? (build-derivations %store
@@ -224,7 +231,7 @@ (define prefix-len (string-length dir))
"echo one > $out ; echo two > $second"
'()))
(drv-path (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
@@ -247,7 +254,7 @@ (define prefix-len (string-length dir))
"echo one > $out ; echo two > $AAA"
'()))
(drv-path (derivation %store "fixed" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
'()
`((,builder))
#:outputs '("out" "AAA")))
@@ -265,7 +272,7 @@ (define prefix-len (string-length dir))
"echo one > $out ; echo two > $two"
'()))
(mdrv (derivation %store "multiple-output" (%current-system)
- "/bin/sh" `(,builder1)
+ %bash `(,builder1)
'()
`((,builder1))
#:outputs '("out" "two")))
@@ -276,7 +283,7 @@ (define prefix-len (string-length dir))
'()))
(udrv (derivation %store "multiple-output-user"
(%current-system)
- "/bin/sh" `(,builder2)
+ %bash `(,builder2)
`(("one" . ,(derivation-path->output-path
mdrv "out"))
("two" . ,(derivation-path->output-path
@@ -306,7 +313,7 @@ (define %coreutils
'()))
(drv-path
(derivation %store "foo" (%current-system)
- "/bin/sh" `(,builder)
+ %bash `(,builder)
`(("PATH" .
,(string-append
(derivation-path->output-path %coreutils)
diff --git a/tests/union.scm b/tests/union.scm
index a3859434a236378dff04ac9779e6023d62ecb234..5bbf992a59baae7155dd572ac9d90e2ba4a6e761 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -26,6 +26,7 @@ (define-module (test-union)
#:use-module ((guix build utils)
#:select (with-directory-excursion directory-exists?))
#:use-module (distro packages bootstrap)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
@@ -93,7 +94,9 @@ (define %store
(let* ((inputs (map (match-lambda
((name package)
`(,name ,(package-derivation %store package))))
- %bootstrap-inputs))
+ (delete-duplicates %bootstrap-inputs
+ (lambda (i1 i2)
+ (eq? (second i1) (second i2))))))
(builder `(begin
(use-modules (guix build union))
(union-build (assoc-ref %outputs "out")