diff options
41 files changed, 688 insertions, 206 deletions
diff --git a/Makefile.am b/Makefile.am index ee6d023988..189b637be3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -38,6 +38,7 @@ MODULES = \ guix/scripts/refresh.scm \ guix/base32.scm \ guix/records.scm \ + guix/hash.scm \ guix/utils.scm \ guix/serialization.scm \ guix/nar.scm \ @@ -82,6 +83,7 @@ nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm SCM_TESTS = \ tests/base32.scm \ + tests/hash.scm \ tests/builders.scm \ tests/derivations.scm \ tests/ui.scm \ @@ -36,6 +36,13 @@ to download a substitute. See the manual for details. + +** Programming interfaces + +*** New (guix hash) module; new ‘open-sha256-port’ and ‘sha256-port’ procedures + +This improves performance of SHA256 computations. + ** Bugs fixed *** “guix --help” now works when using Guile 2.0.5 *** Binary substituter multi-threading and pipe issues fixed @@ -9,6 +9,7 @@ suggestions, bug reports, patches, or general infrastructure help: Daniel Clark <dclark@pobox.com> Alexandru Cojocaru <xojoc@gmx.com> Aleix Conchillo Flaqué <aconchillo@gmail.com> + Matthew Lien <bluet@bluet.org> Alex Sassmannshausen <alex.sassmannshausen@gmail.com> Jason Self <jself@gnu.org> Alen Skondro <askondro@gmail.com> @@ -85,10 +85,6 @@ create a new ‘dir’. #+END_SRC -* add ‘make-sha256-port’ binding for ‘gcry_md_write’ & co. - -This should make `derivation-hash' faster. - * synchronize package descriptions with GSRC and/or the [[http://directory.fsf.org][FSD]] Meta-data for GNU packages, including descriptions and synopses, can be diff --git a/build-aux/download.scm b/build-aux/download.scm index c5486f8970..91b41bcec1 100644 --- a/build-aux/download.scm +++ b/build-aux/download.scm @@ -25,7 +25,8 @@ (web client) (rnrs io ports) (srfi srfi-11) - (guix utils)) + (guix utils) + (guix hash)) (define %url-base "http://alpha.gnu.org/gnu/guix/bootstrap" diff --git a/configure.ac b/configure.ac index ff512dd1ff..80d35a4272 100644 --- a/configure.ac +++ b/configure.ac @@ -22,6 +22,7 @@ guilemoduledir="${datarootdir}/guile/site/2.0" AC_SUBST([guilemoduledir]) GUIX_SYSTEM_TYPE +GUIX_ASSERT_SUPPORTED_SYSTEM AC_ARG_WITH(store-dir, AC_HELP_STRING([--with-store-dir=PATH], diff --git a/gnu-system.am b/gnu-system.am index 3b86b63a6d..41871ed021 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -118,6 +118,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/ncurses.scm \ gnu/packages/netpbm.scm \ gnu/packages/nettle.scm \ + gnu/packages/noweb.scm \ gnu/packages/ocaml.scm \ gnu/packages/oggvorbis.scm \ gnu/packages/openldap.scm \ @@ -137,6 +138,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/readline.scm \ gnu/packages/recutils.scm \ gnu/packages/rsync.scm \ + gnu/packages/rush.scm \ gnu/packages/samba.scm \ gnu/packages/scheme.scm \ gnu/packages/screen.scm \ @@ -187,6 +189,7 @@ dist_patch_DATA = \ gnu/packages/patches/glib-tests-prlimit.patch \ gnu/packages/patches/glibc-bootstrap-system.patch \ gnu/packages/patches/glibc-no-ld-so-cache.patch \ + gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch \ gnu/packages/patches/grub-gets-undeclared.patch \ gnu/packages/patches/guile-1.8-cpp-4.5.patch \ gnu/packages/patches/guile-default-utf8.patch \ @@ -195,9 +198,6 @@ dist_patch_DATA = \ gnu/packages/patches/libapr-skip-getservbyname-test.patch \ gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libtool-skip-tests.patch \ - gnu/packages/patches/lsh-guile-compat.patch \ - gnu/packages/patches/lsh-no-root-login.patch \ - gnu/packages/patches/lsh-pam-service-name.patch \ gnu/packages/patches/m4-gets-undeclared.patch \ gnu/packages/patches/m4-readlink-EINVAL.patch \ gnu/packages/patches/m4-s_isdir.patch \ diff --git a/gnu/packages/ed.scm b/gnu/packages/ed.scm index e9ded33dd8..b662b59a86 100644 --- a/gnu/packages/ed.scm +++ b/gnu/packages/ed.scm @@ -26,14 +26,14 @@ (define-public ed (package (name "ed") - (version "1.8") + (version "1.9") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/ed/ed-" version ".tar.gz")) (sha256 (base32 - "0wvj190ky5i0gm0pilx9k75l6alyc6h5s14fm3dbk90y7g9kihb4")))) + "122syihsx2hwzj75mkf5a9ssiky2xby748kp4cc00wzhmp7p5cym")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("CC=gcc") diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index f8caf4c7f6..571526ebdf 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -205,14 +205,14 @@ used in the GNU system including the GNU/Linux variant.") (define-public gcc-4.8 (package (inherit gcc-4.7) - (version "4.8.0") + (version "4.8.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/gcc/gcc-" version "/gcc-" version ".tar.bz2")) (sha256 (base32 - "0b6cp9d1sas3vq6dj3zrgd134p9b569fqhbixb9cl7mp698zwdxh")))))) + "04sqn0ds17ys8l6zn7vyyvjz1a7hsk4zb0381vlw9wnr7az48nsl")))))) (define-public isl (package diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm index 32726f6258..d636a9c927 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -23,6 +23,7 @@ #:use-module (guix build-system gnu) #:use-module ((gnu packages compression) #:renamer (symbol-prefix-proc 'guix:)) + #:use-module (gnu packages) #:use-module (gnu packages nettle) #:use-module (gnu packages guile) #:use-module (gnu packages perl) @@ -65,12 +66,18 @@ portable, and only require an ANSI C89 platform.") (base32 "1zi2kq3vcbqdy9khl7r6pgk4hgwibniasm9k6siasdvqjijq3ymb")))) (build-system gnu-build-system) + (arguments + `(#:patches (list (assoc-ref %build-inputs + "patch/fix-tests")) + #:patch-flags '("-p0"))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("guile" ,guile-2.0) ("zlib" ,guix:zlib) - ("perl" ,perl))) + ("perl" ,perl) + ("patch/fix-tests" + ,(search-patch "gnutls-fix-tests-on-32-bits-system.patch")))) (propagated-inputs `(("libtasn1" ,libtasn1) ("nettle" ,nettle) diff --git a/gnu/packages/gtk.scm b/gnu/packages/gtk.scm index 38ad05e074..2e0a7b60b4 100644 --- a/gnu/packages/gtk.scm +++ b/gnu/packages/gtk.scm @@ -27,7 +27,9 @@ #:use-module (gnu packages ghostscript) #:use-module (gnu packages glib) #:use-module (gnu packages icu4c) + #:use-module (gnu packages libjpeg) #:use-module (gnu packages libpng) + #:use-module (gnu packages libtiff) #:use-module (gnu packages pdf) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) @@ -153,3 +155,28 @@ applications. It has extensive support for the different writing systems used throughout the world.") (license license:lgpl2.0+) (home-page "https://developer.gnome.org/pango/"))) + +(define-public gdk-pixbuf + (package + (name "gdk-pixbuf") + (version "2.28.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnome/sources/gdk-pixbuf/2.28/gdk-pixbuf-" + version ".tar.xz")) + (sha256 + (base32 + "05s6ksvy1yan6h6zny9n3bmvygcnzma6ljl6i0z9cci2xg116c8q")))) + (build-system gnu-build-system) + (inputs + `(("glib" ,glib) + ("libjpeg" ,libjpeg) + ("libpng" ,libpng) + ("libtiff" ,libtiff) + ("pkg-config" ,pkg-config))) + (synopsis "GNOME image loading and manipulation library") + (description + "GdkPixbuf is a library for image loading and manipulation developed +in the GNOME project.") + (license license:lgpl2.0+) + (home-page "https://developer.gnome.org/gdk-pixbuf/"))) diff --git a/gnu/packages/lout.scm b/gnu/packages/lout.scm index 299af093e5..76cb8a753b 100644 --- a/gnu/packages/lout.scm +++ b/gnu/packages/lout.scm @@ -77,14 +77,14 @@ '("design" "expert" "slides" "user"))))) (package (name "lout") - (version "3.39") + (version "3.40") (source (origin (method url-fetch) (uri (string-append "mirror://savannah/lout/lout-" version ".tar.gz")) (sha256 (base32 - "12gkyqrn0kaa8xq7sc7v3wm407pz2fxg9ngc75aybhi5z825b9vq")))) + "1gb8vb1wl7ikn269dd1c7ihqhkyrwk19jwx5kd0rdvbk6g7g25ix")))) (build-system gnu-build-system) ; actually, just a makefile (outputs '("out" "doc")) (inputs diff --git a/gnu/packages/lsh.scm b/gnu/packages/lsh.scm index c031b287a1..b8c155453f 100644 --- a/gnu/packages/lsh.scm +++ b/gnu/packages/lsh.scm @@ -24,6 +24,7 @@ #:use-module (gnu packages) #:use-module (gnu packages m4) #:use-module (gnu packages linux) + #:use-module (gnu packages nettle) #:use-module ((gnu packages compression) #:renamer (symbol-prefix-proc 'guix:)) #:use-module (gnu packages multiprecision) @@ -44,15 +45,21 @@ (base32 "0z6rlalhvfca64jpvksppc9bdhs7jwhiw4y35g5ibvh91xp3rn1l")))) (build-system gnu-build-system) - (home-page "http://liboop.ofb.net/") - (synopsis "`liboop', an event loop library") - (description "liboop is an event loop library.") + (home-page "http://www.lysator.liu.se/liboop/") + (synopsis "Event loop library") + (description "Liboop is a low-level event loop management library for +POSIX-based operating systems. It supports the development of modular, +multiplexed applications which may respond to events from several sources. It +replaces the \"select() loop\" and allows the registration of event handlers +for file and network I/O, timers and signals. Since processes use these +mechanisms for almost all external communication, liboop can be used as the +basis for almost any application.") (license lgpl2.1+))) (define-public lsh (package (name "lsh") - (version "2.0.4") + (version "2.1") (source (origin (method url-fetch) @@ -60,10 +67,11 @@ version ".tar.gz")) (sha256 (base32 - "149hf49xcj99wwvi7hcb59igq4vpyv8har1br1if3lrsw5irsjv1")))) + "1qqjy9zfzgny0rkb27c8c7dfsylvb6n0ld8h3an2r83pmaqr9gwb")))) (build-system gnu-build-system) (inputs - `(("linux-pam" ,linux-pam) + `(("nettle" ,nettle) + ("linux-pam" ,linux-pam) ("m4" ,m4) ("readline" ,readline) ("liboop" ,liboop) @@ -72,17 +80,9 @@ ("guile" ,guile-final) ("gperf" ,gperf) ("psmisc" ,psmisc) ; for `killall' - - ("patch/no-root-login" ,(search-patch "lsh-no-root-login.patch")) - ("patch/guile-compat" ,(search-patch "lsh-guile-compat.patch")) - ("patch/pam-service-name" - ,(search-patch "lsh-pam-service-name.patch")))) + )) (arguments - '(#:patches (list (assoc-ref %build-inputs "patch/no-root-login") - (assoc-ref %build-inputs "patch/pam-service-name") - (assoc-ref %build-inputs "patch/guile-compat")) - - ;; Skip the `configure' test that checks whether /dev/ptmx & + '(;; Skip the `configure' test that checks whether /dev/ptmx & ;; co. work as expected, because it relies on impurities (for ;; instance, /dev/pts may be unavailable in chroots.) #:configure-flags '("lsh_cv_sys_unix98_ptys=yes") diff --git a/gnu/packages/noweb.scm b/gnu/packages/noweb.scm new file mode 100644 index 0000000000..155639f57e --- /dev/null +++ b/gnu/packages/noweb.scm @@ -0,0 +1,96 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (gnu packages noweb) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix licenses)) + +(define-public noweb + (package + (name "noweb") + (version "2.11b") + (source (origin + (method url-fetch) + (uri (string-append "ftp://www.eecs.harvard.edu/pub/nr/noweb-" + version ".tgz")) + (sha256 + (base32 + "10hdd6mrk26kyh4bnng4ah5h1pnanhsrhqa7qwqy6dyv3rng44y9")))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-cons-before + 'install 'pre-install + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (mkdir-p (string-append out "/share/texmf/tex/latex")) + #t)) + (alist-cons-after + 'install 'post-install + (lambda* (#:key outputs inputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out")) + (cu (assoc-ref inputs "coreutils")) + (du (assoc-ref inputs "diffutils"))) + (with-directory-excursion out + (for-each (lambda (prog) + (substitute* prog + (("nawk") (which "awk")))) + (append (map (lambda (x) + (string-append "bin/" x)) + '("noweb" "nountangle" + "noroots" "noroff" + "noindex")) + (map (lambda (x) + (string-append "lib/" x)) + '("btdefn" "emptydefn" "noidx" + "pipedocs" "toascii" "tohtml" + "toroff" "totex" "unmarkup")))) + (substitute* "bin/cpif" + (("^PATH=.*$") + (string-append "PATH=" cu "/bin:" du "/bin\n")))) + #t)) + (alist-replace + 'configure + (lambda _ + ;; Jump in the source. + (chdir "src") + + ;; The makefile reads "source: FAQ", but FAQ isn't + ;; available. + (substitute* "Makefile" + (("FAQ") ""))) + %standard-phases))) + #:make-flags (let ((out (assoc-ref %outputs "out"))) + (list (string-append "BIN=" out "/bin") + (string-append "LIB=" out "/lib") + (string-append "MAN=" out "/share/man") + (string-append "TEXINPUTS=" out + "/share/texmf/tex/latex"))) + #:tests? #f)) ; no tests + (home-page "http://www.cs.tufts.edu/~nr/noweb/") + (synopsis "Literate programming tool") + (description + "noweb is designed to meet the needs of literate programmers while +remaining as simple as possible. Its primary advantages are simplicity, +extensibility, and language-independence—especially noticeable when compared +with other literate-programming tools. noweb uses 5 control sequences to +WEB's 27. The noweb manual is only 4 pages; an additional page explains how +to customize its LaTeX output. noweb works “out of the box” with any +programming language, and supports TeX, LaTeX, HTML, and troff back ends.") + (license (fsf-free "http://www.cs.tufts.edu/~nr/noweb/#copyright")))) diff --git a/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch b/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch new file mode 100644 index 0000000000..07d633149e --- /dev/null +++ b/gnu/packages/patches/gnutls-fix-tests-on-32-bits-system.patch @@ -0,0 +1,36 @@ +From b12040aeab5fbaf02677571db1d8bf1995bd5ee0 Mon Sep 17 00:00:00 2001 +From: Nikos Mavrogiannopoulos <nmav@gnutls.org> +Date: Sun, 2 Jun 2013 12:10:06 +0200 +Subject: [PATCH] Avoid comparing the expiration date to prevent false positive +error in 32-bit systems. + +--- + tests/cert-tests/pem-decoding | 6 ++++-- + 1 files changed, 4 insertions(+), 2 deletions(-) + +diff --git a/tests/cert-tests/pem-decoding b/tests/cert-tests/pem-decoding +index fe769ec..f8c6372 100755 +--- tests/cert-tests/pem-decoding ++++ tests/cert-tests/pem-decoding +@@ -61,7 +61,9 @@ if test "$rc" != "0"; then + exit $rc + fi + +-diff $srcdir/complex-cert.pem tmp-pem.pem ++cat $srcdir/complex-cert.pem |grep -v "Not After:" >tmp1 ++cat $srcdir/tmp-pem.pem |grep -v "Not After:" >tmp2 ++diff tmp1 tmp2 + rc=$? + + if test "$rc" != "0"; then +@@ -69,6 +71,6 @@ if test "$rc" != "0"; then + exit $rc + fi + +-rm -f tmp-pem.pem ++rm -f tmp-pem.pem tmp1 tmp2 + + exit 0 +-- +1.7.1 + diff --git a/gnu/packages/patches/lsh-guile-compat.patch b/gnu/packages/patches/lsh-guile-compat.patch deleted file mode 100644 index 0fe0484580..0000000000 --- a/gnu/packages/patches/lsh-guile-compat.patch +++ /dev/null @@ -1,9 +0,0 @@ -Use (ice-9 rdelim) for `read-line'. - ---- lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:01.000000000 +0100 -+++ lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:04.000000000 +0100 -@@ -21,3 +21,4 @@ - ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - (use-syntax (ice-9 syncase)) -+(use-modules (ice-9 rdelim)) diff --git a/gnu/packages/patches/lsh-no-root-login.patch b/gnu/packages/patches/lsh-no-root-login.patch deleted file mode 100644 index 9dd81de3fb..0000000000 --- a/gnu/packages/patches/lsh-no-root-login.patch +++ /dev/null @@ -1,16 +0,0 @@ -Correctly handle the `--no-root-login' option. - ---- lsh-2.0.4/src/lshd.c 2006-05-01 13:47:44.000000000 +0200 -+++ lsh-2.0.4/src/lshd.c 2009-09-08 12:20:36.000000000 +0200 -@@ -758,6 +758,10 @@ main_argp_parser(int key, char *arg, str - self->allow_root = 1; - break; - -+ case OPT_NO_ROOT_LOGIN: -+ self->allow_root = 0; -+ break; -+ - case OPT_KERBEROS_PASSWD: - self->pw_helper = PATH_KERBEROS_HELPER; - break; - diff --git a/gnu/packages/patches/lsh-pam-service-name.patch b/gnu/packages/patches/lsh-pam-service-name.patch deleted file mode 100644 index 6a6156855c..0000000000 --- a/gnu/packages/patches/lsh-pam-service-name.patch +++ /dev/null @@ -1,14 +0,0 @@ -Tell `lsh-pam-checkpw', the PAM password helper program, to use a more -descriptive service name. - ---- lsh-2.0.4/src/lsh-pam-checkpw.c 2003-02-16 22:30:10.000000000 +0100 -+++ lsh-2.0.4/src/lsh-pam-checkpw.c 2008-11-28 16:16:58.000000000 +0100 -@@ -38,7 +38,7 @@ - #include <security/pam_appl.h> - - #define PWD_MAXLEN 1024 --#define SERVICE_NAME "other" -+#define SERVICE_NAME "lshd" - #define TIMEOUT 600 - - static int diff --git a/gnu/packages/qemu.scm b/gnu/packages/qemu.scm index b10935ce0d..1bb95840f0 100644 --- a/gnu/packages/qemu.scm +++ b/gnu/packages/qemu.scm @@ -34,6 +34,7 @@ #:use-module (gnu packages attr) #:use-module (gnu packages linux) #:use-module (gnu packages samba) + #:use-module (gnu packages xorg) #:use-module (gnu packages perl)) (define-public qemu-kvm @@ -62,6 +63,7 @@ (setenv "LDFLAGS" "-lrt") (zero? (system* "./configure" + (string-append "--cc=" (which "gcc")) (string-append "--prefix=" out) (string-append "--smbd=" samba "/sbin/smbd"))))) @@ -74,11 +76,12 @@ ("ncurses" ,ncurses) ("libpng" ,libpng) ("libjpeg" ,libjpeg-8) + ("pixman" ,pixman) ;; ("vde2" ,vde2) ("util-linux" ,util-linux) ;; ("pciutils" ,pciutils) ("pkg-config" ,pkg-config) - ;; ("alsa-lib" ,alsa-lib) + ("alsa-lib" ,alsa-lib) ;; ("SDL" ,SDL) ("zlib" ,zlib) ("attr" ,attr) @@ -113,7 +116,7 @@ underway to get the required changes upstream.") ;; The real one, with a complete target list. (package (inherit qemu-kvm) (name "qemu") - (version "1.3.1") + (version "1.5.1") (location (source-properties->location (current-source-location))) (source (origin (method url-fetch) @@ -121,31 +124,18 @@ underway to get the required changes upstream.") version ".tar.bz2")) (sha256 (base32 - "1bqfrb5dlsxm8gxhkksz8qzi5fhj3xqhxyfwbqcphhcv1kpyfwip")))) + "1s7316pgizpayr472la8p8a4vhv7ymmzd5qlbkmq6y9q5zpa25ac")))) (arguments (substitute-keyword-arguments (package-arguments qemu-kvm) ((#:phases phases) `(alist-cons-before 'build 'pre-build (lambda* (#:key inputs #:allow-other-keys) - (let ((libtool (assoc-ref inputs "libtool")) - (pkg-config (assoc-ref inputs "pkg-config"))) - ;; XXX: For lack of generic search path handling. - (setenv "ACLOCAL_PATH" - (format #f "~a/share/aclocal:~a/share/aclocal" - libtool pkg-config))) - - ;; For pixman's `configure' script. - (setenv "CONFIG_SHELL" (which "bash")) - - (substitute* "pixman/configure.ac" - (("AM_CONFIG_HEADER") "AC_CONFIG_HEADERS"))) + (substitute* "tests/libqtest.c" + (("/bin/sh") (which "sh")))) ,phases)))) - (native-inputs `(("autoconf" ,autoconf-wrapper) ; for "pixman" - ("automake" ,automake) - ("libtool" ,libtool) - ("libtool-bin" ,libtool "bin") - ("perl" ,perl))) + (native-inputs `(("perl" ,perl))) + (home-page "http://www.qemu-project.org") (description "QEMU is a generic and open source machine emulator and virtualizer. diff --git a/gnu/packages/rush.scm b/gnu/packages/rush.scm new file mode 100644 index 0000000000..a7f1ec4440 --- /dev/null +++ b/gnu/packages/rush.scm @@ -0,0 +1,56 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (gnu packages rush) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix licenses) + #:use-module (gnu packages)) + +(define-public rush + (package + (name "rush") + (version "1.7") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://gnu/rush/rush-" + version + ".tar.gz")) + (sha256 + (base32 + "0fh0gbbp0iiq3wbkf503xb40r8ljk42vyj9bnlflbz82d6ipy1rm")))) + (build-system gnu-build-system) + (arguments + '(#:patches (list (assoc-ref %build-inputs "patch/gets-undeclared")))) + (inputs `(("patch/gets-undeclared" + ,(search-patch "cpio-gets-undeclared.patch")))) + (home-page "http://www.gnu.org/software/rush/") + (synopsis "Restricted user (login) shell") + (description + "GNU Rush is a Restricted User Shell, designed for sites providing +limited remote access to their resources, such as svn or git repositories, +scp, or the like. Using a sophisticated configuration file, Rush gives you +complete control over the command lines that users execute, as well as over +the usage of system resources, such as virtual memory, CPU time, etc. + +In particular, it allows remote programs to be run in a chrooted environment, +which is important with such programs as sftp-server or scp, that lack this +ability.") + (license gpl3+))) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 1e66750b01..4d717128d9 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -128,7 +128,7 @@ development cycle.") "1771z43nmf9awjvlvrpjfhzcfxsbw2qipir8g9r47sygf2vn59yl")))) (build-system gnu-build-system) (arguments - '(#:patches (list (assoc-ref %build-inputs "patch/shebangs")) + `(#:patches (list (assoc-ref %build-inputs "patch/shebangs")) #:test-target "test" #:phases (alist-replace 'configure @@ -138,6 +138,17 @@ development cycle.") (("^shell=.*$") (string-append "shell=" (which "bash") "\n"))) + ;; Since libgc's pthread redirects are used, we end up + ;; using libgc symbols, so we must link against it. + ;; Reported on 2013-06-25. + (substitute* "api/pthread/src/Makefile" + (("^EXTRALIBS[[:blank:]]*=(.*)$" _ value) + (string-append "EXTRALIBS = " + (string-trim-right value) + " -l$(GCLIB)_fth-$(RELEASE)" + " -Wl,-rpath=" (assoc-ref outputs "out") + "/lib/bigloo/" ,version))) + ;; Those variables are used by libgc's `configure'. (setenv "SHELL" (which "bash")) (setenv "CONFIG_SHELL" (which "bash")) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 018cf1b9f8..c215f2f886 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +32,8 @@ #:use-module (gnu packages perl) #:use-module (gnu packages python) #:use-module (gnu packages sqlite) + #:use-module (gnu packages system) + #:use-module (gnu packages emacs) #:use-module (gnu packages compression)) (define-public bazaar @@ -138,3 +141,25 @@ Configuration Management (SCM). Using it, you can record the history of sources files, and documents. It fills a similar role to the free software RCS, PRCS, and Aegis packages.") (license gpl1+))) + +(define-public vc-dwim + (package + (name "vc-dwim") + (version "1.7") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/vc-dwim/vc-dwim-" + version ".tar.xz")) + (sha256 + (base32 + "094pjwshvazlgagc254in2xvrp93vhcj0kb5ms17qs7sch99x9z2")))) + (build-system gnu-build-system) + (inputs `(("perl" ,perl) + ("inetutils" ,inetutils) ; for `hostname', used in the tests + ("emacs" ,emacs))) ; for `ctags' + (home-page "http://www.gnu.org/software/vc-dwim/") + (synopsis "Version-control-agnostic ChangeLog diff and commit tool") + (description + "vc-dwim is a version-control-agnostic ChangeLog diff and commit +tool. vc-chlog is a helper tool for writing GNU-style ChangeLog entries.") + (license gpl3+))) diff --git a/guix/build/download.scm b/guix/build/download.scm index dcce0bfc89..ac2086d96e 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -65,8 +65,11 @@ abbreviation of URI showing the scheme, host, and basename of the file." (define (elide-path) (let ((path (uri-path uri))) - (string-append (symbol->string (uri-scheme uri)) - "://" (uri-host uri) + (string-append (symbol->string (uri-scheme uri)) "://" + + ;; `file' URIs have no host part. + (or (uri-host uri) "") + (string-append "/.../" (basename path))))) (if (> (string-length uri-as-string) max-length) diff --git a/guix/derivations.scm b/guix/derivations.scm index 3c433a2685..8ddef117d4 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -26,6 +26,7 @@ #:use-module (ice-9 rdelim) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix hash) #:use-module (guix base32) #:export (<derivation> derivation? @@ -468,6 +469,10 @@ in SIZE bytes." inputs)) (drv (make-derivation outputs inputs sources system builder args env-vars))) + + ;; XXX: At this point this remains faster than `port-sha256', because + ;; the SHA256 port's `write' method gets called for every single + ;; character. (sha256 (with-fluids ((%default-port-encoding "UTF-8")) (string->utf8 (call-with-output-string diff --git a/guix/download.scm b/guix/download.scm index fc6c815792..b12659f683 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -84,7 +84,8 @@ "http://mirror.csclub.uwaterloo.ca/nongnu/" "http://nongnu.askapache.com/" "http://savannah.c3sl.ufpr.br/" - "http://www.centervenus.com/mirrors/nongnu/") + "http://www.centervenus.com/mirrors/nongnu/" + "http://download.savannah.gnu.org/releases-noredirect/") (sourceforge "http://prdownloads.sourceforge.net/" "http://heanet.dl.sourceforge.net/sourceforge/" diff --git a/guix/hash.scm b/guix/hash.scm new file mode 100644 index 0000000000..92ecaf78d5 --- /dev/null +++ b/guix/hash.scm @@ -0,0 +1,131 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (guix hash) + #:use-module (guix config) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (system foreign) + #:use-module ((guix build utils) #:select (dump-port)) + #:use-module (srfi srfi-11) + #:export (sha256 + open-sha256-port + port-sha256)) + +;;; Commentary: +;;; +;;; Cryptographic hashes. +;;; +;;; Code: + + +;;; +;;; Hash. +;;; + +(define-syntax GCRY_MD_SHA256 + ;; Value as of Libgcrypt 1.5.2. + (identifier-syntax 8)) + +(define sha256 + (let ((hash (pointer->procedure void + (dynamic-func "gcry_md_hash_buffer" + (dynamic-link %libgcrypt)) + `(,int * * ,size_t)))) + (lambda (bv) + "Return the SHA256 of BV as a bytevector." + (let ((digest (make-bytevector (/ 256 8)))) + (hash GCRY_MD_SHA256 (bytevector->pointer digest) + (bytevector->pointer bv) (bytevector-length bv)) + digest)))) + +(define open-sha256-md + (let ((open (pointer->procedure int + (dynamic-func "gcry_md_open" + (dynamic-link %libgcrypt)) + `(* ,int ,unsigned-int)))) + (lambda () + (let* ((md (bytevector->pointer (make-bytevector (sizeof '*)))) + (err (open md GCRY_MD_SHA256 0))) + (if (zero? err) + (dereference-pointer md) + (throw 'gcrypt-error err)))))) + +(define md-write + (pointer->procedure void + (dynamic-func "gcry_md_write" + (dynamic-link %libgcrypt)) + `(* * ,size_t))) + +(define md-read + (pointer->procedure '* + (dynamic-func "gcry_md_read" + (dynamic-link %libgcrypt)) + `(* ,int))) + +(define md-close + (pointer->procedure void + (dynamic-func "gcry_md_close" + (dynamic-link %libgcrypt)) + '(*))) + + +(define (open-sha256-port) + "Return two values: an output port, and a thunk. When the thunk is called, +it returns the SHA256 hash (a bytevector) of all the data written to the +output port." + (define sha256-md + (open-sha256-md)) + + (define digest #f) + + (define (finalize!) + (let ((ptr (md-read sha256-md 0))) + (set! digest (bytevector-copy (pointer->bytevector ptr 32))) + (md-close sha256-md))) + + (define (write! bv offset len) + (if (zero? len) + (begin + (finalize!) + 0) + (let ((ptr (bytevector->pointer bv offset))) + (md-write sha256-md ptr len) + len))) + + (define (close) + (unless digest + (finalize!))) + + (values (make-custom-binary-output-port "sha256" + write! #f #f + close) + (lambda () + (unless digest + (finalize!)) + digest))) + +(define (port-sha256 port) + "Return the SHA256 hash (a bytevector) of all the data drained from PORT." + (let-values (((out get) + (open-sha256-port))) + (dump-port port out) + (close-port out) + (get))) + +;;; hash.scm ends here diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index da5fa5be9e..87b420405c 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -19,6 +19,7 @@ (define-module (guix scripts download) #:use-module (guix ui) #:use-module (guix store) + #:use-module (guix hash) #:use-module (guix utils) #:use-module (guix base32) #:use-module (guix download) @@ -115,7 +116,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16' (or path (leave (_ "~a: download failed~%") arg)) - (compose sha256 get-bytevector-all))) + port-sha256)) (fmt (assq-ref opts 'format))) (format #t "~a~%~a~%" path (fmt hash)) #t))) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 1b14aaadd0..ca3928b8e3 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -18,16 +18,17 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix scripts hash) - #:use-module (guix base32) - #:use-module (guix ui) - #:use-module (guix utils) - #:use-module (rnrs io ports) - #:use-module (rnrs files) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) - #:export (guix-hash)) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (rnrs io ports) + #:use-module (rnrs files) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:export (guix-hash)) ;;; diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index b8d4efd204..c75ec4f091 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -19,6 +19,7 @@ (define-module (guix scripts refresh) #:use-module (guix ui) + #:use-module (guix hash) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) @@ -136,7 +137,7 @@ values: 'interactive' (default), 'always', and 'never'." (package-name package) (package-version package) version) (let ((hash (call-with-input-file tarball - (compose sha256 get-bytevector-all)))) + port-sha256))) (update-package-source package version hash))) (warning (_ "~a: version ~a could not be \ downloaded and authenticated; not updating") diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 271a22541a..24e5d68c4f 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -124,6 +124,9 @@ pairs." ;; Number of seconds after which networking is considered "slow". 3) +(define %random-state + (seed->random-state (+ (ash (cdr (gettimeofday)) 32) (getpid)))) + (define-syntax-rule (with-timeout duration handler body ...) "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY again." @@ -140,11 +143,15 @@ again." (lambda () body ...) (lambda args - ;; The SIGALRM triggers EINTR. When that happens, try again. - ;; Note: SA_RESTART cannot be used because of - ;; <http://bugs.gnu.org/14640>. + ;; The SIGALRM triggers EINTR, because of the bug at + ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. + ;; When that happens, try again. Note: SA_RESTART cannot be + ;; used because of <http://bugs.gnu.org/14640>. (if (= EINTR (system-error-errno args)) - (try) + (begin + ;; Wait a little to avoid bursts. + (usleep (random 3000000 %random-state)) + (try)) (apply throw args)))))) (lambda result (alarm 0) @@ -168,14 +175,19 @@ provide." ;; sudo tc qdisc add dev eth0 root netem delay 1500ms ;; and then cancel with: ;; sudo tc qdisc del dev eth0 root - (with-timeout (if (or timeout? (version>? (version) "2.0.5")) - %fetch-timeout - 0) - (begin - (warning (_ "while fetching ~a: server is unresponsive~%") - (uri->string uri)) - (warning (_ "try `--no-substitutes' if the problem persists~%"))) - (http-fetch uri #:text? #f #:buffered? buffered?))))) + (let ((port #f)) + (with-timeout (if (or timeout? (version>? (version) "2.0.5")) + %fetch-timeout + 0) + (begin + (warning (_ "while fetching ~a: server is unresponsive~%") + (uri->string uri)) + (warning (_ "try `--no-substitutes' if the problem persists~%")) + (when port + (close-port port))) + (begin + (set! port (open-socket-for-uri uri #:buffered? buffered?)) + (http-fetch uri #:text? #f #:port port))))))) (define-record-type <cache> (%make-cache url store-directory wants-mass-query?) @@ -535,7 +547,7 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by (show-version-and-exit "guix substitute-binary"))))) -;;; Local Variable: +;;; Local Variables: ;;; eval: (put 'with-atomic-file-output 'scheme-indent-function 1) ;;; eval: (put 'with-timeout 'scheme-indent-function 1) ;;; End: diff --git a/guix/store.scm b/guix/store.scm index 57e1ca06aa..343da91506 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -266,8 +266,15 @@ operate, should the disk become full. Return a server object." (socket PF_UNIX SOCK_STREAM 0))) (a (make-socket-address PF_UNIX file))) - ;; Enlarge the receive buffer. - (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) + (catch 'system-error + (lambda () + ;; Enlarge the receive buffer. + (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))) + (lambda args + ;; On the Hurd, the pflocal server's implementation of `socket_setopt' + ;; always returns ENOPROTOOPT. Ignore it. + (unless (= (system-error-errno args) ENOPROTOOPT) + (apply throw args)))) (catch 'system-error (cut connect s a) diff --git a/guix/ui.scm b/guix/ui.scm index 370b41b9dc..fd35c6a8c8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -223,12 +223,15 @@ available for download." drv) (map derivation-input-path build)))) ((download) ; add the references of DOWNLOAD - (delete-duplicates - (append download - (remove (cut valid-path? store <>) - (append-map - substitutable-references - (substitutable-path-info store download))))))) + (if use-substitutes? + (delete-duplicates + (append download + (remove (cut valid-path? store <>) + (append-map + substitutable-references + (substitutable-path-info store + download))))) + download))) (if dry-run? (begin (format (current-error-port) diff --git a/guix/utils.scm b/guix/utils.scm index 2478fb6939..4187efde41 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -36,7 +36,6 @@ #:autoload (system foreign) (pointer->procedure) #:export (bytevector->base16-string base16-string->bytevector - sha256 %nixpkgs-directory nixpkgs-derivation @@ -138,23 +137,6 @@ evaluate to a simple datum." s) bv))) - -;;; -;;; Hash. -;;; - -(define sha256 - (let ((hash (pointer->procedure void - (dynamic-func "gcry_md_hash_buffer" - (dynamic-link %libgcrypt)) - `(,int * * ,size_t))) - (sha256 8)) ; GCRY_MD_SHA256, as of 1.5.0 - (lambda (bv) - "Return the SHA256 of BV as a bytevector." - (let ((digest (make-bytevector (/ 256 8)))) - (hash sha256 (bytevector->pointer digest) - (bytevector->pointer bv) (bytevector-length bv)) - digest)))) ;;; diff --git a/guix/web.scm b/guix/web.scm index d24f15853d..321c38391d 100644 --- a/guix/web.scm +++ b/guix/web.scm @@ -27,7 +27,8 @@ #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) - #:export (http-fetch)) + #:export (open-socket-for-uri + http-fetch)) ;;; Commentary: ;;; @@ -141,62 +142,67 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true." (module-define! (resolve-module '(web client)) 'shutdown (const #f)) -(define* (http-fetch uri #:key (text? #f) (buffered? #t)) +(define* (open-socket-for-uri uri #:key (buffered? #t)) + "Return an open port for URI. When BUFFERED? is false, the returned port is +unbuffered." + (let ((s ((@ (web client) open-socket-for-uri) uri))) + (unless buffered? + (setvbuf s _IONBF)) + s)) + +(define* (http-fetch uri #:key port (text? #f) (buffered? #t)) "Return an input port containing the data at URI, and the expected number of bytes available or #f. If TEXT? is true, the data at URI is considered to be textual. Follow any HTTP redirection. When BUFFERED? is #f, return an unbuffered port, suitable for use in `filtered-port'." (let loop ((uri uri)) - (define port - (let ((s (open-socket-for-uri uri))) - (unless buffered? - (setvbuf s _IONBF)) - s)) - - (let*-values (((resp data) - ;; Try hard to use the API du jour to get an input port. - ;; On Guile 2.0.5 and before, we can only get a string or - ;; bytevector, and not an input port. Work around that. - (if (version>? (version) "2.0.7") - (http-get uri #:streaming? #t #:port port) ; 2.0.9+ - (if (defined? 'http-get*) - (http-get* uri #:decode-body? text? - #:port port) ; 2.0.7 - (http-get uri #:decode-body? text? - #:port port)))) ; 2.0.5- - ((code) - (response-code resp))) - (case code - ((200) - (let ((len (response-content-length resp))) - (cond ((not data) - (begin - ;; Guile 2.0.5 and earlier did not support chunked - ;; transfer encoding, which is required for instance when - ;; fetching %PACKAGE-LIST-URL (see - ;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>). - ;; Normally the `when-guile<=2.0.5' block above fixes - ;; that, but who knows what could happen. - (warning (_ "using Guile ~a, which does not support ~s encoding~%") - (version) - (response-transfer-encoding resp)) - (leave (_ "download failed; use a newer Guile~%") - uri resp))) - ((string? data) ; `http-get' from 2.0.5- - (values (open-input-string data) len)) - ((bytevector? data) ; likewise - (values (open-bytevector-input-port data) len)) - (else ; input port - (values data len))))) - ((301 ; moved permanently - 302) ; found (redirection) - (let ((uri (response-location resp))) - (close-port port) - (format #t (_ "following redirection to `~a'...~%") - (uri->string uri)) - (loop uri))) - (else - (error "download failed" uri code - (response-reason-phrase resp))))))) + (let ((port (or port + (open-socket-for-uri uri + #:buffered? buffered?)))) + (let*-values (((resp data) + ;; Try hard to use the API du jour to get an input port. + ;; On Guile 2.0.5 and before, we can only get a string or + ;; bytevector, and not an input port. Work around that. + (if (version>? (version) "2.0.7") + (http-get uri #:streaming? #t #:port port) ; 2.0.9+ + (if (defined? 'http-get*) + (http-get* uri #:decode-body? text? + #:port port) ; 2.0.7 + (http-get uri #:decode-body? text? + #:port port)))) ; 2.0.5- + ((code) + (response-code resp))) + (case code + ((200) + (let ((len (response-content-length resp))) + (cond ((not data) + (begin + ;; Guile 2.0.5 and earlier did not support chunked + ;; transfer encoding, which is required for instance when + ;; fetching %PACKAGE-LIST-URL (see + ;; <http://lists.gnu.org/archive/html/guile-devel/2011-09/msg00089.html>). + ;; Normally the `when-guile<=2.0.5' block above fixes + ;; that, but who knows what could happen. + (warning (_ "using Guile ~a, which does not support ~s encoding~%") + (version) + (response-transfer-encoding resp)) + (leave (_ "download failed; use a newer Guile~%") + uri resp))) + ((string? data) ; `http-get' from 2.0.5- + (values (open-input-string data) len)) + ((bytevector? data) ; likewise + (values (open-bytevector-input-port data) len)) + (else ; input port + (values data len))))) + ((301 ; moved permanently + 302) ; found (redirection) + (let ((uri (response-location resp))) + (close-port port) + (format #t (_ "following redirection to `~a'...~%") + (uri->string uri)) + (loop uri))) + (else + (error "download failed" uri code + (response-reason-phrase resp)))))))) ;;; web.scm ends here diff --git a/m4/guix.m4 b/m4/guix.m4 index 4fdc409602..477b0e4eb3 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -40,6 +40,8 @@ dnl Determine the Guix host system type, and store it in the dnl `guix_system' variable. AC_DEFUN([GUIX_SYSTEM_TYPE], [ AC_REQUIRE([AC_CANONICAL_HOST]) + AC_PATH_PROG([SED], [sed]) + AC_ARG_WITH(system, AC_HELP_STRING([--with-system=SYSTEM], [Platform identifier (e.g., `i686-linux').]), [guix_system="$withval"], @@ -59,7 +61,7 @@ AC_DEFUN([GUIX_SYSTEM_TYPE], [ *) # Strip the version number from names such as `gnu0.3', # `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]) AC_MSG_CHECKING([for the Guix system type]) @@ -68,6 +70,35 @@ AC_DEFUN([GUIX_SYSTEM_TYPE], [ AC_SUBST([guix_system]) ]) +dnl GUIX_ASSERT_SUPPORTED_SYSTEM +dnl +dnl Assert that this is a system to which the distro is ported. +AC_DEFUN([GUIX_ASSERT_SUPPORTED_SYSTEM], [ + AC_REQUIRE([GUIX_SYSTEM_TYPE]) + + AC_ARG_WITH([courage], [AC_HELP_STRING([--with-courage], + [Assert that even if this platform is unsupported, you will be +courageous and port the GNU System distribution to it (see +"GNU Distribution" in the manual.)])], + [guix_courageous="$withval"], + [guix_courageous="no"]) + + # Currently only Linux-based systems are supported, and only on some + # platforms. + case "$guix_system" in + x86_64-linux|i686-linux) + ;; + *) + if test "x$guix_courageous" = "xyes"; then + AC_MSG_WARN([building Guix on `$guix_system', which is not supported]) + else + AC_MSG_ERROR([`$guix_system' is not a supported platform. +See "GNU Distribution" in the manual, or try `--with-courage'.]) + fi + ;; + esac +]) + dnl GUIX_ASSERT_GUILE_FEATURES FEATURES dnl dnl Assert that FEATURES are provided by $GUILE. diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index 5f0710c256..e2c30e75a8 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -171,10 +171,10 @@ parse_opt (int key, char *arg, struct argp_state *state) settings.thisSystem = arg; break; default: - return ARGP_ERR_UNKNOWN; + return (error_t) ARGP_ERR_UNKNOWN; } - return 0; + return (error_t) 0; } /* Argument parsing. */ diff --git a/tests/base32.scm b/tests/base32.scm index d674547557..81d242355a 100644 --- a/tests/base32.scm +++ b/tests/base32.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-base32) + #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix utils) #:use-module (srfi srfi-1) diff --git a/tests/derivations.scm b/tests/derivations.scm index 0cba98e1e8..788cffd7ad 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -21,6 +21,7 @@ #:use-module (guix derivations) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix hash) #:use-module (guix base32) #:use-module ((guix packages) #:select (package-derivation)) #:use-module ((gnu packages) #:select (search-bootstrap-binary)) diff --git a/tests/hash.scm b/tests/hash.scm new file mode 100644 index 0000000000..27751023d3 --- /dev/null +++ b/tests/hash.scm @@ -0,0 +1,74 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 (test-hash) + #:use-module (guix hash) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports)) + +;; Test the (guix hash) module. + +(define %empty-sha256 + ;; SHA256 hash of the empty string. + (base16-string->bytevector + "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) + +(define %hello-sha256 + ;; SHA256 hash of "hello world" + (base16-string->bytevector + "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9")) + +(test-begin "hash") + +(test-equal "sha256, empty" + %empty-sha256 + (sha256 #vu8())) + +(test-equal "sha256, hello" + %hello-sha256 + (sha256 (string->utf8 "hello world"))) + +(test-equal "open-sha256-port, empty" + %empty-sha256 + (let-values (((port get) + (open-sha256-port))) + (close-port port) + (get))) + +(test-equal "open-sha256-port, hello" + %hello-sha256 + (let-values (((port get) + (open-sha256-port))) + (put-bytevector port (string->utf8 "hello world")) + (get))) + +(test-assert "port-sha256" + (let* ((file (search-path %load-path "ice-9/psyntax.scm")) + (size (stat:size (stat file))) + (contents (call-with-input-file file get-bytevector-all))) + (equal? (sha256 contents) + (call-with-input-file file port-sha256)))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/packages.scm b/tests/packages.scm index a4bb7fbd31..78770c7d94 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -70,10 +70,14 @@ (goto port line column) (read port)))))) - (and (equal? (read-at (package-field-location %bootstrap-guile 'name)) - (package-name %bootstrap-guile)) - (equal? (read-at (package-field-location %bootstrap-guile 'version)) - (package-version %bootstrap-guile)) + ;; Until Guile 2.0.6 included, source properties were added only to pairs. + ;; Thus, check against both VALUE and (FIELD VALUE). + (and (member (read-at (package-field-location %bootstrap-guile 'name)) + (let ((name (package-name %bootstrap-guile))) + (list name `(name ,name)))) + (member (read-at (package-field-location %bootstrap-guile 'version)) + (let ((version (package-version %bootstrap-guile))) + (list version `(version ,version)))) (not (package-field-location %bootstrap-guile 'does-not-exist))))) (test-assert "package-transitive-inputs" diff --git a/tests/store.scm b/tests/store.scm index b42bc97017..3d5d59b991 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -20,6 +20,7 @@ (define-module (test-store) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix packages) #:use-module (guix derivations) |