summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.dir-locals.el2
-rw-r--r--gnu-system.am1
-rw-r--r--gnu/packages/algebra.scm38
-rw-r--r--gnu/packages/autotools.scm31
-rw-r--r--gnu/packages/cursynth.scm52
-rw-r--r--gnu/packages/gnu-pw-mgr.scm4
-rw-r--r--gnu/packages/pulseaudio.scm2
-rw-r--r--gnu/packages/recutils.scm12
-rw-r--r--gnu/packages/ssh.scm12
-rw-r--r--gnu/packages/tor.scm5
-rw-r--r--guix/build/download.scm6
-rw-r--r--guix/licenses.scm2
-rw-r--r--guix/scripts/authenticate.scm94
-rw-r--r--guix/scripts/offload.scm75
-rwxr-xr-xguix/scripts/substitute-binary.scm13
-rw-r--r--guix/utils.scm129
m---------nix-upstream0
-rw-r--r--tests/derivations.scm3
-rw-r--r--tests/guix-authenticate.sh13
-rw-r--r--tests/utils.scm31
20 files changed, 391 insertions, 134 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 03d9a4ec8d..22ade9f8a5 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -22,6 +22,8 @@
(eval . (put 'with-error-handling 'scheme-indent-function 0))
(eval . (put 'with-mutex 'scheme-indent-function 1))
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
+ (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
+ (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
diff --git a/gnu-system.am b/gnu-system.am
index 9eda697f64..caaa5e5e6a 100644
--- a/gnu-system.am
+++ b/gnu-system.am
@@ -54,6 +54,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/cross-base.scm \
gnu/packages/cryptsetup.scm \
gnu/packages/curl.scm \
+ gnu/packages/cursynth.scm \
gnu/packages/cyrus-sasl.scm \
gnu/packages/dc.scm \
gnu/packages/dejagnu.scm \
diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm
index a1564e000e..86f8361a63 100644
--- a/gnu/packages/algebra.scm
+++ b/gnu/packages/algebra.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2012, 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
@@ -27,7 +27,8 @@
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix download)
- #:use-module (guix build-system gnu))
+ #:use-module (guix build-system gnu)
+ #:use-module (guix utils))
(define-public mpfrcx
@@ -82,14 +83,14 @@ solve the shortest vector problem.")
(define-public pari-gp
(package
(name "pari-gp")
- (version "2.5.5")
+ (version "2.7.0")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-"
version ".tar.gz"))
(sha256 (base32
- "058nw1fhggy7idii4f124ami521lv3izvngs9idfz964aks8cvvn"))))
+ "1hk7lmq09crr9jvia8nxzhvbwf8mw62xk456i96jg8dljh0r9sgz"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("perl" ,perl)
@@ -102,17 +103,10 @@ solve the shortest vector problem.")
#:phases
(alist-replace
'configure
- (lambda* (#:key inputs outputs #:allow-other-keys)
- (let ((out (assoc-ref outputs "out"))
- (readline (assoc-ref inputs "readline"))
- (gmp (assoc-ref inputs "gmp")))
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((out (assoc-ref outputs "out")))
(zero?
- (system* "./Configure"
- (string-append "--prefix=" out)
- (string-append "--with-readline=" readline)
- (string-append "--with-gmp=" gmp)))))
- ;; FIXME: readline and gmp will be detected automatically in the next
- ;; stable release
+ (system* "./Configure" (string-append "--prefix=" out)))))
%standard-phases)))
(synopsis "PARI/GP, a computer algebra system for number theory")
(description
@@ -129,15 +123,16 @@ PARI is also available as a C library to allow for faster computations.")
(define-public gp2c
(package
(name "gp2c")
- (version "0.0.8")
+ (version "0.0.8pl1")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/GP2C/gp2c-"
version ".tar.gz"))
(sha256 (base32
- "03fgiwy2si264g3zfgw2yi6i2l8szl5m106zgwk77sddshk20b34"))))
+ "0r1xrshgx0db2snmacwvg5r99fhd9rpblcfs86pfsp23hnjxj9i0"))))
(build-system gnu-build-system)
+ (native-inputs `(("perl" ,perl)))
(inputs `(("pari-gp" ,pari-gp)))
(arguments
'(#:configure-flags
@@ -231,3 +226,14 @@ transform (DFT) in one or more dimensions, of arbitrary input size, and of
both real and complex data (as well as of even/odd data---i.e. the discrete
cosine/ sine transforms or DCT/DST).")
(license gpl2+)))
+
+(define-public fftwf
+ (package (inherit fftw)
+ (name "fftwf")
+ (arguments
+ (substitute-keyword-arguments (package-arguments fftw)
+ ((#:configure-flags cf)
+ `(cons "--enable-float" ,cf))))
+ (description
+ (string-append (package-description fftw)
+ " Single-precision version."))))
diff --git a/gnu/packages/autotools.scm b/gnu/packages/autotools.scm
index c2e4637ac0..bd38f2a901 100644
--- a/gnu/packages/autotools.scm
+++ b/gnu/packages/autotools.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,7 +28,9 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
- #:use-module (guix build-system trivial))
+ #:use-module (guix build-system trivial)
+ #:use-module (ice-9 match)
+ #:export (autoconf-wrapper))
(define-public autoconf
(package
@@ -59,11 +62,23 @@ scripts are self-contained and portable, freeing the user from needing to
know anything about Autoconf or M4.")
(license gpl3+))) ; some files are under GPLv2+
-(define-public autoconf-wrapper
- ;; An Autoconf wrapper that generates `configure' scripts that use our
- ;; own Bash instead of /bin/sh in shebangs. For that reason, it
- ;; should only be used internally---users should not end up
- ;; distributing `configure' files with a system-specific shebang.
+(define-public autoconf-2.68
+ (package (inherit autoconf)
+ (version "2.68")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/autoconf/autoconf-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "1fjm21k2na07f3vasf288a0zx66lbv0hd3l9bvv3q8p62s3pg569"))))))
+
+(define* (autoconf-wrapper #:optional (autoconf autoconf))
+ "Return an wrapper around AUTOCONF that generates `configure' scripts that
+use our own Bash instead of /bin/sh in shebangs. For that reason, it should
+only be used internally---users should not end up distributing `configure'
+files with a system-specific shebang."
(package (inherit autoconf)
(location (source-properties->location (current-source-location)))
(name (string-append (package-name autoconf) "-wrapper"))
@@ -144,7 +159,7 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
(list (search-patch "automake-skip-amhello-tests.patch")))))
(build-system gnu-build-system)
(inputs
- `(("autoconf" ,autoconf-wrapper)
+ `(("autoconf" ,(autoconf-wrapper))
("perl" ,perl)))
(native-search-paths
(list (search-path-specification
diff --git a/gnu/packages/cursynth.scm b/gnu/packages/cursynth.scm
new file mode 100644
index 0000000000..54b3acc768
--- /dev/null
+++ b/gnu/packages/cursynth.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.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 cursynth)
+ #:use-module (guix packages)
+ #:use-module (guix licenses)
+ #:use-module (guix download)
+ #:use-module (guix build-system gnu)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages ncurses)
+ #:use-module (gnu packages linux))
+
+(define-public cursynth
+ (package
+ (name "cursynth")
+ (version "1.4")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/cursynth/cursynth-"
+ version ".tar.gz"))
+ (sha256
+ (base32 "1p9c54v9b0jjx33sammqsdi5xw65csly4cr1i08wv9x6r2yib55m"))))
+ (build-system gnu-build-system)
+ (native-inputs `(("pkg-config" ,pkg-config)))
+ ;; TODO: See https://github.com/iyoko/cursynth/issues/4 which currently
+ ;; prevents us from using pulseaudio
+ (inputs `(("ncurses" ,ncurses)
+ ("alsa" ,alsa-lib)))
+ (home-page "http://www.gnu.org/software/cursynth")
+ (synopsis "Polyphonic and MIDI subtractive music synthesizer using curses")
+ (description "GNU cursynth is a polyphonic synthesizer that runs
+graphically in the terminal. It is built on a full-featured subtractive
+synthesis engine. Notes and parameter changes may be entered via MIDI or the
+computer's keyboard.")
+ (license gpl3+)))
diff --git a/gnu/packages/gnu-pw-mgr.scm b/gnu/packages/gnu-pw-mgr.scm
index 3b66cde018..646273f080 100644
--- a/gnu/packages/gnu-pw-mgr.scm
+++ b/gnu/packages/gnu-pw-mgr.scm
@@ -27,7 +27,7 @@
(define-public gnu-pw-mgr
(package
(name "gnu-pw-mgr")
- (version "1.1")
+ (version "1.2")
(source
(origin
(method url-fetch)
@@ -36,7 +36,7 @@
version ".tar.gz"))
(sha256
(base32
- "1nqkwjsdcif51d1s4dizr1ifx0qpmkjzvi375vc27dwbav4dwalx"))))
+ "0rdindczxq8ysm3qq7ghc7pcvhp6bn6fadlwna8p83vc1n9nd5py"))))
(build-system gnu-build-system)
(inputs `(("which" ,which)))
(home-page "http://www.gnu.org/software/gnu-pw-mgr/")
diff --git a/gnu/packages/pulseaudio.scm b/gnu/packages/pulseaudio.scm
index db7e752ee6..d82f4bedb6 100644
--- a/gnu/packages/pulseaudio.scm
+++ b/gnu/packages/pulseaudio.scm
@@ -168,7 +168,7 @@ parse JSON formatted strings back into the C representation of JSON objects.")
("pkg-config" ,pkg-config)
("m4" ,m4)
("libtool" ,libtool)
- ("fftw" ,fftw)
+ ("fftwf" ,fftwf)
("avahi" ,avahi)
("check" ,check)))
(propagated-inputs
diff --git a/gnu/packages/recutils.scm b/gnu/packages/recutils.scm
index 0e4d81b30f..7e78ac121d 100644
--- a/gnu/packages/recutils.scm
+++ b/gnu/packages/recutils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,21 +31,27 @@
(define-public recutils
(package
(name "recutils")
- (version "1.6")
+ (version "1.7")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/recutils/recutils-"
version ".tar.gz"))
(sha256
(base32
- "0dxmz73n4qaasqymx97nlw6in98r6lnsfp0586hwkn95d3ll306s"))))
+ "0cdwa4094x3yx7vn98xykvnlp9rngvd58d19vs3vh5hrvggccg93"))))
(build-system gnu-build-system)
+
+ ;; Running tests in parallel leads to test failures and crashes in
+ ;; torture/utils.
+ (arguments '(#:parallel-tests? #f))
+
(native-inputs `(("emacs" ,emacs)
("bc" ,bc)))
;; TODO: Add more optional inputs.
;; FIXME: Our Bash doesn't have development headers (need for the 'readrec'
;; built-in command), but it's not clear how to get them installed.
+ ;; See <https://lists.gnu.org/archive/html/bug-bash/2014-03/msg00125.html>.
(inputs `(("curl" ,curl)
("libgcrypt" ,libgcrypt)
("check" ,check)))
diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm
index 43c1b6e90b..78611b1767 100644
--- a/gnu/packages/ssh.scm
+++ b/gnu/packages/ssh.scm
@@ -187,7 +187,7 @@ Additionally, various channel-specific options can be negotiated.")
(define-public guile-ssh
(package
(name "guile-ssh")
- (version "0.5.0")
+ (version "0.6.0")
(source (origin
(method url-fetch)
(uri (string-append
@@ -195,7 +195,7 @@ Additionally, various channel-specific options can be negotiated.")
version ".tar.gz"))
(sha256
(base32
- "13wk2fj08b8zjylvf78l3d9pf8y3zqcd7h75jf15a46iprk00n7q"))))
+ "1v4y5vrwg0g6804pzbr160zahlqvj7k7iwys2bdpfzp7m2i47siq"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
@@ -227,11 +227,11 @@ Additionally, various channel-specific options can be negotiated.")
(assoc-ref %outputs "out")
"/share/guile/site/2.0"))
- ;; Two client/server tests use the same port.
- #:parallel-tests? #f
+ ;; Building the .go requires building libguile-ssh.so first.
+ #:parallel-build? #f
- ;; XXX: There are test failures reported and being fixed.
- #:tests? #f))
+ ;; Tests are not parallel-safe.
+ #:parallel-tests? #f))
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool "bin")
diff --git a/gnu/packages/tor.scm b/gnu/packages/tor.scm
index 772b2a3c17..2b00197a03 100644
--- a/gnu/packages/tor.scm
+++ b/gnu/packages/tor.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,14 +32,14 @@
(define-public tor
(package
(name "tor")
- (version "0.2.4.20")
+ (version "0.2.4.21")
(source (origin
(method url-fetch)
(uri (string-append "https://www.torproject.org/dist/tor-"
version ".tar.gz"))
(sha256
(base32
- "17sd54pfz1w2x5bd0j83vac8d1lazy9wdm9liijqzyfbrd3igifc"))))
+ "1kpijqapml7y4sl54qgyrzppxxhmy4xgk2y7wkqwjxn7q24g97d1"))))
(build-system gnu-build-system)
(inputs
`(("zlib" ,zlib)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index f9715e10f7..54115a9de2 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -196,9 +196,9 @@ which is not available during bootstrap."
"Fetch data from URI and write it to FILE. Return FILE on success."
(define post-2.0.7?
- (or (string>? (major-version) "2")
- (string>? (minor-version) "0")
- (string>? (micro-version) "7")
+ (or (> (string->number (major-version)) 2)
+ (> (string->number (minor-version)) 0)
+ (> (string->number (micro-version)) 7)
(string>? (version) "2.0.7")))
(define headers
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 5f1b3c16cf..fce3d2b896 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -57,7 +57,7 @@
;;; Available licenses.
;;;
;;; This list is based on these links:
-;;; https://github.com/NixOS/nixpkgs/blob/master/pkgs/lib/licenses.nix
+;;; https://github.com/NixOS/nixpkgs/blob/master/lib/licenses.nix
;;; https://www.gnu.org/licenses/license-list
;;;
;;; Code:
diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index 927dbe8afc..62717bb09c 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -34,18 +34,53 @@
;;;
;;; Code:
-(define (read-canonical-sexp file)
- "Read a gcrypt sexp from FILE and return it."
- (call-with-input-file file
- (compose string->canonical-sexp get-string-all)))
+(define read-canonical-sexp
+ ;; Read a gcrypt sexp from a port and return it.
+ (compose string->canonical-sexp get-string-all))
-(define (read-hash-data file key-type)
- "Read sha256 hash data from FILE and return it as a gcrypt sexp. KEY-TYPE
+(define (read-hash-data port key-type)
+ "Read sha256 hash data from PORT 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))
+ (let* ((hex (get-string-all port))
(bv (base16-string->bytevector (string-trim-both hex))))
(bytevector->hash-data bv #:key-type key-type)))
+(define (sign-with-key key-file port)
+ "Sign the hash read from PORT with KEY-FILE, and write an sexp that includes
+both the hash and the actual signature."
+ (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
+ (public-key (if (string-suffix? ".sec" key-file)
+ (call-with-input-file
+ (string-append (string-drop-right key-file 4)
+ ".pub")
+ read-canonical-sexp)
+ (leave
+ (_ "cannot find public key for secret key '~a'~%")
+ key-file)))
+ (data (read-hash-data port (key-type public-key)))
+ (signature (signature-sexp data secret-key public-key)))
+ (display (canonical-sexp->string signature))
+ #t))
+
+(define (validate-signature port)
+ "Read the signature from PORT (which is as produced above), check whether
+its public key is authorized, verify the signature, and print the signed data
+to stdout upon success."
+ (let* ((signature (read-canonical-sexp port))
+ (subject (signature-subject signature))
+ (data (signature-signed-data signature)))
+ (if (and data subject)
+ (if (authorized-key? subject)
+ (if (valid-signature? signature)
+ (let ((hash (hash-data->bytevector data)))
+ (display (bytevector->base16-string hash))
+ #t) ; success
+ (leave (_ "error: invalid signature: ~a~%")
+ (canonical-sexp->string signature)))
+ (leave (_ "error: unauthorized public key: ~a~%")
+ (canonical-sexp->string subject)))
+ (leave (_ "error: corrupt signature data: ~a~%")
+ (canonical-sexp->string signature)))))
;;;
;;; Entry point with 'openssl'-compatible interface. We support this
@@ -55,39 +90,22 @@ is a symbol representing the type of public key algo being used."
(define (guix-authenticate . args)
(match args
+ ;; As invoked by guix-daemon.
(("rsautl" "-sign" "-inkey" key "-in" hash-file)
- ;; Sign the hash in HASH-FILE with KEY, and return an sexp that includes
- ;; both the hash and the actual signature.
- (let* ((secret-key (read-canonical-sexp key))
- (public-key (if (string-suffix? ".sec" key)
- (read-canonical-sexp
- (string-append (string-drop-right key 4) ".pub"))
- (leave
- (_ "cannot find public key for secret key '~a'~%")
- key)))
- (data (read-hash-data hash-file (key-type public-key)))
- (signature (signature-sexp data secret-key public-key)))
- (display (canonical-sexp->string signature))
- #t))
+ (call-with-input-file hash-file
+ (lambda (port)
+ (sign-with-key key port))))
+ ;; As invoked by Nix/Crypto.pm (used by Hydra.)
+ (("rsautl" "-sign" "-inkey" key)
+ (sign-with-key key (current-input-port)))
+ ;; As invoked by guix-daemon.
(("rsautl" "-verify" "-inkey" _ "-pubin" "-in" signature-file)
- ;; Read the signature as produced above, check whether its public key is
- ;; authorized, and verify the signature, and print the signed data to
- ;; stdout upon success.
- (let* ((signature (read-canonical-sexp signature-file))
- (subject (signature-subject signature))
- (data (signature-signed-data signature)))
- (if (and data subject)
- (if (authorized-key? subject)
- (if (valid-signature? signature)
- (let ((hash (hash-data->bytevector data)))
- (display (bytevector->base16-string hash))
- #t) ; success
- (leave (_ "error: invalid signature: ~a~%")
- (canonical-sexp->string signature)))
- (leave (_ "error: unauthorized public key: ~a~%")
- (canonical-sexp->string subject)))
- (leave (_ "error: corrupt signature data: ~a~%")
- (canonical-sexp->string signature)))))
+ (call-with-input-file signature-file
+ (lambda (port)
+ (validate-signature port))))
+ ;; As invoked by Nix/Crypto.pm (used by Hydra.)
+ (("rsautl" "-verify" "-inkey" _ "-pubin")
+ (validate-signature (current-input-port)))
(("--help")
(display (_ "Usage: guix authenticate OPTION...
Sign or verify the signature on the given file. This tool is meant to
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e078012582..d06dd744a8 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -26,6 +26,7 @@
#:use-module ((guix build utils) #:select (which mkdir-p))
#:use-module (guix ui)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -136,7 +137,7 @@ determined."
;; "-i" (build-machine-private-key machine)
;; ;; XXX: With lsh 2.1, passing '--write-pid'
;; ;; last causes the PID not to be printed.
-;; "--write-pid" "--gateway" "--background" "-z"
+;; "--write-pid" "--gateway" "--background"
;; (build-machine-name machine)))
;; (line (read-line port))
;; (status (close-pipe port)))
@@ -179,7 +180,7 @@ determined."
(lambda ()
;; Let the child inherit ERROR-PORT.
(with-error-to-port error-port
- (apply open-pipe* mode %lshg-command "-z"
+ (apply open-pipe* mode %lshg-command
"-l" (build-machine-user machine)
"-p" (number->string (build-machine-port machine))
@@ -324,10 +325,10 @@ there, and write the build log to LOG-PORT. Return the exit status."
"Offload DRV to MACHINE. Prior to the actual offloading, transfer all of
INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from
MACHINE."
- ;; Acquire MACHINE's exclusive lock to serialize file transfers
- ;; to/from MACHINE in the presence of several 'offload' hook
- ;; instance.
- (when (with-machine-lock machine 'bandwidth
+ ;; Acquire MACHINE's upload or download lock to serialize file transfers in
+ ;; a given direction to/from MACHINE in the presence of several 'offload'
+ ;; hook instance.
+ (when (with-machine-lock machine 'upload
(send-files (cons (derivation-file-name drv) inputs)
machine))
(let ((status (offload drv machine
@@ -337,7 +338,7 @@ MACHINE."
(if (zero? status)
(begin
;; Likewise (see above.)
- (with-machine-lock machine 'bandwidth
+ (with-machine-lock machine 'download
(retrieve-files outputs machine))
(format (current-error-port)
"done with offloaded '~a'~%"
@@ -356,15 +357,18 @@ with exit code ~a~%"
success, #f otherwise."
(define (missing-files files)
;; Return the subset of FILES not already on MACHINE.
- (let* ((files (format #f "~{~a~%~}" files))
- (missing (filtered-port
- (list (which %lshg-command)
- "-l" (build-machine-user machine)
- "-p" (number->string (build-machine-port machine))
- "-i" (build-machine-private-key machine)
- (build-machine-name machine)
- "guix" "archive" "--missing")
- (open-input-string files))))
+ (let*-values (((files)
+ (format #f "~{~a~%~}" files))
+ ((missing pids)
+ (filtered-port
+ (list (which %lshg-command)
+ "-l" (build-machine-user machine)
+ "-p" (number->string (build-machine-port machine))
+ "-i" (build-machine-private-key machine)
+ (build-machine-name machine)
+ "guix" "archive" "--missing")
+ (open-input-string files))))
+ (for-each waitpid pids)
(string-tokenize (get-string-all missing))))
(with-store store
@@ -372,24 +376,26 @@ success, #f otherwise."
(warning (_ "failed to export files for '~a': ~s~%")
(build-machine-name machine)
c)
- (false-if-exception (close-pipe pipe))
#f))
;; Compute the subset of FILES missing on MACHINE, and send them in
;; topologically sorted order so that they can actually be imported.
- (let ((files (missing-files (topologically-sorted store files)))
- (pipe (remote-pipe machine OPEN_WRITE
- '("guix" "archive" "--import"))))
+ (let* ((files (missing-files (topologically-sorted store files)))
+ (pipe (remote-pipe machine OPEN_WRITE
+ '("xz" "-dc" "|"
+ "guix" "archive" "--import"))))
(format #t (_ "sending ~a store files to '~a'...~%")
(length files) (build-machine-name machine))
- (catch 'system-error
- (lambda ()
- (export-paths store files pipe))
- (lambda args
- (warning (_ "failed while exporting files to '~a': ~a~%")
- (build-machine-name machine)
- (strerror (system-error-errno args)))))
- (zero? (close-pipe pipe))))))
+ (call-with-compressed-output-port 'xz pipe
+ (lambda (compressed)
+ (catch 'system-error
+ (lambda ()
+ (export-paths store files compressed))
+ (lambda args
+ (warning (_ "failed while exporting files to '~a': ~a~%")
+ (build-machine-name machine)
+ (strerror (system-error-errno args)))))))
+ #t))))
(define (retrieve-files files machine)
"Retrieve FILES from MACHINE's store, and import them."
@@ -397,7 +403,8 @@ success, #f otherwise."
(build-machine-name machine))
(let ((pipe (remote-pipe machine OPEN_READ
- `("guix" "archive" "--export" ,@files))))
+ `("guix" "archive" "--export" ,@files
+ "|" "xz" "-c"))))
(and pipe
(with-store store
(guard (c ((nix-protocol-error? c)
@@ -409,11 +416,13 @@ success, #f otherwise."
;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES.
- (restore-file-set pipe
- #:log-port (current-error-port)
- #:lock? #f)
+ (call-with-decompressed-port 'xz pipe
+ (lambda (decompressed)
+ (restore-file-set decompressed
+ #:log-port (current-error-port)
+ #:lock? #f)))
- (zero? (close-pipe pipe)))))))
+ #t)))))
;;;
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 7ac12ddef2..4e49b0c3ac 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -400,16 +400,6 @@ indefinitely."
(call-with-output-file expiry-file
(cute write (time-second now) <>))))
-(define (decompressed-port compression input)
- "Return an input port where INPUT is decompressed according to COMPRESSION,
-along with a list of PIDs to wait for."
- (match compression
- ("none" (values input '()))
- ("bzip2" (filtered-port `(,%bzip2 "-dc") input))
- ("xz" (filtered-port `(,%xz "-dc") input))
- ("gzip" (filtered-port `(,%gzip "-dc") input))
- (else (error "unsupported compression scheme" compression))))
-
(define (progress-report-port report-progress port)
"Return a port that calls REPORT-PROGRESS every time something is read from
PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by
@@ -598,7 +588,8 @@ substituter disabled~%")
(current-error-port))))
(progress-report-port progress raw)))
((input pids)
- (decompressed-port (narinfo-compression narinfo)
+ (decompressed-port (and=> (narinfo-compression narinfo)
+ string->symbol)
progress)))
;; Unpack the Nar at INPUT into DESTINATION.
(restore-file input destination)
diff --git a/guix/utils.scm b/guix/utils.scm
index 68329ec915..7306c6011d 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -21,6 +21,7 @@
#:use-module (guix config)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-39)
#:use-module (srfi srfi-60)
@@ -70,7 +71,13 @@
call-with-temporary-output-file
with-atomic-file-output
fold2
- filtered-port))
+
+ filtered-port
+ compressed-port
+ decompressed-port
+ call-with-decompressed-port
+ compressed-output-port
+ call-with-compressed-output-port))
;;;
@@ -155,18 +162,29 @@ COMMAND (a list). In addition, return a list of PIDs that the caller must
wait. When INPUT is a file port, it must be unbuffered; otherwise, any
buffered data is lost."
(let loop ((input input)
- (pids '()))
+ (pids '()))
(if (file-port? input)
(match (pipe)
((in . out)
(match (primitive-fork)
(0
- (close-port in)
- (close-port (current-input-port))
- (dup2 (fileno input) 0)
- (close-port (current-output-port))
- (dup2 (fileno out) 1)
- (apply execl (car command) command))
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (close-port in)
+ (close-port (current-input-port))
+ (dup2 (fileno input) 0)
+ (close-port (current-output-port))
+ (dup2 (fileno out) 1)
+ (catch 'system-error
+ (lambda ()
+ (apply execl (car command) command))
+ (lambda args
+ (format (current-error-port)
+ "filtered-port: failed to execute '~{~a ~}': ~a~%"
+ command (strerror (system-error-errno args))))))
+ (lambda ()
+ (primitive-_exit 1))))
(child
(close-port out)
(values in (cons child pids))))))
@@ -184,11 +202,104 @@ buffered data is lost."
(dump-port input out))
(lambda ()
(false-if-exception (close out))
- (primitive-exit 0))))
+ (primitive-_exit 0))))
(child
(close-port out)
(loop in (cons child pids)))))))))
+(define (decompressed-port compression input)
+ "Return an input port where INPUT is decompressed according to COMPRESSION,
+a symbol such as 'xz."
+ (match compression
+ ((or #f 'none) (values input '()))
+ ('bzip2 (filtered-port `(,%bzip2 "-dc") input))
+ ('xz (filtered-port `(,%xz "-dc") input))
+ ('gzip (filtered-port `(,%gzip "-dc") input))
+ (else (error "unsupported compression scheme" compression))))
+
+(define (compressed-port compression input)
+ "Return an input port where INPUT is decompressed according to COMPRESSION,
+a symbol such as 'xz."
+ (match compression
+ ((or #f 'none) (values input '()))
+ ('bzip2 (filtered-port `(,%bzip2 "-c") input))
+ ('xz (filtered-port `(,%xz "-c") input))
+ ('gzip (filtered-port `(,%gzip "-c") input))
+ (else (error "unsupported compression scheme" compression))))
+
+(define (call-with-decompressed-port compression port proc)
+ "Call PROC with a wrapper around PORT, a file port, that decompresses data
+read from PORT according to COMPRESSION, a symbol such as 'xz. PORT is closed
+as soon as PROC's dynamic extent is entered."
+ (let-values (((decompressed pids)
+ (decompressed-port compression port)))
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (close-port port)
+ (proc decompressed))
+ (lambda ()
+ (close-port decompressed)
+ (unless (every (compose zero? cdr waitpid) pids)
+ (error "decompressed-port failure" pids))))))
+
+(define (filtered-output-port command output)
+ "Return an output port. Data written to that port is filtered through
+COMMAND and written to OUTPUT, an output file port. In addition, return a
+list of PIDs to wait for. OUTPUT must be unbuffered; otherwise, any buffered
+data is lost."
+ (match (pipe)
+ ((in . out)
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (close-port out)
+ (close-port (current-input-port))
+ (dup2 (fileno in) 0)
+ (close-port (current-output-port))
+ (dup2 (fileno output) 1)
+ (catch 'system-error
+ (lambda ()
+ (apply execl (car command) command))
+ (lambda args
+ (format (current-error-port)
+ "filtered-output-port: failed to execute '~{~a ~}': ~a~%"
+ command (strerror (system-error-errno args))))))
+ (lambda ()
+ (primitive-_exit 1))))
+ (child
+ (close-port in)
+ (values out (list child)))))))
+
+(define (compressed-output-port compression output)
+ "Return an output port whose input is compressed according to COMPRESSION,
+a symbol such as 'xz, and then written to OUTPUT. In addition return a list
+of PIDs to wait for."
+ (match compression
+ ((or #f 'none) (values output '()))
+ ('bzip2 (filtered-output-port `(,%bzip2 "-c") output))
+ ('xz (filtered-output-port `(,%xz "-c") output))
+ ('gzip (filtered-output-port `(,%gzip "-c") output))
+ (else (error "unsupported compression scheme" compression))))
+
+(define (call-with-compressed-output-port compression port proc)
+ "Call PROC with a wrapper around PORT, a file port, that compresses data
+that goes to PORT according to COMPRESSION, a symbol such as 'xz. PORT is
+closed as soon as PROC's dynamic extent is entered."
+ (let-values (((compressed pids)
+ (compressed-output-port compression port)))
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (close-port port)
+ (proc compressed))
+ (lambda ()
+ (close-port compressed)
+ (unless (every (compose zero? cdr waitpid) pids)
+ (error "compressed-output-port failure" pids))))))
+
;;;
;;; Nixpkgs.
diff --git a/nix-upstream b/nix-upstream
-Subproject 3fc056927c962ec9778e94528f2f9ae316afca4
+Subproject 24cb65efc3c34e24fc653779a4d42cf4f31c673
diff --git a/tests/derivations.scm b/tests/derivations.scm
index e87662a198..3903a563a8 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -524,6 +524,9 @@ Deriver: ~a~%"
(basename
(derivation-file-name drv))))) ; Deriver
+ ;; Make sure substitutes are usable.
+ (set-build-options store #:use-substitutes? #t)
+
(let-values (((build download)
(derivation-prerequisites-to-build store drv))
((build* download*)
diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh
index aa6f9e9f01..35ec7ffd6a 100644
--- a/tests/guix-authenticate.sh
+++ b/tests/guix-authenticate.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -42,6 +42,17 @@ hash2="`guix authenticate rsautl -verify \
-pubin -in $sig`"
test "$hash2" = `cat "$hash"`
+# Same thing in a pipeline, using the command line syntax that Nix/Crypto.pm
+# uses.
+hash2="` \
+ cat "$hash" \
+ | guix authenticate rsautl -sign \
+ -inkey "$abs_top_srcdir/tests/signing-key.sec" \
+ | guix authenticate rsautl -verify \
+ -inkey $abs_top_srcdir/tests/signing-key.pub \
+ -pubin`"
+test "$hash2" = `cat "$hash"`
+
# Detect corrupt signatures.
if guix authenticate rsautl -verify \
-inkey "$abs_top_srcdir/tests/signing-key.pub" \
diff --git a/tests/utils.scm b/tests/utils.scm
index adac5d4381..1da847689c 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -142,6 +142,37 @@
(append pids1 pids2)))
(equal? (get-bytevector-all decompressed) data)))))
+(test-assert "filtered-port, does not exist"
+ (let* ((file (search-path %load-path "guix.scm"))
+ (input (open-file file "r0b")))
+ (let-values (((port pids)
+ (filtered-port '("/does/not/exist") input)))
+ (any (compose (negate zero?) cdr waitpid)
+ pids))))
+
+(test-assert "compressed-port, decompressed-port, non-file"
+ (let ((data (call-with-input-file (search-path %load-path "guix.scm")
+ get-bytevector-all)))
+ (let*-values (((compressed pids1)
+ (compressed-port 'xz (open-bytevector-input-port data)))
+ ((decompressed pids2)
+ (decompressed-port 'xz compressed)))
+ (and (every (compose zero? cdr waitpid)
+ (append pids1 pids2))
+ (equal? (get-bytevector-all decompressed) data)))))
+
+(false-if-exception (delete-file temp-file))
+(test-assert "compressed-output-port + decompressed-port"
+ (let* ((file (search-path %load-path "guix/derivations.scm"))
+ (data (call-with-input-file file get-bytevector-all)))
+ (call-with-compressed-output-port 'xz (open-file temp-file "w0b")
+ (lambda (compressed)
+ (put-bytevector compressed data)))
+
+ (bytevector=? data
+ (call-with-decompressed-port 'xz (open-file temp-file "r0b")
+ get-bytevector-all))))
+
(false-if-exception (delete-file temp-file))
(test-equal "fcntl-flock wait"
42 ; the child's exit status
generated by cgit v1.2.3 (git 2.45.2) at 2024-08-06 06:08:49 +0000