diff --git a/gnu-system.am b/gnu-system.am index 52c58d8c90..b47163c1f4 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -89,6 +89,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/gnome.scm \ gnu/packages/gnunet.scm \ gnu/packages/gnupg.scm \ + gnu/packages/gnustep.scm \ gnu/packages/gnutls.scm \ gnu/packages/gnuzilla.scm \ gnu/packages/gnu-pw-mgr.scm \ diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index ffedfd3f44..89df1a9148 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -317,6 +318,13 @@ ONC RPC numbers") (base32 "1frjcdkhkpzk0f84hx6hmw5l0ynpmji8vcbaxg8h5k2svyxz0nmm")))) (build-system gnu-build-system) + (arguments + `(#:configure-flags + ;; By default, man and info pages are put in PREFIX/{man,info}, + ;; but we want them in PREFIX/share/{man,info}. + (let ((out (assoc-ref %outputs "out"))) + (list (string-append "--mandir=" out "/share/man") + (string-append "--infodir=" out "/share/info"))))) (home-page "http://netcat.sourceforge.net") (synopsis "Read and write data over TCP/IP") (description diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index faab4edc85..a1564e000e 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Andreas Enge ;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -179,8 +180,14 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.") (let ((out (assoc-ref outputs "out"))) (setenv "CONFIG_SHELL" (which "bash")) (zero? - (system* "./configure" - (string-append "--prefix=" out))))) + (system* + "./configure" + (string-append "--prefix=" out) + ;; By default, man and info pages are put in + ;; PREFIX/{man,info}, but we want them in + ;; PREFIX/share/{man,info}. + (string-append "--mandir=" out "/share/man") + (string-append "--infodir=" out "/share/info"))))) %standard-phases))) (home-page "http://www.gnu.org/software/bc/") (synopsis "Arbitrary precision numeric processing language") diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 89d90c989b..1f6e86341f 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2012 Nikita Karetnikov +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -500,7 +501,7 @@ with the Linux kernel.") (define-public tzdata (package (name "tzdata") - (version "2013d") + (version "2014a") (source (origin (method url-fetch) (uri (string-append @@ -508,7 +509,7 @@ with the Linux kernel.") version ".tar.gz")) (sha256 (base32 - "011v63ppr73vhjgxv00inkn5pc7z48i8lhbapkpdq3kfczq9c76d")))) + "1cg843ajz4g16axpz56zvalwsbp1s764na2bk4fb44ayx162bzvw")))) (build-system gnu-build-system) (arguments '(#:tests? #f @@ -555,7 +556,7 @@ with the Linux kernel.") version ".tar.gz")) (sha256 (base32 - "1dh7nzmfxs8fps4bzcd2lz5fz24zxy2123a99avxsk34jh6bk7id")))))) + "1xfkqi1q8cnxqbv8azdj5pqlzhkjz6xag09f1z0s8rxi86jkpf85")))))) (home-page "http://www.iana.org/time-zones") (synopsis "Database of current and historical time zones") (description "The Time Zone Database (often called tz or zoneinfo) diff --git a/gnu/packages/cmake.scm b/gnu/packages/cmake.scm index 84873f4a3b..87a70decc7 100644 --- a/gnu/packages/cmake.scm +++ b/gnu/packages/cmake.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Cyril Roelandt +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +23,8 @@ #:use-module (guix download) #:use-module (guix build-system gnu) #:use-module (gnu packages) - #:use-module (gnu packages file)) + #:use-module (gnu packages file) + #:use-module (srfi srfi-1)) (define-public cmake (package @@ -32,15 +34,15 @@ (method url-fetch) (uri (string-append "http://www.cmake.org/files/v" - (substring version 0 - (string-index version #\. (+ 1 (string-index version #\.)))) + (string-join (take (string-split version #\.) 2) + ".") "/cmake-" version ".tar.gz")) (sha256 (base32 "11q21vyrr6c6smyjy81k2k07zmn96ggjia9im9cxwvj0n88bm1fq")) (patches (list (search-patch "cmake-fix-tests.patch"))))) (build-system gnu-build-system) (arguments - '(#:test-target "test" + `(#:test-target "test" #:phases (alist-replace 'configure (lambda* (#:key outputs #:allow-other-keys) @@ -61,8 +63,20 @@ "Utilities/cmlibarchive/libarchive/archive_write_set_format_shar.c" "Tests/CMakeLists.txt") (("/bin/sh") (which "sh"))) - (zero? (system* "./configure" - (string-append "--prefix=" out))))) + (zero? (system* + "./configure" + (string-append "--prefix=" out) + ;; By default, the man pages and other docs land + ;; in PREFIX/man and PREFIX/doc, but we want them + ;; in share/{man,doc}. Note that unlike + ;; autoconf-generated configure scripts, cmake's + ;; configure prepends "PREFIX/" to what we pass + ;; to --mandir and --docdir. + "--mandir=share/man" + ,(string-append + "--docdir=share/doc/cmake-" + (string-join (take (string-split version #\.) 2) + ".")))))) %standard-phases))) (inputs `(("file" ,file))) diff --git a/gnu/packages/gnustep.scm b/gnu/packages/gnustep.scm new file mode 100644 index 0000000000..8584ba6096 --- /dev/null +++ b/gnu/packages/gnustep.scm @@ -0,0 +1,71 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu packages gnustep) + #:use-module (guix download) + #:use-module (guix packages) + #:use-module (guix build-system gnu) + #:use-module (guix licenses) + #:use-module (gnu packages xorg) + #:use-module (gnu packages fontutils) + #:use-module (gnu packages libjpeg) + #:use-module (gnu packages pkg-config)) + +(define-public windowmaker + (package + (name "windowmaker") + (version "0.95.5") + (source (origin + (method url-fetch) + (uri (string-append + "http://windowmaker.org/pub/source/release/WindowMaker-" + version ".tar.gz")) + (sha256 + (base32 + "1l3hmx4jzf6vp0zclqx9gsqrlwh4rvqm1g1zr5ha0cp0zmsg89ab")))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-cons-after + 'install 'wrap + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + ;; 'wmaker' wants to invoke 'wmaker.inst' the first time, + ;; which in turn wants to invoke 'wmmenugen' etc., so + ;; make sure everything is in $PATH. + (wrap-program (string-append bin "/wmaker") + `("PATH" ":" prefix (,bin))))) + %standard-phases))) + (inputs + `(("libxmu" ,libxmu) + ("libxft" ,libxft) + ("libx11" ,libx11) + ("fontconfig" ,fontconfig) + ("libjpeg" ,libjpeg))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (home-page "http://windowmaker.org/") + (synopsis "NeXTSTEP-like window manager") + (description + "Window Maker is an X11 window manager originally designed to provide +integration support for the GNUstep Desktop Environment. In every way +possible, it reproduces the elegant look and feel of the NeXTSTEP user +interface. It is fast, feature rich, easy to configure, and easy to use.") + + ;; Artwork is distributed under the WTFPL. + (license gpl2+))) diff --git a/gnu/packages/imagemagick.scm b/gnu/packages/imagemagick.scm index a1713273e9..e8869ddfd5 100644 --- a/gnu/packages/imagemagick.scm +++ b/gnu/packages/imagemagick.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,14 +37,14 @@ (define-public imagemagick (package (name "imagemagick") - (version "6.8.8-4") + (version "6.8.8-8") (source (origin (method url-fetch) (uri (string-append "mirror://imagemagick/ImageMagick-" version ".tar.xz")) (sha256 (base32 - "0bfxhfymkdbvardlr0nbjfmv53m47lcl9kkycipk4hxawfs927jr")))) + "1b1j4j6gyxd02nm7v70d8prjvh09dk9klralrr8avm9ys1wqd7r4")))) (build-system gnu-build-system) (arguments `(#:phases (alist-cons-before diff --git a/gnu/packages/lua.scm b/gnu/packages/lua.scm index 81caa263ad..8394afb641 100644 --- a/gnu/packages/lua.scm +++ b/gnu/packages/lua.scm @@ -66,13 +66,13 @@ for configuration, scripting, and rapid prototyping.") (define-public luajit (package (name "luajit") - (version "2.0.2") + (version "2.0.3") (source (origin (method url-fetch) (uri (string-append "http://luajit.org/download/LuaJIT-" version ".tar.gz")) (sha256 - (base32 "0f3cykihfdn3gi6na9p0xjd4jnv26z18m441n5vyg42q9abh4ln0")))) + (base32 "0ydxpqkmsn2c341j4r2v6r5r0ig3kbwv3i9jran3iv81s6r6rgjm")))) (build-system gnu-build-system) (arguments '(#:tests? #f ;luajit is distributed without tests diff --git a/gnu/packages/lynx.scm b/gnu/packages/lynx.scm index a87316643d..ebca50d34f 100644 --- a/gnu/packages/lynx.scm +++ b/gnu/packages/lynx.scm @@ -33,13 +33,15 @@ (define-public lynx (package (name "lynx") - (version "2.8.8") + (version "2.8.8rel.2") (source (origin (method url-fetch) - (uri (string-append "http://lynx.isc.org/lynx" version - "/lynx" version ".tar.bz2")) + (uri (string-append + "http://lynx.isc.org/lynx" + (substring version 0 (string-index version char-set:letter)) + "/lynx" version ".tar.bz2")) (sha256 - (base32 "00jcfmx4bxnrzywzzlllz3z45a2mc4fl91ca5lrzz1pyr1s1qnm2")))) + (base32 "1rxysl08acqll5b87368f04kckl8sggy1qhnq59gsxyny1ffg039")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config) ("perl" ,perl))) diff --git a/gnu/packages/screen.scm b/gnu/packages/screen.scm index bb11c58fc1..58ee42a2a2 100644 --- a/gnu/packages/screen.scm +++ b/gnu/packages/screen.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Cyril Roelandt +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,6 +40,13 @@ (inputs `(("ncurses", ncurses) ("perl" ,perl))) + (arguments + `(#:configure-flags + ;; By default, man and info pages are put in PREFIX/{man,info}, + ;; but we want them in PREFIX/share/{man,info}. + (let ((out (assoc-ref %outputs "out"))) + (list (string-append "--mandir=" out "/share/man") + (string-append "--infodir=" out "/share/info"))))) (home-page "http://www.gnu.org/software/screen/") (synopsis "Full-screen window manager providing multiple terminals") (description diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index 6bf68a916e..43c1b6e90b 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -121,14 +122,14 @@ a server that supports the SSH-2 protocol.") (define-public openssh (package (name "openssh") - (version "6.5p1") + (version "6.6p1") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh-" version ".tar.gz")) (sha256 (base32 - "09wh7mi65aahyxd2xvq1makckhd5laid8c0pb8njaidrbpamw6d1")))) + "1fq3w86q05y5nn6z878wm312k0svaprw8k007188fd259dkg1ha8")))) (build-system gnu-build-system) (inputs `(("groff" ,groff) ("openssl" ,openssl) diff --git a/gnu/packages/xiph.scm b/gnu/packages/xiph.scm index 0e8cb5fafc..2de9074f28 100644 --- a/gnu/packages/xiph.scm +++ b/gnu/packages/xiph.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 David Thompson ;;; Copyright © 2014 Sree Harsha Totakura +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -80,7 +81,8 @@ periodic timestamps for seeking.") "1gby6hapz9njx4l9g0pndyk4q83z5fgrgc30mfwfgx7bllspsk43")))) (build-system gnu-build-system) (propagated-inputs `(("libogg" ,libogg))) - (arguments `(#:configure-flags '("LDFLAGS=-lm"))) + (arguments `(#:configure-flags '("LDFLAGS=-lm") + #:parallel-tests? #f)) (synopsis "libvorbis, a library implementing the vorbis audio format") (description "The libvorbis library implements the ogg vorbis audio format, @@ -201,7 +203,12 @@ OpenBSD's sndio.") (list (search-patch "flac-fix-memcmp-not-declared.patch"))))) (build-system gnu-build-system) (arguments - `(#:parallel-tests? #f)) + `(#:parallel-tests? #f + ;; By default, man pages are put in PREFIX/man, + ;; but we want them in PREFIX/share/man. + #:configure-flags (list (string-append "--mandir=" + (assoc-ref %outputs "out") + "/share/man")))) ;; FIXME: configure also looks for xmms, input could be added once it exists (inputs `(("libogg" ,libogg))) (synopsis "flac free lossless audio codec") diff --git a/gnu/packages/xorg.scm b/gnu/packages/xorg.scm index 13da10d7cb..2e1eeda245 100644 --- a/gnu/packages/xorg.scm +++ b/gnu/packages/xorg.scm @@ -1260,13 +1260,13 @@ tracking.") "1gdv6559cdz1lfw73x7wsvax1fkvphmayrymprljhyyb5nwk5kkz")))) (build-system gnu-build-system) (propagated-inputs - ;; xft.pc refers to 'xrender'. - `(("libxrender" ,libxrender))) - (inputs - `(("libx11" ,libx11) - ("xproto" ,xproto) + ;; xft.pc refers to all these. + `(("libxrender" ,libxrender) ("freetype" ,freetype) ("fontconfig" ,fontconfig))) + (inputs + `(("libx11" ,libx11) + ("xproto" ,xproto))) (native-inputs `(("pkg-config" ,pkg-config))) (home-page "http://www.x.org/wiki/") @@ -4731,14 +4731,14 @@ icccm: Both client and window-manager helpers for ICCCM.") (define-public xterm (package (name "xterm") - (version "301") + (version "303") (source (origin (method url-fetch) (uri ; XXX: constant URL! "http://invisible-island.net/datafiles/release/xterm.tar.gz") (sha256 (base32 - "040rarvv18zg0lk7qy0m3n7gv10mh40jic708wvng01z4rlbpfhz")))) + "0n7hay16aam9kfn642ri0wj5yzilbjm3l8znxc2p5dx9pn3rkwla")))) (build-system gnu-build-system) (arguments '(#:configure-flags '("--enable-wide-chars" "--enable-256-color" diff --git a/gnu/packages/zip.scm b/gnu/packages/zip.scm index c0fd8c519e..03f3bc22ea 100644 --- a/gnu/packages/zip.scm +++ b/gnu/packages/zip.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,7 +90,9 @@ Compression ratios of 2:1 to 3:1 are common for text files.") (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out"))) (copy-file "unix/Makefile" "Makefile") - (substitute* "Makefile" (("/usr/local") out)))) + (substitute* "Makefile" + (("/usr/local") out) + (("/man/") "/share/man/")))) %standard-phases))) (home-page "http://www.info-zip.org/UnZip.html") (synopsis "Unzip decompression and file extraction utility") diff --git a/guix/pk-crypto.scm b/guix/pk-crypto.scm index 50f709418c..481d3f2463 100644 --- a/guix/pk-crypto.scm +++ b/guix/pk-crypto.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,7 +24,8 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) - #:export (canonical-sexp? + #:export (gcrypt-version + canonical-sexp? error-source error-string string->canonical-sexp @@ -39,6 +40,7 @@ canonical-sexp-list? bytevector->hash-data hash-data->bytevector + key-type sign verify generate-key @@ -85,6 +87,17 @@ "Return a pointer to symbol FUNC in libgcrypt." (dynamic-func func lib)))) +(define gcrypt-version + ;; According to the manual, this function must be called before any other, + ;; and it's not clear whether it can be called more than once. So call it + ;; right here from the top level. + (let* ((ptr (libgcrypt-func "gcry_check_version")) + (proc (pointer->procedure '* ptr '(*))) + (version (pointer->string (proc %null-pointer)))) + (lambda () + "Return the version number of libgcrypt as a string." + version))) + (define finalize-canonical-sexp! (libgcrypt-func "gcry_sexp_release")) @@ -232,15 +245,31 @@ Return #f if that element does not exist, or if it's a list." "Return an s-expression representing NUMBER." (string->canonical-sexp (string-append "#" (number->string number 16) "#"))) -(define* (bytevector->hash-data bv #:optional (hash-algo "sha256")) +(define* (bytevector->hash-data bv + #:optional + (hash-algo "sha256") + #:key (key-type 'ecc)) "Given BV, a bytevector containing a hash, return an s-expression suitable -for use as the data for 'sign'." +for use as the data for 'sign'. KEY-TYPE must be a symbol: 'dsa, 'ecc, or +'rsa." (string->canonical-sexp - (format #f "(data (flags pkcs1) (hash \"~a\" #~a#))" + (format #f "(data (flags ~a) (hash \"~a\" #~a#))" + (case key-type + ((ecc dsa) "rfc6979") + ((rsa) "pkcs1") + (else (error "unknown key type" key-type))) hash-algo (bytevector->base16-string bv)))) -(define (hash-data->bytevector data) +(define (key-type sexp) + "Return a symbol denoting the type of key representing by SEXP--e.g., 'rsa', +'ecc'--or #f if SEXP does not denote a valid key." + (case (canonical-sexp-nth-data sexp 0) + ((public-key private-key) + (canonical-sexp-nth-data (canonical-sexp-nth sexp 1) 0)) + (else #f))) + +(define* (hash-data->bytevector data) "Return two values: the hash value (a bytevector), and the hash algorithm (a string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'. Return #f if DATA does not conform." diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 0ab7686585..c900fcecb9 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -87,6 +87,13 @@ Export/import one or more packages from/to the store.\n")) (newline) (show-bug-report-information)) +(define %key-generation-parameters + ;; Default key generation parameters. We prefer Ed25519, but it was + ;; introduced in libgcrypt 1.6.0. + (if (version>? (gcrypt-version) "1.6.0") + "(genkey (ecdsa (curve Ed25519) (flags rfc6979)))" + "(genkey (rsa (nbits 4:4096)))")) + (define %options ;; Specifications of the command-line options. (cons* (option '(#\h "help") #f #f @@ -110,13 +117,16 @@ Export/import one or more packages from/to the store.\n")) (lambda (opt name arg result) (catch 'gcry-error (lambda () + ;; XXX: Curve25519 was actually introduced in + ;; libgcrypt 1.6.0. (let ((params (string->canonical-sexp - (or arg "(genkey (rsa (nbits 4:4096)))")))) + (or arg %key-generation-parameters)))) (alist-cons 'generate-key params result))) - (lambda args - (leave (_ "invalid key generation parameters: ~s~%") - arg))))) + (lambda (key err) + (leave (_ "invalid key generation parameters: ~a: ~a~%") + (error-source err) + (error-string err)))))) (option '("authorize") #f #f (lambda (opt name arg result) (alist-cons 'authorize #t result))) diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm index 27580dedff..927dbe8afc 100644 --- a/guix/scripts/authenticate.scm +++ b/guix/scripts/authenticate.scm @@ -39,11 +39,12 @@ (call-with-input-file file (compose string->canonical-sexp get-string-all))) -(define (read-hash-data file) - "Read sha256 hash data from FILE and return it as a gcrypt sexp." +(define (read-hash-data file key-type) + "Read sha256 hash data from FILE and return it as a gcrypt sexp. KEY-TYPE +is a symbol representing the type of public key algo being used." (let* ((hex (call-with-input-file file get-string-all)) (bv (base16-string->bytevector (string-trim-both hex)))) - (bytevector->hash-data bv))) + (bytevector->hash-data bv #:key-type key-type))) ;;; @@ -64,7 +65,7 @@ (leave (_ "cannot find public key for secret key '~a'~%") key))) - (data (read-hash-data hash-file)) + (data (read-hash-data hash-file (key-type public-key))) (signature (signature-sexp data secret-key public-key))) (display (canonical-sexp->string signature)) #t)) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 95e35088a1..e078012582 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -159,19 +159,35 @@ determined." ;; (leave (_ "failed to execute '~a': ~a~%") ;; %lsh-command (strerror (system-error-errno args)))))) -(define (remote-pipe machine mode command) +(define-syntax with-error-to-port + (syntax-rules () + ((_ port exp0 exp ...) + (let ((new port) + (old (current-error-port))) + (dynamic-wind + (lambda () + (set-current-error-port new)) + (lambda () + exp0 exp ...) + (lambda () + (set-current-error-port old))))))) + +(define* (remote-pipe machine mode command + #:key (error-port (current-error-port))) "Run COMMAND on MACHINE, assuming an lsh gateway has been set up." (catch 'system-error (lambda () - (apply open-pipe* mode %lshg-command "-z" - "-l" (build-machine-user machine) - "-p" (number->string (build-machine-port machine)) + ;; Let the child inherit ERROR-PORT. + (with-error-to-port error-port + (apply open-pipe* mode %lshg-command "-z" + "-l" (build-machine-user machine) + "-p" (number->string (build-machine-port machine)) - ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. - "-i" (build-machine-private-key machine) + ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. + "-i" (build-machine-private-key machine) - (build-machine-name machine) - command)) + (build-machine-name machine) + command))) (lambda args (warning (_ "failed to execute '~a': ~a~%") %lshg-command (strerror (system-error-errno args))) @@ -257,9 +273,18 @@ connections allowed to MACHINE." ;;; Offloading. ;;; +(define (build-log-port) + "Return the default port where build logs should be sent. The default is +file descriptor 4, which is open by the daemon before running the offload +hook." + (let ((port (fdopen 4 "w0"))) + ;; Make sure file descriptor 4 isn't closed when PORT is GC'd. + (set-port-revealed! port 1) + port)) + (define* (offload drv machine #:key print-build-trace? (max-silent-time 3600) - build-timeout (log-port (current-output-port))) + build-timeout (log-port (build-log-port))) "Perform DRV on MACHINE, assuming DRV and its prerequisites are available there, and write the build log to LOG-PORT. Return the exit status." (format (current-error-port) "offloading '~a' to '~a'...~%" @@ -276,7 +301,11 @@ there, and write the build log to LOG-PORT. Return the exit status." (list (format #f "--timeout=~a" build-timeout)) '()) - ,(derivation-file-name drv))))) + ,(derivation-file-name drv)) + + ;; Since 'guix build' writes the build log to its + ;; stderr, everything will go directly to LOG-PORT. + #:error-port log-port))) (let loop ((line (read-line pipe))) (unless (eof-object? line) (display line log-port) @@ -597,6 +626,7 @@ This tool is meant to be used internally by 'guix-daemon'.\n")) ;;; Local Variables: ;;; eval: (put 'with-machine-lock 'scheme-indent-function 2) ;;; eval: (put 'with-file-lock 'scheme-indent-function 1) +;;; eval: (put 'with-error-to-port 'scheme-indent-function 1) ;;; End: ;;; offload.scm ends here diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 54f4aaa6c0..7ac12ddef2 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -125,9 +125,10 @@ again." (sigaction SIGALRM SIG_DFL) (apply values result))))) -(define* (fetch uri #:key (buffered? #t) (timeout? #t)) +(define* (fetch uri #:key (buffered? #t) (timeout? #t) (quiet-404? #f)) "Return a binary input port to URI and the number of bytes it's expected to -provide." +provide. If QUIET-404? is true, HTTP 404 error conditions are passed through +to the caller without emitting an error message." (case (uri-scheme uri) ((file) (let ((port (open-file (uri-path uri) @@ -135,10 +136,12 @@ provide." (values port (stat:size (stat port))))) ((http) (guard (c ((http-get-error? c) - (leave (_ "download from '~a' failed: ~a, ~s~%") - (uri->string (http-get-error-uri c)) - (http-get-error-code c) - (http-get-error-reason c)))) + (let ((code (http-get-error-code c))) + (if (and (= code 404) quiet-404?) + (raise c) + (leave (_ "download from '~a' failed: ~a, ~s~%") + (uri->string (http-get-error-uri c)) + code (http-get-error-reason c)))))) ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So ;; honor TIMEOUT? to disable the timeout when fetching a nar. ;; @@ -275,8 +278,9 @@ reading PORT." "Return the record for PATH, or #f if CACHE does not hold PATH." (define (download url) ;; Download the .narinfo from URL, and return its contents as a list of - ;; key/value pairs. - (false-if-exception (fetch (string->uri url)))) + ;; key/value pairs. Don't emit an error message upon 404. + (false-if-exception (fetch (string->uri url) + #:quiet-404? #t))) (and (string=? (cache-store-directory cache) (%store-prefix)) (and=> (download (string-append (cache-url cache) "/" diff --git a/nix-upstream b/nix-upstream index bf0ad8aabc..3fc056927c 160000 --- a/nix-upstream +++ b/nix-upstream @@ -1 +1 @@ -Subproject commit bf0ad8aabca67b4faabe3a1ac3c57884ae9924f4 +Subproject commit 3fc056927c962ec9778e94528f2f9ae316afca4e diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index 79cd080363..086b846ce1 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -287,10 +287,11 @@ main (int argc, char *argv[]) string subs = getEnv ("NIX_SUBSTITUTERS", "default"); if (subs == "default") - settings.substituters.push_back (settings.nixLibexecDir - + "/guix/substitute-binary"); - else - settings.substituters = tokenizeString (subs, ":"); + { + string subst = + settings.nixLibexecDir + "/guix/substitute-binary"; + setenv ("NIX_SUBSTITUTERS", subst.c_str (), 1); + } } if (geteuid () == 0 && settings.buildUsersGroup.empty ()) diff --git a/test-env.in b/test-env.in index 9b5817f4ee..3853ce91ef 100644 --- a/test-env.in +++ b/test-env.in @@ -30,7 +30,7 @@ then NIX_IGNORE_SYMLINK_STORE=1 # in case the store is a symlink NIX_STORE_DIR="@GUIX_TEST_ROOT@/store" NIX_LOCALSTATE_DIR="@GUIX_TEST_ROOT@/var" - NIX_LOG_DIR="@GUIX_TEST_ROOT@/var/log/nix" + NIX_LOG_DIR="@GUIX_TEST_ROOT@/var/log/guix" NIX_DB_DIR="@GUIX_TEST_ROOT@/db" NIX_ROOT_FINDER="@abs_top_builddir@/nix/scripts/list-runtime-roots" diff --git a/tests/guix-register.sh b/tests/guix-register.sh index ee633af4f9..019a451b3b 100644 --- a/tests/guix-register.sh +++ b/tests/guix-register.sh @@ -84,8 +84,8 @@ guix-register --prefix "$new_store" "$closure" NIX_IGNORE_SYMLINK_STORE=1 NIX_STORE_DIR="$new_store_dir" NIX_STATE_DIR="$new_store$localstatedir" -NIX_LOG_DIR="$new_store$localstatedir/log/nix" -NIX_DB_DIR="$new_store$localstatedir/nix/db" +NIX_LOG_DIR="$new_store$localstatedir/log/guix" +NIX_DB_DIR="$new_store$localstatedir/guix/db" export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR \ NIX_LOG_DIR NIX_DB_DIR diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm index 6774dd4157..294c7f3df8 100644 --- a/tests/pk-crypto.scm +++ b/tests/pk-crypto.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +31,7 @@ ;; Test the (guix pk-crypto) module. (define %key-pair - ;; Key pair that was generated with: + ;; RSA key pair that was generated with: ;; (generate-key (string->canonical-sexp "(genkey (rsa (nbits 4:1024)))")) ;; which takes a bit of time. "(key-data @@ -48,6 +48,20 @@ (q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#) (u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))))") +(define %ecc-key-pair + ;; Ed25519 key pair generated with: + ;; (generate-key (string->canonical-sexp "(genkey (ecdsa (curve Ed25519) (flags rfc6979 transient)))")) + "(key-data + (public-key + (ecc + (curve Ed25519) + (q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#))) + (private-key + (ecc + (curve Ed25519) + (q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#) + (d #6EFB32D0B4EC6B3237B523539F1979379B82726AAA605EB2FBA6775B2B777B78#))))") + (test-begin "pk-crypto") (let ((sexps '("(foo bar)" @@ -148,8 +162,32 @@ (and (string=? algo "sha256") (bytevector=? value bv)))))) +(test-equal "key-type" + '(rsa ecc) + (map (compose key-type + (cut find-sexp-token <> 'public-key) + string->canonical-sexp) + (list %key-pair %ecc-key-pair))) + (test-assert "sign + verify" (let* ((pair (string->canonical-sexp %key-pair)) + (secret (find-sexp-token pair 'private-key)) + (public (find-sexp-token pair 'public-key)) + (data (bytevector->hash-data + (sha256 (string->utf8 "Hello, world.")) + #:key-type (key-type public))) + (sig (sign data secret))) + (and (verify sig data public) + (not (verify sig + (bytevector->hash-data + (sha256 (string->utf8 "Hi!")) + #:key-type (key-type public)) + public))))) + +;; Ed25519 appeared in libgcrypt 1.6.0. +(test-skip (if (version>? (gcrypt-version) "1.6.0") 0 1)) +(test-assert "sign + verify, Ed25519" + (let* ((pair (string->canonical-sexp %ecc-key-pair)) (secret (find-sexp-token pair 'private-key)) (public (find-sexp-token pair 'public-key)) (data (bytevector->hash-data diff --git a/tests/store.scm b/tests/store.scm index 78023a423d..d23024bcbc 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -87,7 +87,39 @@ (%store-prefix) "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile"))))) -(test-skip (if %store 0 11)) +(test-skip (if %store 0 13)) + +(test-assert "valid-path? live" + (let ((p (add-text-to-store %store "hello" "hello, world"))) + (valid-path? %store p))) + +(test-assert "valid-path? false" + (not (valid-path? %store + (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foobar")))) + +(test-assert "valid-path? error" + (with-store s + (guard (c ((nix-protocol-error? c) #t)) + (valid-path? s "foo") + #f))) + +(test-assert "valid-path? recovery" + ;; Prior to Nix commit 51800e0 (18 Mar. 2014), the daemon would immediately + ;; close the connection after receiving a 'valid-path?' RPC with a non-store + ;; file name. See + ;; for + ;; details. + (with-store s + (let-syntax ((true-if-error (syntax-rules () + ((_ exp) + (guard (c ((nix-protocol-error? c) #t)) + exp #f))))) + (and (true-if-error (valid-path? s "foo")) + (true-if-error (valid-path? s "bar")) + (true-if-error (valid-path? s "baz")) + (true-if-error (valid-path? s "chbouib")) + (valid-path? s (add-text-to-store s "valid" "yeah")))))) (test-assert "hash-part->path" (let ((p (add-text-to-store %store "hello" "hello, world")))