me/guix
Archived
1
0
Fork 0
Code Activity

Merge branch 'core-updates'

Browse source 
Conflicts:
	guix/build/union.scm
This commit is contained in:
Ludovic Courtès 2013-01-11 16:01:49 +01:00
commit 01e354eb83
40 changed files with 1208 additions and 512 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
HACKING
View file

@ -2,7 +2,7 @@
#+TITLE: Hacking GNU Guix and its incredible distro #+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, Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright 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: commands:
#+BEGIN_SRC sh #+BEGIN_SRC sh
./pre-inst-env guix-build \ ./pre-inst-env guix-build \
-e '(@@ (distro packages base) %guile-bootstrap-tarball)' \ -e '(@ (distro packages make-bootstrap) bootstrap-tarballs)' \
--system=i686-linux --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 #+END_SRC
These should build tarballs containing statically-linked tools usable on 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 ‘tar’, and ‘xz’ under ‘distro/packages/bootstrap/i686-linux’. These
binaries can be extracted from the static-binaries tarball built above. binaries can be extracted from the static-binaries tarball built above.
A rule for A rule for ‘distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz’
‘distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz’
needs to be added in ‘Makefile.am’, with the appropriate hexadecimal needs to be added in ‘Makefile.am’, with the appropriate hexadecimal
vrepresentation of its SHA256 hash. 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’, ‘%bootstrap-coreutils&co’, ‘%bootstrap-binutils’, ‘%bootstrap-glibc’,
and ‘%bootstrap-gcc’, the expected SHA256 of the corresponding tarballs and ‘%bootstrap-gcc’, the expected SHA256 of the corresponding tarballs
for ‘i686-linux’ (built above) must be added. for ‘i686-linux’ (built above) must be added.

15
Makefile.am
View file

@ -90,6 +90,7 @@ MODULES = \
distro/packages/nano.scm \ distro/packages/nano.scm \
distro/packages/ncurses.scm \ distro/packages/ncurses.scm \
distro/packages/nettle.scm \ distro/packages/nettle.scm \
distro/packages/openssl.scm \
distro/packages/perl.scm \ distro/packages/perl.scm \
distro/packages/pkg-config.scm \ distro/packages/pkg-config.scm \
distro/packages/pth.scm \ distro/packages/pth.scm \
@ -116,7 +117,9 @@ dist_patch_DATA = \
distro/packages/patches/cpio-gets-undeclared.patch \ distro/packages/patches/cpio-gets-undeclared.patch \
distro/packages/patches/diffutils-gets-undeclared.patch \ distro/packages/patches/diffutils-gets-undeclared.patch \
distro/packages/patches/flex-bison-tests.patch \ distro/packages/patches/flex-bison-tests.patch \
distro/packages/patches/gawk-shell.patch \
distro/packages/patches/gettext-gets-undeclared.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/glibc-no-ld-so-cache.patch \
distro/packages/patches/guile-1.8-cpp-4.5.patch \ distro/packages/patches/guile-1.8-cpp-4.5.patch \
distro/packages/patches/guile-default-utf8.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 # Big bootstrap binaries are not included in the tarball. Instead, they
# are downloaded. # are downloaded.
nodist_bootstrap_x86_64_linux_DATA = \ 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 = \ 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 # Those files must remain executable, so they remain executable once
# imported into the store. # imported into the store.
@ -173,12 +176,12 @@ DOWNLOAD_FILE = \
$(GUILE) --no-auto-compile -L "$(top_builddir)" -L "$(top_srcdir)" \ $(GUILE) --no-auto-compile -L "$(top_builddir)" -L "$(top_srcdir)" \
"$(top_srcdir)/build-aux/download.scm" "$(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 "$@"` $(MKDIR_P) `dirname "$@"`
$(DOWNLOAD_FILE) "$@" "0467a82cbe4136f60a79eb4176011bf88cf28ea19c9ad9defa365811ff8e11cf" $(DOWNLOAD_FILE) "$@" "bc43210dcd146d242bef4d354b0aeac12c4ef3118c07502d17ffa8d49e15aa2c"
distro/packages/bootstrap/i686-linux/guile-bootstrap-2.0.6.tar.xz: distro/packages/bootstrap/i686-linux/guile-2.0.7.tar.xz:
$(MKDIR_P) `dirname "$@"` $(MKDIR_P) `dirname "$@"`
$(DOWNLOAD_FILE) "$@" "93b537766dfab3ad287143523751e3ec02dd32d3ccaf88ad2d31c63158f342ee" $(DOWNLOAD_FILE) "$@" "f9a7c6f4c556eaafa2a69bcf07d4ffbb6682ea831d4c9da9ba095aca3ccd217c"
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm

4
build-aux/download.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,7 +35,7 @@
(match (string-tokenize file (char-set-complement (char-set #\/))) (match (string-tokenize file (char-set-complement (char-set #\/)))
((_ ... system basename) ((_ ... system basename)
(string->uri (string-append %url-base "/" system (string->uri (string-append %url-base "/" system
"/20121115/" basename))))) "/20130105/" basename)))))
(match (command-line) (match (command-line)
((_ file expected-hash) ((_ file expected-hash)

20
distro/packages/acl.scm
View file

@ -41,15 +41,19 @@
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
(alist-replace 'check (alist-cons-after
(lambda _ 'configure 'patch-makefile-SHELL
(patch-shebang "test/run") (lambda _
(system* "make" "tests" "-C" "test") (patch-makefile-SHELL "include/buildmacros"))
(alist-replace
'check
(lambda _
(system* "make" "tests" "-C" "test")
;; XXX: Ignore the test result since this is ;; XXX: Ignore the test result since this is
;; dependent on the underlying file system. ;; dependent on the underlying file system.
#t) #t)
%standard-phases))) %standard-phases))))
(inputs `(("attr" ,attr) (inputs `(("attr" ,attr)
("gettext" ,guix:gettext) ("gettext" ,guix:gettext)
("perl" ,perl))) ("perl" ,perl)))

40
distro/packages/attr.scm
View file

@ -41,23 +41,31 @@
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases
(alist-replace 'install (alist-cons-after
(lambda _ 'configure 'patch-makefile-SHELL
(zero? (system* "make" (lambda _
"install" (patch-makefile-SHELL "include/buildmacros"))
"install-lib" (alist-replace
"install-dev"))) 'install
(alist-replace 'check (lambda _
(lambda _ (zero? (system* "make"
(for-each patch-shebang "install"
(find-files "test" ".*")) "install-lib"
(system* "make" "tests" "-C" "test") "install-dev")))
(alist-replace
'check
(lambda _
;; Use the right shell.
(substitute* "test/run"
(("/bin/sh")
(which "bash")))
;; XXX: Ignore the test result since (system* "make" "tests" "-C" "test")
;; this is dependent on the underlying
;; file system. ;; XXX: Ignore the test result since this is dependent on the
#t) ;; underlying file system.
%standard-phases)))) #t)
%standard-phases)))))
(inputs `(("perl" ,perl) (inputs `(("perl" ,perl)
("gettext" ,guix:gettext))) ("gettext" ,guix:gettext)))
(home-page (home-page

34
distro/packages/autotools.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -99,9 +99,37 @@ Standards. Automake requires the use of Autoconf.")
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("m4" ,m4) (native-inputs `(("m4" ,m4)
("perl" ,perl))) ("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 (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" (inputs `(("patch/skip-tests"
,(search-patch "libtool-skip-tests.patch")))) ,(search-patch "libtool-skip-tests.patch"))))
(synopsis "GNU Libtool, a generic library support script") (synopsis "GNU Libtool, a generic library support script")

281
distro/packages/base.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -20,6 +20,7 @@
(define-module (distro packages base) (define-module (distro packages base)
#:use-module (guix licenses) #:use-module (guix licenses)
#:use-module (distro) #:use-module (distro)
#:use-module (distro packages acl)
#:use-module (distro packages bash) #:use-module (distro packages bash)
#:use-module (distro packages bootstrap) #:use-module (distro packages bootstrap)
#:use-module (distro packages compression) #:use-module (distro packages compression)
@ -97,6 +98,17 @@ lines.")
"13wlsb4sf5d5a82xjhxqmdvrrn36rmw5f0pl9qyb9zkvldnb7hra")))) "13wlsb4sf5d5a82xjhxqmdvrrn36rmw5f0pl9qyb9zkvldnb7hra"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "GNU sed, a batch stream editor") (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 (description
"Sed (stream editor) isn't really a true text editor or text processor. "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 Instead, it is used to filter text, i.e., it takes text input and performs
@ -252,19 +264,33 @@ The tools supplied with this package are:
(define-public coreutils (define-public coreutils
(package (package
(name "coreutils") (name "coreutils")
(version "8.19") (version "8.20")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/coreutils/coreutils-" (uri (string-append "mirror://gnu/coreutils/coreutils-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1rx9x3fp848w4nny7irdkcpkan9fcx24d99v5dkwgkyq7wc76f5d")))) "1cly97xdy3v4nbbx631k43smqw0nnpn651kkprs0yyl2cj3pkjyv"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `()) ; TODO: optional deps: SELinux, ACL, GMP (inputs `(("acl" ,acl)
("gmp" ,gmp)
("perl" ,perl))) ; TODO: add SELinux
(arguments (arguments
'(;; Perl is missing, and some tests are failing. `(#:parallel-build? #f ; help2man may be called too early
#:tests? #f)) #: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 (synopsis
"The basic file, shell and text manipulation utilities of the GNU "The basic file, shell and text manipulation utilities of the GNU
operating system") operating system")
@ -289,8 +315,18 @@ are expected to exist on every operating system.")
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("patch/impure-dirs" ,(search-patch "make-impure-dirs.patch")))) `(("patch/impure-dirs" ,(search-patch "make-impure-dirs.patch"))))
(arguments `(#:patches (list (assoc-ref %build-inputs (arguments
"patch/impure-dirs")))) '(#: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 (synopsis "GNU Make, a program controlling the generation of non-source
files from sources") files from sources")
(description (description
@ -317,6 +353,11 @@ that it is possible to use Make to build and install the program.")
"1a9w66v5dwvbnawshjwqcgz7km6kw6ihkzp6sswv9ycc3knzhykc")))) "1a9w66v5dwvbnawshjwqcgz7km6kw6ihkzp6sswv9ycc3knzhykc"))))
(build-system gnu-build-system) (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. ;; TODO: Add dependency on zlib + those for Gold.
(native-inputs (native-inputs
`(("patch/new-dtags" ,(search-patch "binutils-ld-new-dtags.patch")))) `(("patch/new-dtags" ,(search-patch "binutils-ld-new-dtags.patch"))))
@ -455,14 +496,14 @@ used in the GNU system including the GNU/Linux variant.")
(define-public glibc (define-public glibc
(package (package
(name "glibc") (name "glibc")
(version "2.16.0") (version "2.17")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/glibc/glibc-" (uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"092rdm49zh6l1pqkxbcpcaawgsgzxhpf1s7wf5wi5dvc5am3dp0y")))) "0gmjnn4kma9vgizccw1jv979xw55a8n1nkk94gg0l3hy80vy6539"))))
(build-system gnu-build-system) (build-system gnu-build-system)
;; Glibc's <limits.h> refers to <linux/limit.h>, for instance, so glibc ;; Glibc's <limits.h> refers to <linux/limit.h>, for instance, so glibc
@ -485,13 +526,20 @@ used in the GNU system including the GNU/Linux variant.")
;; GNU libc for details. ;; GNU libc for details.
"--enable-kernel=2.6.30" "--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'". ;; XXX: Work around "undefined reference to `__stack_chk_guard'".
"libc_cv_ssp=no") "libc_cv_ssp=no")
#:tests? #f ; XXX #:tests? #f ; XXX
#:phases (alist-cons-before #:phases (alist-cons-before
'configure 'pre-configure 'configure 'pre-configure
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
;; Use `pwd', not `/bin/pwd'. ;; Use `pwd', not `/bin/pwd'.
(substitute* "configure" (substitute* "configure"
(("/bin/pwd") "pwd")) (("/bin/pwd") "pwd"))
@ -509,10 +557,35 @@ used in the GNU system including the GNU/Linux variant.")
;; <http://www.linuxfromscratch.org/lfs/view/stable/chapter05/glibc.html>, ;; <http://www.linuxfromscratch.org/lfs/view/stable/chapter05/glibc.html>,
;; linking against libgcc_s is not needed with GCC ;; linking against libgcc_s is not needed with GCC
;; 4.7.1. ;; 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))) %standard-phases)))
(inputs `(("patch/ld.so.cache" (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") (synopsis "The GNU C Library")
(description (description
"Any Unix-like operating system needs a C library: the library which "Any Unix-like operating system needs a C library: the library which
@ -534,21 +607,23 @@ with the Linux kernel.")
(package (inherit gnu-make) (package (inherit gnu-make)
(name "make-boot0") (name "make-boot0")
(location (source-properties->location (current-source-location))) (location (source-properties->location (current-source-location)))
(arguments `(#:guile ,%bootstrap-guile (arguments
#:implicit-inputs? #f `(#:guile ,%bootstrap-guile
#:tests? #f ; cannot run "make check" #:implicit-inputs? #f
#:phases #:tests? #f ; cannot run "make check"
(alist-replace ,@(substitute-keyword-arguments (package-arguments gnu-make)
'build (lambda _ ((#:phases phases)
(zero? (system* "./build.sh"))) `(alist-replace
(alist-replace 'build (lambda _
'install (lambda* (#:key outputs #:allow-other-keys) (zero? (system* "./build.sh")))
(let* ((out (assoc-ref outputs "out")) (alist-replace
(bin (string-append out "/bin"))) 'install (lambda* (#:key outputs #:allow-other-keys)
(mkdir-p bin) (let* ((out (assoc-ref outputs "out"))
(copy-file "make" (bin (string-append out "/bin")))
(string-append bin "/make")))) (mkdir-p bin)
%standard-phases)))) (copy-file "make"
(string-append bin "/make"))))
,phases))))))
(inputs %bootstrap-inputs)))) (inputs %bootstrap-inputs))))
(define diffutils-boot0 (define diffutils-boot0
@ -728,82 +803,125 @@ identifier SYSTEM."
;; cross-`as'. ;; cross-`as'.
,@%boot0-inputs)) ,@%boot0-inputs))
(define-public glibc-final (define glibc-final-with-bootstrap-bash
;; The final libc, "cross-built". If everything went well, the resulting ;; 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-with-bootstrap-guile
(package (inherit glibc) (package (inherit glibc)
(name "glibc-intermediate")
(arguments (arguments
(lambda (system) (lambda (system)
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:implicit-inputs? #f #: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) ,@(substitute-keyword-arguments (package-arguments glibc)
((#:configure-flags flags) ((#:configure-flags flags)
`(append (list ,(string-append "--host=" (boot-triplet system)) `(append (list ,(string-append "--host=" (boot-triplet system))
,(string-append "--build=" ,(string-append "--build="
(nix-system->gnu-triplet system)) (nix-system->gnu-triplet system))
"BASH_SHELL=/bin/sh"
;; Build Sun/ONC RPC support. In particular, ;; Build Sun/ONC RPC support. In particular,
;; install rpc/*.h. ;; install rpc/*.h.
"--enable-obsolete-rpc") "--enable-obsolete-rpc")
,flags)))))) ,flags))))))
(propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0))) (propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0)))
(inputs `( ;; A native GCC is needed to build `cross-rpcgen'. (inputs
("native-gcc" ,@(assoc-ref %boot0-inputs "gcc")) `( ;; A native GCC is needed to build `cross-rpcgen'.
,@%boot1-inputs ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
,@(package-inputs glibc)))))) ; patches
(define gcc-boot0-wrapped ;; Here, we use the bootstrap Bash, which is not satisfactory
;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the ;; because we don't want to depend on bootstrap tools.
;; non-cross names. ("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) (package (inherit gcc-4.7)
(name (string-append (package-name gcc-boot0) "-wrapped")) (name (string-append (package-name gcc) "-wrapped"))
(source #f) (source #f)
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
(lambda (system) (lambda (system)
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:modules ((guix build utils)) #:modules ((guix build utils))
#:builder (begin #:builder (begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(let* ((binutils (assoc-ref %build-inputs "binutils")) (let* ((binutils (assoc-ref %build-inputs "binutils"))
(gcc (assoc-ref %build-inputs "gcc")) (gcc (assoc-ref %build-inputs "gcc"))
(libc (assoc-ref %build-inputs "libc")) (libc (assoc-ref %build-inputs "libc"))
(out (assoc-ref %outputs "out")) (bash (assoc-ref %build-inputs "bash"))
(bindir (string-append out "/bin")) (out (assoc-ref %outputs "out"))
(triplet ,(boot-triplet system))) (bindir (string-append out "/bin"))
(mkdir-p bindir) (triplet ,(boot-triplet system)))
(with-directory-excursion bindir (mkdir-p bindir)
(for-each (lambda (tool) (with-directory-excursion bindir
(symlink (string-append binutils "/bin/" (for-each (lambda (tool)
triplet "-" tool) (symlink (string-append binutils "/bin/"
tool)) triplet "-" tool)
'("ar" "ranlib")) tool))
'("ar" "ranlib"))
;; GCC-BOOT0 is a libc-less cross-compiler, so it ;; GCC-BOOT0 is a libc-less cross-compiler, so it
;; needs to be told where to find the crt files and ;; needs to be told where to find the crt files and
;; the dynamic linker. ;; the dynamic linker.
(call-with-output-file "gcc" (call-with-output-file "gcc"
(lambda (p) (lambda (p)
(format p "#!/bin/sh (format p "#!~a/bin/bash
exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
gcc triplet bash
libc libc gcc triplet
,(glibc-dynamic-linker system)))) libc libc
,(glibc-dynamic-linker system))))
(chmod "gcc" #o555))))))) (chmod "gcc" #o555)))))))
(native-inputs (native-inputs
`(("binutils" ,binutils-boot0) `(("binutils" ,binutils)
("gcc" ,gcc-boot0) ("gcc" ,gcc)
("libc" ,glibc-final))) ("libc" ,glibc)
("bash" ,bash)))
(inputs '()))) (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 (define %boot2-inputs
;; 3rd stage inputs. ;; 3rd stage inputs.
`(("libc" ,glibc-final) `(("libc" ,glibc-final)
@ -857,9 +975,10 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(source #f) (source #f)
(build-system trivial-build-system) (build-system trivial-build-system)
(inputs `(("binutils" ,binutils-final) (inputs `(("binutils" ,binutils-final)
("guile" ,%bootstrap-guile) ("guile" ,%bootstrap-guile)
("wrapper" ,(search-path %load-path ("bash" ,@(assoc-ref %boot2-inputs "bash"))
"distro/packages/ld-wrapper.scm")))) ("wrapper" ,(search-path %load-path
"distro/packages/ld-wrapper.scm"))))
(arguments (arguments
`(#:guile ,%bootstrap-guile `(#:guile ,%bootstrap-guile
#:modules ((guix build utils)) #:modules ((guix build utils))
@ -883,6 +1002,9 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(("@GUILE@") (("@GUILE@")
(string-append (assoc-ref %build-inputs "guile") (string-append (assoc-ref %build-inputs "guile")
"/bin/guile")) "/bin/guile"))
(("@BASH@")
(string-append (assoc-ref %build-inputs "bash")
"/bin/bash"))
(("@LD@") (("@LD@")
(string-append (assoc-ref %build-inputs "binutils") (string-append (assoc-ref %build-inputs "binutils")
"/bin/ld"))) "/bin/ld")))
@ -917,9 +1039,6 @@ store.")
,@(alist-delete "bash" %boot3-inputs))) ,@(alist-delete "bash" %boot3-inputs)))
(define-public guile-final (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-bootstrap-guile
(package-with-explicit-inputs guile-2.0/fixed (package-with-explicit-inputs guile-2.0/fixed
%boot4-inputs %boot4-inputs
@ -931,7 +1050,9 @@ store.")
(package (inherit ld-wrapper-boot3) (package (inherit ld-wrapper-boot3)
(name "ld-wrapper") (name "ld-wrapper")
(inputs `(("guile" ,guile-final) (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 (define-public %final-inputs
;; Final derivations used as implicit inputs by `gnu-build-system'. ;; Final derivations used as implicit inputs by `gnu-build-system'.

41
distro/packages/bash.scm
View file

@ -32,7 +32,13 @@
"-DSTANDARD_UTILS_PATH='\"/no-such-path\"'" "-DSTANDARD_UTILS_PATH='\"/no-such-path\"'"
"-DNON_INTERACTIVE_LOGIN_SHELLS" "-DNON_INTERACTIVE_LOGIN_SHELLS"
"-DSSH_SOURCE_BASHRC") "-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 (package
(name "bash") (name "bash")
(version "4.2") (version "4.2")
@ -67,15 +73,9 @@
;; for now. ;; for now.
#:tests? #f #:tests? #f
#:phases #:phases (alist-cons-after 'install 'post-install
(alist-cons-after 'install 'post-install ,post-install-phase
(lambda* (#:key outputs #:allow-other-keys) %standard-phases)))
;; Add a `bash' -> `sh' link.
(let ((out (assoc-ref outputs "out")))
(with-directory-excursion
(string-append out "/bin")
(symlink "bash" "sh"))))
%standard-phases)))
(synopsis "GNU Bourne-Again Shell") (synopsis "GNU Bourne-Again Shell")
(description (description
"Bash is the shell, or command language interpreter, that will appear in "Bash is the shell, or command language interpreter, that will appear in
@ -87,3 +87,24 @@ use. In addition, most sh scripts can be run by Bash without
modification.") modification.")
(license gpl3+) (license gpl3+)
(home-page "http://www.gnu.org/software/bash/")))) (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")))))))

4
distro/packages/bdb.scm
View file

@ -44,7 +44,9 @@
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
(zero? (zero?
(system* "./dist/configure" (system* "./dist/configure"
(string-append "--prefix=" out))))) (string-append "--prefix=" out)
(string-append "CONFIG_SHELL=" (which "bash"))
(string-append "SHELL=" (which "bash"))))))
%standard-phases)))) %standard-phases))))
(synopsis "db, the Berkeley database") (synopsis "db, the Berkeley database")
(description (description

33
distro/packages/bootstrap.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -167,7 +167,7 @@ check whether everything is alright."
(xz (->store "xz")) (xz (->store "xz"))
(mkdir (->store "mkdir")) (mkdir (->store "mkdir"))
(bash (->store "bash")) (bash (->store "bash"))
(guile (->store "guile-bootstrap-2.0.6.tar.xz")) (guile (->store "guile-2.0.7.tar.xz"))
(builder (builder
(add-text-to-store store (add-text-to-store store
"build-bootstrap-guile.sh" "build-bootstrap-guile.sh"
@ -205,15 +205,15 @@ $out/bin/guile --version~%"
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
%bootstrap-base-url "/" %bootstrap-base-url "/"
system "/20121115/static-binaries.tar.xz")) system "/20130105/static-binaries.tar.xz"))
(sha256 (sha256
(match system (match system
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"0azisn8l2b3cvgni9k0ahzsxs5cxrj0hmf38zgpq3k6pggk3zbfm")) "0md23alzy6nc5f16pric7mkagczdzr8xbh074sb3rjzrls06j1ls"))
("i686-linux" ("i686-linux"
(base32 (base32
"16v60frbh0naccanwxcxz0z3444dd8salbg8p7cp7vwz8245nhfk")))))) "0nzj1lmm9b94g7k737cr4w1dv282w5nmhb53238ikax9r6pkc0yb"))))))
"true" ; the program to test "true" ; the program to test
"Bootstrap binaries of Coreutils, Awk, etc.")) "Bootstrap binaries of Coreutils, Awk, etc."))
@ -224,15 +224,15 @@ $out/bin/guile --version~%"
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
%bootstrap-base-url "/" %bootstrap-base-url "/"
system "/20121115/binutils-2.22.tar.xz")) system "/20130105/binutils-2.22.tar.xz"))
(sha256 (sha256
(match system (match system
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"0ms6i035v40n7mhi91n4b8ivwv2qni3mcd5dj9sj9qmvgqb50r84")) "1ffmk2yy2pxvkqgzrkzp3s4jpn4qaaksyk3b5nsc5cjwfm7qkgzh"))
("i686-linux" ("i686-linux"
(base32 (base32
"193x62ach4l4x16rbzglrqa1d0a825z2as6czdiv9xjiizmcr0ad")))))) "1rafk6aq4sayvv3r3d2khn93nkyzf002xzh0xadlyci4mznr6b0a"))))))
"ld" ; the program to test "ld" ; the program to test
"Bootstrap binaries of the GNU Binutils")) "Bootstrap binaries of the GNU Binutils"))
@ -277,15 +277,15 @@ $out/bin/guile --version~%"
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append %bootstrap-base-url "/" system (uri (string-append %bootstrap-base-url "/" system
"/20121115/glibc-2.16.0.tar.xz")) "/20130105/glibc-2.17.tar.xz"))
(sha256 (sha256
(match system (match system
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"1cz587p3scrrx0zgqnmp4nnfj0vvf01zdqdgkz445dnbfh64nl0v")) "18kv1z9d8dr1j3hm9w7663kchqw9p6rsx11n1m143jgba2jz6jy3"))
("i686-linux" ("i686-linux"
(base32 (base32
"0vzybz1577vflm0p0zg1slqj32carj5102b45k7iskkj46viy14z")))))))))) "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88"))))))))))
(synopsis "Bootstrap binaries and headers of the GNU C Library") (synopsis "Bootstrap binaries and headers of the GNU C Library")
(description #f) (description #f)
(home-page #f))) (home-page #f)))
@ -348,15 +348,15 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
(origin (origin
(method url-fetch) (method url-fetch)
(uri (string-append %bootstrap-base-url "/" system (uri (string-append %bootstrap-base-url "/" system
"/20121115/gcc-4.7.2.tar.xz")) "/20130105/gcc-4.7.2.tar.xz"))
(sha256 (sha256
(match system (match system
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"0fg65i2qcym8ls5ig3g1cc9ida5cxwwsd6zi95xi1d8dnfrja4zz")) "1x1p7han5crnbw906iwdifykr6grzm0w27dy9gz75j0q1b32i4px"))
("i686-linux" ("i686-linux"
(base32 (base32
"01hlz98qmc8yhqrxqajpg5kbkhpvqq6wjnbfvplys32n895avzxg")))))))))) "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2"))))))))))
(synopsis "Bootstrap binaries of the GNU Compiler Collection") (synopsis "Bootstrap binaries of the GNU Compiler Collection")
(description #f) (description #f)
(home-page #f))) (home-page #f)))
@ -367,6 +367,9 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
`(("libc" ,%bootstrap-glibc) `(("libc" ,%bootstrap-glibc)
("gcc" ,%bootstrap-gcc) ("gcc" ,%bootstrap-gcc)
("binutils" ,%bootstrap-binutils) ("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 ;;; bootstrap.scm ends here

1
distro/packages/compression.scm
View file

@ -98,6 +98,7 @@ superior compression ratio of gzip is just a bonus.")
(build-shared-lib (build-shared-lib
;; Build a shared library. ;; Build a shared library.
'(lambda* (#:key inputs #:allow-other-keys) '(lambda* (#:key inputs #:allow-other-keys)
(patch-makefile-SHELL "Makefile-libbz2_so")
(zero? (system* "make" "-f" "Makefile-libbz2_so")))) (zero? (system* "make" "-f" "Makefile-libbz2_so"))))
(install-shared-lib (install-shared-lib
'(lambda* (#:key outputs #:allow-other-keys) '(lambda* (#:key outputs #:allow-other-keys)

31
distro/packages/gawk.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,15 +35,26 @@
(sha256 (sha256
(base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0")))) (base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (case-lambda (arguments
((system) (case-lambda
(if (string=? system "i686-cygwin") ((system)
'(#:tests? #f) ; work around test failure on Cygwin `(#:parallel-tests? #f ; test suite fails in parallel
'(#:parallel-tests? #f))) ; test suite fails in parallel
((system cross-system) ;; Work around test failure on Cygwin.
'(#:parallel-tests? #f)))) #:tests? ,(not (string=? system "i686-cygwin"))
(inputs `(("libsigsegv" ,libsigsegv) ; headers
("libsigsegv/lib" ,libsigsegv "lib"))) ; library #: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/") (home-page "http://www.gnu.org/software/gawk/")
(synopsis "GNU implementation of the Awk programming language") (synopsis "GNU implementation of the Awk programming language")
(description (description

15
distro/packages/gettext.scm
View file

@ -37,7 +37,20 @@
"1sa3ch12qxa4h3ya6hkz119yclcccmincl9j20dhrdx5mykp3b4k")))) "1sa3ch12qxa4h3ya6hkz119yclcccmincl9j20dhrdx5mykp3b4k"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (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 (inputs
`(("patch/gets" `(("patch/gets"
,(search-patch "gettext-gets-undeclared.patch")))) ,(search-patch "gettext-gets-undeclared.patch"))))

20
distro/packages/guile.scm
View file

@ -120,6 +120,16 @@ extensible. It supports many SRFIs.")
(self-native-input? #t) (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") (synopsis "GNU Guile 2.0, an embeddable Scheme implementation")
(description (description
"GNU Guile is an implementation of the Scheme programming language, with "GNU Guile is an implementation of the Scheme programming language, with
@ -134,15 +144,7 @@ call interface, and powerful string processing.")
(define-public guile-2.0/fixed (define-public guile-2.0/fixed
;; A package of Guile 2.0 that's rarely changed. It is the one used ;; 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. ;; in the `base' module, and thus changing it entails a full rebuild.
(package (inherit guile-2.0) 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"))))))
;;; ;;;

18
distro/packages/ld-wrapper.scm
View file

@ -1,4 +1,4 @@
#!/bin/sh #!@BASH@
# -*- mode: scheme; coding: utf-8; -*- # -*- mode: scheme; coding: utf-8; -*-
# XXX: We have to go through Bash because there's no command-line switch to # 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 # Use `load-compiled' because `load' (and `-l') doesn't otherwise load our
# .go file (see <http://bugs.gnu.org/12519>). # .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)))" "$@" exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "$@"
!# !#
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; GNU Guix --- Functional package management for GNU
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> ;;; 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 ;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at ;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version. ;;; 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 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; 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) #:use-module (srfi srfi-1)
#:export (ld-wrapper)) #:export (ld-wrapper))

3
distro/packages/libsigsegv.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,7 +35,6 @@
(sha256 (sha256
(base32 "16hrs8k3nmc7a8jam5j1fpspd6sdpkamskvsdpcw6m29vnis8q44")))) (base32 "16hrs8k3nmc7a8jam5j1fpspd6sdpkamskvsdpcw6m29vnis8q44"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "lib")) ; separate libdir from the rest
(home-page "http://www.gnu.org/software/libsigsegv/") (home-page "http://www.gnu.org/software/libsigsegv/")
(synopsis "GNU libsigsegv, a library to handle page faults in user mode") (synopsis "GNU libsigsegv, a library to handle page faults in user mode")
(description (description

11
distro/packages/linux.scm
View file

@ -33,8 +33,13 @@
(define-public linux-libre-headers (define-public linux-libre-headers
(let* ((version* "3.3.8") (let* ((version* "3.3.8")
(build-phase (build-phase
'(lambda* (#:key outputs #:allow-other-keys) '(lambda* (#:key system #:allow-other-keys)
(setenv "ARCH" "x86_64") ; XXX (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")) (and (zero? (system* "make" "defconfig"))
(zero? (system* "make" "mrproper" "headers_check"))))) (zero? (system* "make" "mrproper" "headers_check")))))
(install-phase (install-phase
@ -193,4 +198,4 @@ providing the system administrator with some help in common tasks.")
"Tools for working with USB devices, such as lsusb") "Tools for working with USB devices, such as lsusb")
(description (description
"Tools for working with USB devices, such as lsusb.") "Tools for working with USB devices, such as lsusb.")
(license gpl2+))) (license gpl2+)))

5
distro/packages/lsh.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -114,8 +114,7 @@
(substitute* "src/testsuite/login-auth-test" (substitute* "src/testsuite/login-auth-test"
(("/bin/cat") (("/bin/cat")
;; Use the right path to `cat'. ;; Use the right path to `cat'.
(search-path (search-path-as-string->list (getenv "PATH")) (which "cat"))))
"cat"))))
%standard-phases))) %standard-phases)))
(home-page "http://www.lysator.liu.se/~nisse/lsh/") (home-page "http://www.lysator.liu.se/~nisse/lsh/")
(synopsis (synopsis

14
distro/packages/m4.scm
View file

@ -46,7 +46,19 @@
#:patches (list (assoc-ref %build-inputs "patch/s_isdir") #:patches (list (assoc-ref %build-inputs "patch/s_isdir")
(assoc-ref %build-inputs (assoc-ref %build-inputs
"patch/readlink-EINVAL") "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) ((system cross-system)
`(#:patches (list (assoc-ref %build-inputs "patch/s_isdir") `(#:patches (list (assoc-ref %build-inputs "patch/s_isdir")
(assoc-ref %build-inputs (assoc-ref %build-inputs

300
distro/packages/make-bootstrap.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,7 +19,9 @@
(define-module (distro packages make-bootstrap) (define-module (distro packages make-bootstrap)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
#:use-module ((distro) #:select (search-patch)) #:use-module ((distro) #:select (search-patch))
#:use-module (distro packages base) #:use-module (distro packages base)
#:use-module (distro packages bash) #:use-module (distro packages bash)
@ -29,11 +31,13 @@
#:use-module (distro packages linux) #:use-module (distro packages linux)
#:use-module (distro packages multiprecision) #:use-module (distro packages multiprecision)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (%bootstrap-binaries-tarball #:export (%bootstrap-binaries-tarball
%binutils-bootstrap-tarball %binutils-bootstrap-tarball
%glibc-bootstrap-tarball %glibc-bootstrap-tarball
%gcc-bootstrap-tarball %gcc-bootstrap-tarball
%guile-bootstrap-tarball)) %guile-bootstrap-tarball
%bootstrap-tarballs))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -43,48 +47,38 @@
;;; ;;;
;;; Code: ;;; Code:
(define* (static-package p #:optional (loc (current-source-location))) (define %glibc-for-bootstrap
"Return a statically-linked version of package P." ;; A libc whose `system' and `popen' functions looks for `sh' in $PATH,
;; TODO: Move to (guix build-system gnu). ;; without nscd, and with static NSS modules.
(let ((args (package-arguments p))) (package (inherit glibc-final)
(package (inherit p) (arguments
(location (source-properties->location loc)) (lambda (system)
(arguments (substitute-keyword-arguments ((package-arguments glibc-final) system)
(let ((augment (lambda (args) ((#:patches patches)
(let ((a (default-keyword-arguments args `(cons (assoc-ref %build-inputs "patch/system")
'(#:configure-flags '() ,patches))
#:strip-flags #f)))) ((#:configure-flags flags)
(substitute-keyword-arguments a ;; Arrange so that getaddrinfo & co. do not contact the nscd,
((#:configure-flags flags) ;; and can use statically-linked NSS modules.
`(cons* "--disable-shared" `(cons* "--disable-nscd" "--disable-build-nscd"
"LDFLAGS=-static" "--enable-static-nss"
,flags)) ,flags)))))
((#:strip-flags _) (inputs
''("--strip-all"))))))) `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
(if (procedure? args) ,@(package-inputs glibc-final)))))
(lambda x
(augment (apply args x))) (define %standard-inputs-with-relocatable-glibc
(augment args))))))) ;; 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 (define %bash-static
(let ((bash-light (package (inherit bash-final) (static-package 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"))))))))
(static-package bash-light)))
(define %static-inputs (define %static-inputs
;; Packages that are to be used as %BOOTSTRAP-INPUTS. ;; Packages that are to be used as %BOOTSTRAP-INPUTS.
@ -94,8 +88,13 @@
'("--disable-nls" '("--disable-nls"
"--disable-silent-rules" "--disable-silent-rules"
"--enable-no-install-program=stdbuf,libstdbuf.so" "--enable-no-install-program=stdbuf,libstdbuf.so"
"CFLAGS=-Os -g0" ; smaller, please
"LDFLAGS=-static -pthread") "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) (bzip2 (package (inherit bzip2)
(arguments (arguments
(substitute-keyword-arguments (package-arguments bzip2) (substitute-keyword-arguments (package-arguments bzip2)
@ -121,18 +120,27 @@
(gawk (package (inherit gawk) (gawk (package (inherit gawk)
(arguments (arguments
(lambda (system) (lambda (system)
`(#:phases (alist-cons-before `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
'build 'no-export-dynamic ,@(substitute-keyword-arguments
(lambda* (#:key outputs #:allow-other-keys) ((package-arguments gawk) system)
;; Since we use `-static', remove ((#:phases phases)
;; `-export-dynamic'. `(alist-cons-before
(substitute* "configure" 'configure 'no-export-dynamic
(("-export-dynamic") ""))) (lambda _
%standard-phases) ;; Since we use `-static', remove
,@((package-arguments gawk) system))))))) ;; `-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 `(,@(map (match-lambda
((name package) ((name package)
(list name (static-package package (current-source-location))))) (list name (finalize package))))
`(("tar" ,tar) `(("tar" ,tar)
("gzip" ,gzip) ("gzip" ,gzip)
("bzip2" ,bzip2) ("bzip2" ,bzip2)
@ -272,84 +280,87 @@
;; GNU libc's essential shared libraries, dynamic linker, and headers, ;; GNU libc's essential shared libraries, dynamic linker, and headers,
;; with all references to store directories stripped. As a result, ;; with all references to store directories stripped. As a result,
;; libc.so is unusable and need to be patched for proper relocation. ;; libc.so is unusable and need to be patched for proper relocation.
(package (inherit glibc-final) (let ((glibc %glibc-for-bootstrap))
(name "glibc-stripped") (package (inherit glibc)
(build-system trivial-build-system) (name "glibc-stripped")
(arguments (build-system trivial-build-system)
`(#:modules ((guix build utils)) (arguments
#:builder `(#:modules ((guix build utils))
(begin #:builder
(use-modules (guix build utils)) (begin
(use-modules (guix build utils))
(setvbuf (current-output-port) _IOLBF) (setvbuf (current-output-port) _IOLBF)
(let* ((out (assoc-ref %outputs "out")) (let* ((out (assoc-ref %outputs "out"))
(libdir (string-append out "/lib")) (libdir (string-append out "/lib"))
(incdir (string-append out "/include")) (incdir (string-append out "/include"))
(libc (assoc-ref %build-inputs "libc")) (libc (assoc-ref %build-inputs "libc"))
(linux (assoc-ref %build-inputs "linux-headers"))) (linux (assoc-ref %build-inputs "linux-headers")))
(mkdir-p libdir) (mkdir-p libdir)
(for-each (lambda (file) (for-each (lambda (file)
(let ((target (string-append libdir "/" (let ((target (string-append libdir "/"
(basename file)))) (basename file))))
(copy-file file target) (copy-file file target)
(remove-store-references target))) (remove-store-references target)))
(find-files (string-append libc "/lib") (find-files (string-append libc "/lib")
"^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$")) "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
(copy-recursively (string-append libc "/include") incdir) (copy-recursively (string-append libc "/include") incdir)
;; Copy some of the Linux-Libre headers that glibc headers ;; Copy some of the Linux-Libre headers that glibc headers
;; refer to. ;; refer to.
(mkdir (string-append incdir "/linux")) (mkdir (string-append incdir "/linux"))
(for-each (lambda (file) (for-each (lambda (file)
(copy-file (string-append linux "/include/linux/" file) (copy-file (string-append linux "/include/linux/" file)
(string-append incdir "/linux/" (string-append incdir "/linux/"
(basename file)))) (basename file))))
'("limits.h" "errno.h" "socket.h" "kernel.h" '("limits.h" "errno.h" "socket.h" "kernel.h"
"sysctl.h" "param.h" "ioctl.h" "types.h" "sysctl.h" "param.h" "ioctl.h" "types.h"
"posix_types.h" "stddef.h")) "posix_types.h" "stddef.h"))
(copy-recursively (string-append linux "/include/asm") (copy-recursively (string-append linux "/include/asm")
(string-append incdir "/asm")) (string-append incdir "/asm"))
(copy-recursively (string-append linux "/include/asm-generic") (copy-recursively (string-append linux "/include/asm-generic")
(string-append incdir "/asm-generic")) (string-append incdir "/asm-generic"))
#t)))) #t))))
(inputs `(("libc" ,glibc-final) (inputs `(("libc" ,glibc)
("linux-headers" ,linux-libre-headers))))) ("linux-headers" ,linux-libre-headers))))))
(define %gcc-static (define %gcc-static
;; A statically-linked GCC, with stripped-down functionality. ;; A statically-linked GCC, with stripped-down functionality.
(package (inherit gcc-final) (package-with-explicit-inputs
(name "gcc-static") (package (inherit gcc-final)
(arguments (name "gcc-static")
(lambda (system) (arguments
`(#:modules ((guix build utils) (lambda (system)
(guix build gnu-build-system) `(#:modules ((guix build utils)
(srfi srfi-1) (guix build gnu-build-system)
(srfi srfi-26) (srfi srfi-1)
(ice-9 regex)) (srfi srfi-26)
,@(substitute-keyword-arguments ((package-arguments gcc-final) system) (ice-9 regex))
((#:guile _) #f) ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
((#:implicit-inputs? _) #t) ((#:guile _) #f)
((#:configure-flags flags) ((#:implicit-inputs? _) #t)
`(append (list ((#:configure-flags flags)
"--disable-shared" `(append (list
"--disable-plugin" "--disable-shared"
"--enable-languages=c" "--disable-plugin"
"--disable-libmudflap" "--enable-languages=c"
"--disable-libgomp" "--disable-libmudflap"
"--disable-libssp" "--disable-libgomp"
"--disable-libquadmath" "--disable-libssp"
"--disable-decimal-float") "--disable-libquadmath"
(remove (cut string-match "--(.*plugin|enable-languages)" <>) "--disable-decimal-float")
,flags))) (remove (cut string-match "--(.*plugin|enable-languages)" <>)
((#:make-flags flags) ,flags)))
`(cons "BOOT_LDFLAGS=-static" ,flags)))))) ((#:make-flags flags)
(inputs `(("gmp-source" ,(package-source gmp)) `(cons "BOOT_LDFLAGS=-static" ,flags))))))
("mpfr-source" ,(package-source mpfr)) (inputs `(("gmp-source" ,(package-source gmp))
("mpc-source" ,(package-source mpc)) ("mpfr-source" ,(package-source mpfr))
("binutils" ,binutils-final) ("mpc-source" ,(package-source mpc))
,@(package-inputs gcc-4.7))))) ("binutils" ,binutils-final)
,@(package-inputs gcc-4.7))))
%standard-inputs-with-relocatable-glibc))
(define %gcc-stripped (define %gcc-stripped
;; The subset of GCC files needed for bootstrap. ;; The subset of GCC files needed for bootstrap.
@ -429,7 +440,9 @@
;; There are uses of `dynamic-link' in ;; There are uses of `dynamic-link' in
;; {foreign,coverage}.test that don't fly here. ;; {foreign,coverage}.test that don't fly here.
#:tests? #f))))) #: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 (define %guile-static-stripped
;; A stripped static Guile binary, for use during bootstrap. ;; A stripped static Guile binary, for use during bootstrap.
@ -509,4 +522,41 @@
;; A tarball with the statically-linked, relocatable Guile. ;; A tarball with the statically-linked, relocatable Guile.
(tarball-package %guile-static-stripped)) (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 ;;; make-bootstrap.scm ends here

29
distro/packages/multiprecision.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -28,14 +28,18 @@
(define-public gmp (define-public gmp
(package (package
(name "gmp") (name "gmp")
(version "5.0.5") (version "5.1.0")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/gmp/gmp-" version (uri
".tar.bz2")) ;; 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 (sha256
(base32 (base32
"1jfymbr90mpn0zw5sg001llqnvf2462y77vgjknrmfs1rjn8ln0z")))) "15n7xxgasbxdch8ii8z9ic6fxc2ysk3q8iavf55abjp5iylspnfz"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("m4" ,m4))) (native-inputs `(("m4" ,m4)))
(arguments `(#:configure-flags (arguments `(#:configure-flags
@ -96,14 +100,13 @@ double-precision floating-point arithmetic (53-bit mantissa).")
(define-public mpc (define-public mpc
(package (package
(name "mpc") (name "mpc")
(version "1.0") (version "1.0.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://www.multiprecision.org/mpc/download/mpc-" "mirror://gnu/mpc/mpc-" version ".tar.gz"))
version ".tar.gz"))
(sha256 (base32 (sha256 (base32
"00rxjmkpqnv6zzcyw9aa5w6rzaav32ys87km25zgfcv9i32km5cw")))) "1zq0fidp1jii2j5k5n9hmx55a6wwid33gjzhimvxq9d5zrf82npd"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("gmp" ,gmp) (inputs `(("gmp" ,gmp)
("mpfr" ,mpfr))) ("mpfr" ,mpfr)))
@ -111,7 +114,11 @@ double-precision floating-point arithmetic (53-bit mantissa).")
with exact rounding") with exact rounding")
(description (description
"GNU MPC is a C library for the arithmetic of complex numbers with "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 arbitrarily high precision and correct rounding of the result. It extends
upon and follows the same principles as GNU MPFR.") 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+) (license lgpl3+)
(home-page "http://mpc.multiprecision.org/"))) (home-page "http://mpc.multiprecision.org/")))

39
distro/packages/ncurses.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -24,7 +24,26 @@
#:use-module (guix build-system gnu)) #:use-module (guix build-system gnu))
(define-public ncurses (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) '(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
;; When building a wide-character (Unicode) build, create backward ;; When building a wide-character (Unicode) build, create backward
@ -81,13 +100,15 @@
'("--without-cxx-binding") '("--without-cxx-binding")
'())) '()))
#:tests? #f ; no "check" target #:tests? #f ; no "check" target
#:phases (alist-cons-after 'install 'post-install #:phases (alist-cons-after
,post-install-phase 'install 'post-install ,post-install-phase
%standard-phases) (alist-cons-before
'configure 'patch-makefile-SHELL
;; The `ncursesw5-config' has a #!/bin/sh that we don't want to ,patch-makefile-phase
;; patch, to avoid retaining a reference to the build-time Bash. (alist-replace
#:patch-shebangs? #f)) 'configure
,configure-phase
%standard-phases)))))
((system cross-system) ((system cross-system)
(arguments cross-system)))) (arguments cross-system))))
(self-native-input? #t) (self-native-input? #t)

68
distro/packages/openssl.scm Normal file
View file

@ -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/")))

34
distro/packages/patches/gawk-shell.patch Normal file
View file

@ -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__ */

28
distro/packages/patches/glibc-bootstrap-system.patch Normal file
View file

@ -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);

12
distro/packages/perl.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -46,16 +46,14 @@
'configure 'configure
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")) (let ((out (assoc-ref outputs "out"))
(libc (assoc-ref inputs "libc")) (libc (assoc-ref inputs "libc")))
(pwd (search-path (search-path-as-string->list
(getenv "PATH"))
"pwd")))
;; Use the right path for `pwd'. ;; Use the right path for `pwd'.
(substitute* "dist/Cwd/Cwd.pm" (substitute* "dist/Cwd/Cwd.pm"
(("/bin/pwd") pwd)) (("/bin/pwd")
(which "pwd")))
(zero? (zero?
(system* "/bin/sh" "./Configure" (system* "./Configure"
(string-append "-Dprefix=" out) (string-append "-Dprefix=" out)
(string-append "-Dman1dir=" out "/share/man/man1") (string-append "-Dman1dir=" out "/share/man/man1")
(string-append "-Dman3dir=" out "/share/man/man3") (string-append "-Dman3dir=" out "/share/man/man3")

80
distro/packages/readline.scm
View file

@ -26,44 +26,46 @@
#:use-module (guix build-system gnu)) #:use-module (guix build-system gnu))
(define-public readline (define-public readline
(package (let ((post-install-phase
(name "readline") '(lambda* (#:key outputs #:allow-other-keys)
(version "6.2") (let* ((out (assoc-ref outputs "out"))
(source (origin (lib (string-append out "/lib")))
(method url-fetch) ;; Make libraries writable so that `strip' can work.
(uri (string-append "mirror://gnu/readline/readline-" ;; Failing to do that, it bails out with "Permission
version ".tar.gz")) ;; denied".
(sha256 (for-each (lambda (f) (chmod f #o755))
(base32 (find-files lib "\\.so"))
"10ckm2bd2rkxhvdmj7nmbsylmihw0abwcsnxf8y27305183rd9kr")))) (for-each (lambda (f) (chmod f #o644))
(build-system gnu-build-system) (find-files lib "\\.a"))))))
(propagated-inputs `(("ncurses" ,ncurses))) (package
(inputs `(("patch/link-ncurses" (name "readline")
,(search-patch "readline-link-ncurses.patch")))) (version "6.2")
(arguments `(#:patches (list (assoc-ref %build-inputs (source (origin
"patch/link-ncurses")) (method url-fetch)
#:patch-flags '("-p0") (uri (string-append "mirror://gnu/readline/readline-"
#:configure-flags version ".tar.gz"))
(list (string-append "LDFLAGS=-Wl,-rpath -Wl," (sha256
(assoc-ref %build-inputs "ncurses") (base32
"/lib")) "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 #:phases (alist-cons-after
'install 'post-install 'install 'post-install
(lambda* (#:key outputs #:allow-other-keys) ,post-install-phase
(let* ((out (assoc-ref outputs "out")) %standard-phases)))
(lib (string-append out "/lib"))) (synopsis "GNU Readline, a library for interactive line editing")
;; Make libraries writable so that `strip' can (description
;; work. Failing to do that, it bails out with "The GNU Readline library provides a set of functions for use by
;; "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
applications that allow users to edit command lines as they are typed in. 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 Both Emacs and vi editing modes are available. The Readline library includes
additional functions to maintain a list of previously-entered command lines, additional functions to maintain a list of previously-entered command lines,
@ -73,5 +75,5 @@ expansion on previous commands.
The history facilites are also placed into a separate library, the History 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 library, as part of the build process. The History library may be used
without Readline in applications which desire its capabilities.") without Readline in applications which desire its capabilities.")
(license gpl3+) (license gpl3+)
(home-page "http://savannah.gnu.org/projects/readline/"))) (home-page "http://savannah.gnu.org/projects/readline/"))))

18
distro/packages/time.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -35,6 +36,18 @@
(base32 (base32
"0va9063fcn7xykv658v2s9gilj2fq4rcdxx2mn2mmy1v4ndafzp3")))) "0va9063fcn7xykv658v2s9gilj2fq4rcdxx2mn2mmy1v4ndafzp3"))))
(build-system gnu-build-system) (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/") (home-page "http://www.gnu.org/software/time/")
(synopsis (synopsis
"GNU Time, a tool that runs programs and summarizes the system "GNU Time, a tool that runs programs and summarizes the system
@ -49,6 +62,5 @@ in a file instead of displaying it on the screen.
The resources that 'time' can report on fall into the general categories 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 of time, memory, and I/O and IPC calls. Some systems do not provide
much information about program resource use; 'time' reports unavailable much information about program resource use; 'time' reports unavailable
information as zero values. information as zero values.")
") (license gpl2+)))
(license gpl2+)))

2
doc/guix.texi
View file

@ -444,7 +444,7 @@ Install @var{package}.
@code{guile}, or a package name followed by a hyphen and version number, @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 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 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} @item --remove=@var{package}
@itemx -r @var{package} @itemx -r @var{package}

28
guix/build-system/gnu.scm
View file

@ -21,6 +21,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-39) #:use-module (srfi srfi-39)
@ -29,7 +30,8 @@
gnu-build-system gnu-build-system
package-with-explicit-inputs package-with-explicit-inputs
package-with-extra-configure-variable package-with-extra-configure-variable
static-libgcc-package)) static-libgcc-package
static-package))
;; Commentary: ;; Commentary:
;; ;;
@ -117,6 +119,28 @@ configure flags for VARIABLE, the associated value is augmented."
"A version of P linked with `-static-gcc'." "A version of P linked with `-static-gcc'."
(package-with-extra-configure-variable p "LDFLAGS" "-static-libgcc")) (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 (define %store
;; Store passed to STANDARD-INPUTS. ;; Store passed to STANDARD-INPUTS.
@ -152,6 +176,7 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
(out-of-source? #f) (out-of-source? #f)
(path-exclusions ''()) (path-exclusions ''())
(tests? #t) (tests? #t)
(test-target "check")
(parallel-build? #t) (parallel-tests? #t) (parallel-build? #t) (parallel-tests? #t)
(patch-shebangs? #t) (patch-shebangs? #t)
(strip-binaries? #t) (strip-binaries? #t)
@ -193,6 +218,7 @@ which could lead to gratuitous input divergence."
#:out-of-source? ,out-of-source? #:out-of-source? ,out-of-source?
#:path-exclusions ,path-exclusions #:path-exclusions ,path-exclusions
#:tests? ,tests? #:tests? ,tests?
#:test-target ,test-target
#:parallel-build? ,parallel-build? #:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests? #:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs? #:patch-shebangs? ,patch-shebangs?

84
guix/build/download.scm
View file

@ -1,20 +1,20 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; GNU Guix --- Functional package management for GNU
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> ;;; 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 ;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at ;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version. ;;; 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 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; 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) (define-module (guix build download)
#:use-module (web uri) #:use-module (web uri)
@ -27,6 +27,7 @@
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (url-fetch)) #:export (url-fetch))
;;; Commentary: ;;; Commentary:
@ -35,17 +36,58 @@
;;; ;;;
;;; Code: ;;; 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) (define (ftp-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success." "Fetch data from URI and write it to FILE. Return FILE on success."
(let* ((conn (ftp-open (uri-host uri))) (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)) (in (ftp-retr conn (basename (uri-path uri))
(dirname (uri-path uri))))) (dirname (uri-path uri)))))
(call-with-output-file file (call-with-output-file file
(lambda (out) (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)) (ftp-close conn))
(newline)
file) file)
(define (open-connection-for-uri uri) (define (open-connection-for-uri uri)
@ -103,20 +145,34 @@ which is not available during bootstrap."
(define (http-fetch uri file) (define (http-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success." "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) (let*-values (((connection)
(open-connection-for-uri uri)) (open-connection-for-uri uri))
((resp bv) ((resp bv-or-port)
(http-get uri #:port connection #:decode-body? #f)) ;; 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) ((code)
(response-code resp))) (response-code resp))
((size)
(response-content-length resp)))
(case code (case code
((200) ; OK ((200) ; OK
(begin (begin
(call-with-output-file file (call-with-output-file file
(lambda (p) (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)) file))
((302) ; found (redirection) ((302) ; found (redirection)
(let ((uri (response-location resp))) (let ((uri (response-location resp)))

90
guix/build/gnu-build-system.scm
View file

@ -1,25 +1,26 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; GNU Guix --- Functional package management for GNU
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> ;;; 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 ;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at ;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version. ;;; 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 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; 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) (define-module (guix build gnu-build-system)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (%standard-phases #:export (%standard-phases
@ -82,6 +83,28 @@
(and (zero? (system* "tar" "xvf" source)) (and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory ".")))) (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")) (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
#:allow-other-keys) #:allow-other-keys)
(every (lambda (p) (every (lambda (p)
@ -90,23 +113,51 @@
(append patch-flags (list "--input" p))))) (append patch-flags (list "--input" p)))))
patches)) patches))
(define* (configure #:key outputs (configure-flags '()) out-of-source? (define* (configure #:key inputs outputs (configure-flags '()) out-of-source?
#:allow-other-keys) #: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")) (let* ((prefix (assoc-ref outputs "out"))
(bindir (assoc-ref outputs "bin"))
(libdir (assoc-ref outputs "lib")) (libdir (assoc-ref outputs "lib"))
(includedir (assoc-ref outputs "include")) (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 "--enable-fast-install" ; when using Libtool
;; Produce multiple outputs when specific output names ;; Produce multiple outputs when specific output names
;; are recognized. ;; are recognized.
,@(if bindir
(list (string-append "--bindir=" bindir "/bin"))
'())
,@(if libdir ,@(if libdir
(list (string-append "--libdir=" libdir "/lib")) (cons (string-append "--libdir=" libdir "/lib")
(if includedir
'()
(list
(string-append "--includedir="
libdir "/include"))))
'()) '())
,@(if includedir ,@(if includedir
(list (string-append "--includedir=" (list (string-append "--includedir="
includedir "/include")) includedir "/include"))
'()) '())
,@(if docdir
(list (string-append "--docdir=" docdir
"/doc/" (package-name)))
'())
,@configure-flags)) ,@configure-flags))
(abs-srcdir (getcwd)) (abs-srcdir (getcwd))
(srcdir (if out-of-source? (srcdir (if out-of-source?
@ -121,10 +172,15 @@
(format #t "build directory: ~s~%" (getcwd)) (format #t "build directory: ~s~%" (getcwd))
(format #t "configure flags: ~s~%" flags) (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 ;; Call `configure' with a relative path. Otherwise, GCC's build system
;; (for instance) records absolute source file names, which typically ;; (for instance) records absolute source file names, which typically
;; contain the hash part of the `.drv' file, leading to a reference leak. ;; contain the hash part of the `.drv' file, leading to a reference leak.
(zero? (apply system* (zero? (apply system* bash
(string-append srcdir "/configure") (string-append srcdir "/configure")
flags)))) flags))))
@ -221,7 +277,9 @@
;; Standard build phases, as a list of symbol/procedure pairs. ;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules () (let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...))))) ((_ 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))) patch-shebangs strip)))
@ -232,11 +290,17 @@
"Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES "Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
in order. Return #t if all the PHASES succeeded, #f otherwise." in order. Return #t if all the PHASES succeeded, #f otherwise."
(setvbuf (current-output-port) _IOLBF) (setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
;; The trick is to #:allow-other-keys everywhere, so that each procedure in ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
;; PHASES can pick the keyword arguments it's interested in. ;; PHASES can pick the keyword arguments it's interested in.
(every (match-lambda (every (match-lambda
((name . proc) ((name . proc)
(format #t "starting phase `~a'~%" name) (let ((start (gettimeofday)))
(apply proc args))) (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)) phases))

12
guix/build/union.scm
View file

@ -1,20 +1,20 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; GNU Guix --- Functional package management for GNU
;;; Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; 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 ;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at ;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version. ;;; 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 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; 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) (define-module (guix build union)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)

182
guix/build/utils.scm
View file

@ -1,20 +1,20 @@
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; GNU Guix --- Functional package management for GNU
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> ;;; 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 ;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at ;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version. ;;; 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 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details. ;;; GNU General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;; 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) (define-module (guix build utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -26,6 +26,8 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (directory-exists? #:export (directory-exists?
executable-file?
call-with-ascii-input-file
with-directory-excursion with-directory-excursion
mkdir-p mkdir-p
copy-recursively copy-recursively
@ -34,6 +36,8 @@
set-path-environment-variable set-path-environment-variable
search-path-as-string->list search-path-as-string->list
list->search-path-as-string list->search-path-as-string
which
alist-cons-before alist-cons-before
alist-cons-after alist-cons-after
alist-replace alist-replace
@ -41,7 +45,9 @@
substitute substitute
substitute* substitute*
dump-port dump-port
set-file-time
patch-shebang patch-shebang
patch-makefile-SHELL
fold-port-matches fold-port-matches
remove-store-references)) remove-store-references))
@ -56,6 +62,27 @@
(and s (and s
(eq? 'directory (stat:type 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 ...) (define-syntax-rule (with-directory-excursion dir body ...)
"Run BODY with DIR as the process's current directory." "Run BODY with DIR as the process's current directory."
(let ((init (getcwd))) (let ((init (getcwd)))
@ -189,6 +216,12 @@ SEPARATOR-separated path accordingly. Example:
(format #t "environment variable `~a' set to `~a'~%" (format #t "environment variable `~a' set to `~a'~%"
env-var value))) 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. ;;; Phases.
@ -364,29 +397,49 @@ all subject to the substitutions."
;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh. ;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh.
;;; ;;;
(define (dump-port in out) (define* (dump-port in out
"Read as much data as possible from IN and write it to OUT." #:key (buffer-size 16384)
(define buffer-size 4096) (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 (define buffer
(make-bytevector buffer-size)) (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) (or (eof-object? bytes)
(begin (let ((total (+ total bytes)))
(put-bytevector out buffer 0 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 (define patch-shebang
(let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$"))) (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$")))
(lambda* (file (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 "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 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) (define (patch p interpreter rest-of-line)
(let* ((template (string-append file ".XXXXXX")) (let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template)) (out (mkstemp! template))
(mode (stat:mode (stat file)))) (st (stat file))
(mode (stat:mode st)))
(with-throw-handler #t (with-throw-handler #t
(lambda () (lambda ()
(format out "#!~a~a~%" (format out "#!~a~a~%"
@ -395,6 +448,8 @@ patched, #f otherwise."
(close out) (close out)
(chmod template mode) (chmod template mode)
(rename-file template file) (rename-file template file)
(when keep-mtime?
(set-file-time file st))
#t) #t)
(lambda (key . args) (lambda (key . args)
(format (current-error-port) (format (current-error-port)
@ -403,30 +458,60 @@ patched, #f otherwise."
(false-if-exception (delete-file template)) (false-if-exception (delete-file template))
#f)))) #f))))
(with-fluids ((%default-port-encoding #f)) ; ASCII (call-with-ascii-input-file file
(call-with-input-file file (lambda (p)
(lambda (p) (and (eq? #\# (read-char p))
(and (eq? #\# (read-char p)) (eq? #\! (read-char p))
(eq? #\! (read-char p)) (let ((line (false-if-exception (read-line p))))
(let ((line (false-if-exception (read-line p)))) (and=> (and line (regexp-exec shebang-rx line))
(and=> (and line (regexp-exec shebang-rx line)) (lambda (m)
(lambda (m) (let* ((cmd (match:substring m 1))
(let* ((cmd (match:substring m 1)) (bin (search-path path (basename cmd))))
(bin (search-path path (if bin
(basename cmd)))) (if (string=? bin cmd)
(if bin #f ; nothing to do
(if (string=? bin cmd) (begin
#f ; nothing to do (format (current-error-port)
(begin "patch-shebang: ~a: changing `~a' to `~a'~%"
(format (current-error-port) file cmd bin)
"patch-shebang: ~a: changing `~a' to `~a'~%" (patch p bin (match:substring m 2))))
file cmd bin) (begin
(patch p bin (match:substring m 2)))) (format (current-error-port)
(begin "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
(format (current-error-port) file (basename cmd))
"patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%" #f))))))))))))
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 (define* (fold-port-matches proc init pattern port
#:optional (unmatched (lambda (_ r) r))) #:optional (unmatched (lambda (_ r) r)))
@ -440,6 +525,14 @@ for each unmatched character."
(map char-set (string->list pattern)) (map char-set (string->list pattern))
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... ;; Note: we're not really striving for performance here...
(let loop ((chars '()) (let loop ((chars '())
(pattern initial-pattern) (pattern initial-pattern)
@ -499,16 +592,17 @@ known as `nuke-refs' in Nixpkgs."
(setvbuf in _IOFBF 65536) (setvbuf in _IOFBF 65536)
(setvbuf out _IOFBF 65536) (setvbuf out _IOFBF 65536)
(fold-port-matches (lambda (match result) (fold-port-matches (lambda (match result)
(put-string out store) (put-bytevector out (string->utf8 store))
(put-char out #\/) (put-u8 out (char->integer #\/))
(put-string out (put-bytevector out
"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-") (string->utf8
"eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-"))
#t) #t)
#f #f
pattern pattern
in in
(lambda (char result) (lambda (char result)
(put-char out char) (put-u8 out (char->integer char))
result)))))) result))))))
;;; Local Variables: ;;; Local Variables:

9
guix/ftp-client.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -33,6 +33,7 @@
ftp-open ftp-open
ftp-close ftp-close
ftp-chdir ftp-chdir
ftp-size
ftp-list ftp-list
ftp-retr)) ftp-retr))
@ -133,6 +134,12 @@ or a TCP port number), and return it."
(%ftp-command (string-append "CWD " dir) 250 (%ftp-command (string-append "CWD " dir) 250
(ftp-connection-socket conn))) (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 (ftp-pasv conn)
(define %pasv-rx (define %pasv-rx
(make-regexp "([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)")) (make-regexp "([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)"))

16
m4/guix.m4
View file

@ -1,20 +1,20 @@
dnl Guix --- Nix package management from Guile. -*- coding: utf-8 -*- dnl GNU Guix --- Functional package management for GNU
dnl Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> dnl Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
dnl dnl
dnl This file is part of Guix. dnl This file is part of GNU Guix.
dnl 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 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 the Free Software Foundation; either version 3 of the License, or (at
dnl your option) any later version. dnl your option) any later version.
dnl 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 WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
dnl GNU General Public License for more details. dnl GNU General Public License for more details.
dnl dnl
dnl You should have received a copy of the GNU General Public License 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 GUIX_ASSERT_LIBGCRYPT_USABLE
dnl dnl
@ -61,5 +61,9 @@ AC_DEFUN([GUIX_SYSTEM_TYPE], [
# `darwin10.2.0', etc. # `darwin10.2.0', etc.
guix_system="$machine_name-`echo $host_os | "$SED" -e's/@<:@0-9.@:>@*$//g'`";; guix_system="$machine_name-`echo $host_os | "$SED" -e's/@<:@0-9.@:>@*$//g'`";;
esac]) esac])
AC_MSG_CHECKING([for the Guix system type])
AC_MSG_RESULT([$guix_system])
AC_SUBST([guix_system]) AC_SUBST([guix_system])
]) ])

12
nix/sync-with-upstream
View file

@ -1,21 +1,21 @@
#!/bin/sh #!/bin/sh
# Guix --- Nix package management from Guile. -*- coding: utf-8 -*- # GNU Guix --- Functional package management for GNU
# Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> # 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 # under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at # the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version. # 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 # WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details. # GNU General Public License for more details.
# #
# You should have received a copy of the GNU General Public License # 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. # Update the local copy of Nix source code needed to build the daemon.

12
release.nix
View file

@ -32,13 +32,13 @@ let
bootstrap_guile = bootstrap_guile =
let pkgs = import nixpkgs {}; in { let pkgs = import nixpkgs {}; in {
i686 = pkgs.fetchurl { i686 = pkgs.fetchurl {
url = http://www.fdn.fr/~lcourtes/software/guix/packages/i686-linux/guile-bootstrap-2.0.6.tar.xz; url = http://www.fdn.fr/~lcourtes/software/guix/packages/i686-linux/20121219/guile-2.0.7.tar.xz;
sha256 = "93b537766dfab3ad287143523751e3ec02dd32d3ccaf88ad2d31c63158f342ee"; sha256 = "45d1f9bfb9e4531a8f1c5a105f7ab094cd481b8a179ccc63cbabb73ce6b8437f";
}; };
x86_64 = pkgs.fetchurl { x86_64 = pkgs.fetchurl {
url = http://www.fdn.fr/~lcourtes/software/guix/packages/x86_64-linux/guile-bootstrap-2.0.6.tar.xz; url = http://www.fdn.fr/~lcourtes/software/guix/packages/x86_64-linux/20121219/guile-2.0.7.tar.xz;
sha256 = "0467a82cbe4136f60a79eb4176011bf88cf28ea19c9ad9defa365811ff8e11cf"; sha256 = "953fbcc8db6e310626be79b67319cf4141dc23b296447952a99d95425b3a4dc1";
}; };
}; };
@ -76,9 +76,9 @@ let
# the build system download it over and over again. # the build system download it over and over again.
'' mkdir -p distro/packages/bootstrap/{i686,x86_64}-linux '' mkdir -p distro/packages/bootstrap/{i686,x86_64}-linux
cp -v "${bootstrap_guile.i686}" \ 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}" \ 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 inherit succeedOnFailure keepBuildDirectory

41
tests/derivations.scm
View file

@ -23,6 +23,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module ((guix packages) #:select (package-derivation)) #:use-module ((guix packages) #:select (package-derivation))
#:use-module ((distro) #:select (search-bootstrap-binary))
#:use-module (distro packages bootstrap) #:use-module (distro packages bootstrap)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
@ -47,6 +48,11 @@
(let ((drv (package-derivation %store %bootstrap-guile))) (let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv))) (%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) (define (directory-contents dir)
"Return an alist representing the contents of DIR." "Return an alist representing the contents of DIR."
(define prefix-len (string-length dir)) (define prefix-len (string-length dir))
@ -96,10 +102,11 @@
(test-assert "derivation with no inputs" (test-assert "derivation with no inputs"
(let* ((builder (add-text-to-store %store "my-builder.sh" (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 (drv-path (derivation %store "foo" (%current-system)
'() '(("HOME" . "/homeless")) '()))) %bash `("-e" ,builder)
'(("HOME" . "/homeless")) '())))
(and (store-path? drv-path) (and (store-path? drv-path)
(valid-path? %store drv-path)))) (valid-path? %store drv-path))))
@ -110,7 +117,7 @@
'())) '()))
((drv-path drv) ((drv-path drv)
(derivation %store "foo" (%current-system) (derivation %store "foo" (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
'(("HOME" . "/homeless") '(("HOME" . "/homeless")
("zzz" . "Z!") ("zzz" . "Z!")
("AAA" . "A!")) ("AAA" . "A!"))
@ -132,7 +139,7 @@
(input (search-path %load-path "ice-9/boot-9.scm")) (input (search-path %load-path "ice-9/boot-9.scm"))
(drv-path (derivation %store "derivation-with-input-file" (drv-path (derivation %store "derivation-with-input-file"
(%current-system) (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
`(("in" `(("in"
;; Cheat to pass the actual file ;; Cheat to pass the actual file
;; name to the builder. ;; name to the builder.
@ -152,7 +159,7 @@
"echo -n hello > $out" '())) "echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(drv-path (derivation %store "fixed" (%current-system) (drv-path (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
'() '()
`((,builder)) ; optional `((,builder)) ; optional
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
@ -170,11 +177,11 @@
"echo hey; echo -n hello > $out" '())) "echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(drv-path1 (derivation %store "fixed" (%current-system) (drv-path1 (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder1) %bash `(,builder1)
'() `() '() `()
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
(drv-path2 (derivation %store "fixed" (%current-system) (drv-path2 (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder2) %bash `(,builder2)
'() `() '() `()
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store (succeeded? (build-derivations %store
@ -193,11 +200,11 @@
"echo hey; echo -n hello > $out" '())) "echo hey; echo -n hello > $out" '()))
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed" (%current-system) (fixed1 (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder1) %bash `(,builder1)
'() `() '() `()
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
(fixed2 (derivation %store "fixed" (%current-system) (fixed2 (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder2) %bash `(,builder2)
'() `() '() `()
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
(fixed-out (derivation-path->output-path fixed1)) (fixed-out (derivation-path->output-path fixed1))
@ -206,11 +213,11 @@
;; Use Bash hackery to avoid Coreutils. ;; Use Bash hackery to avoid Coreutils.
"echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '())) "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
(final1 (derivation %store "final" (%current-system) (final1 (derivation %store "final" (%current-system)
"/bin/sh" `(,builder3) %bash `(,builder3)
`(("in" . ,fixed-out)) `(("in" . ,fixed-out))
`((,builder3) (,fixed1)))) `((,builder3) (,fixed1))))
(final2 (derivation %store "final" (%current-system) (final2 (derivation %store "final" (%current-system)
"/bin/sh" `(,builder3) %bash `(,builder3)
`(("in" . ,fixed-out)) `(("in" . ,fixed-out))
`((,builder3) (,fixed2)))) `((,builder3) (,fixed2))))
(succeeded? (build-derivations %store (succeeded? (build-derivations %store
@ -224,7 +231,7 @@
"echo one > $out ; echo two > $second" "echo one > $out ; echo two > $second"
'())) '()))
(drv-path (derivation %store "fixed" (%current-system) (drv-path (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
'(("HOME" . "/homeless") '(("HOME" . "/homeless")
("zzz" . "Z!") ("zzz" . "Z!")
("AAA" . "A!")) ("AAA" . "A!"))
@ -247,7 +254,7 @@
"echo one > $out ; echo two > $AAA" "echo one > $out ; echo two > $AAA"
'())) '()))
(drv-path (derivation %store "fixed" (%current-system) (drv-path (derivation %store "fixed" (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
'() '()
`((,builder)) `((,builder))
#:outputs '("out" "AAA"))) #:outputs '("out" "AAA")))
@ -265,7 +272,7 @@
"echo one > $out ; echo two > $two" "echo one > $out ; echo two > $two"
'())) '()))
(mdrv (derivation %store "multiple-output" (%current-system) (mdrv (derivation %store "multiple-output" (%current-system)
"/bin/sh" `(,builder1) %bash `(,builder1)
'() '()
`((,builder1)) `((,builder1))
#:outputs '("out" "two"))) #:outputs '("out" "two")))
@ -276,7 +283,7 @@
'())) '()))
(udrv (derivation %store "multiple-output-user" (udrv (derivation %store "multiple-output-user"
(%current-system) (%current-system)
"/bin/sh" `(,builder2) %bash `(,builder2)
`(("one" . ,(derivation-path->output-path `(("one" . ,(derivation-path->output-path
mdrv "out")) mdrv "out"))
("two" . ,(derivation-path->output-path ("two" . ,(derivation-path->output-path
@ -306,7 +313,7 @@
'())) '()))
(drv-path (drv-path
(derivation %store "foo" (%current-system) (derivation %store "foo" (%current-system)
"/bin/sh" `(,builder) %bash `(,builder)
`(("PATH" . `(("PATH" .
,(string-append ,(string-append
(derivation-path->output-path %coreutils) (derivation-path->output-path %coreutils)

5
tests/union.scm
View file

@ -26,6 +26,7 @@
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (with-directory-excursion directory-exists?)) #:select (with-directory-excursion directory-exists?))
#:use-module (distro packages bootstrap) #:use-module (distro packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
@ -93,7 +94,9 @@
(let* ((inputs (map (match-lambda (let* ((inputs (map (match-lambda
((name package) ((name package)
`(,name ,(package-derivation %store package)))) `(,name ,(package-derivation %store package))))
%bootstrap-inputs)) (delete-duplicates %bootstrap-inputs
(lambda (i1 i2)
(eq? (second i1) (second i2))))))
(builder `(begin (builder `(begin
(use-modules (guix build union)) (use-modules (guix build union))
(union-build (assoc-ref %outputs "out") (union-build (assoc-ref %outputs "out")