substitute-binary: Support decompression from non-file ports.

* guix/scripts/substitute-binary.scm (filtered-port): Move to utils.scm.
  (decompressed-port): Upon "none", return '() as the second value.
  (guix-substitute-binary): Expect `decompressed-port' to return a list
  of PIDs as its second value.
* guix/utils.scm (filtered-port): New procedure.  Add case for when
  INPUT is not `file-port?'.
* tests/utils.scm ("filtered-port, file", "filtered-port, non-file"):
  New tests.
master
Ludovic Courtès 2013-04-29 23:25:19 +02:00
parent dab5d51be7
commit e0fbbc889d
3 changed files with 77 additions and 20 deletions

View File

@ -348,26 +348,10 @@ indefinitely."
(call-with-output-file expiry-file
(cute write (time-second now) <>))))
(define (filtered-port command input)
"Return an input port (and PID) where data drained from INPUT is filtered
through COMMAND. INPUT must be a file input port."
(let ((i+o (pipe)))
(match (primitive-fork)
(0
(close-port (car i+o))
(close-port (current-input-port))
(dup2 (fileno input) 0)
(close-port (current-output-port))
(dup2 (fileno (cdr i+o)) 1)
(apply execl (car command) command))
(child
(close-port (cdr i+o))
(values (car i+o) child)))))
(define (decompressed-port compression input)
"Return an input port where INPUT is decompressed according to COMPRESSION."
(match compression
("none" (values input #f))
("none" (values input '()))
("bzip2" (filtered-port `(,%bzip2 "-dc") input))
("xz" (filtered-port `(,%xz "-dc") input))
("gzip" (filtered-port `(,%gzip "-dc") input))
@ -442,7 +426,7 @@ through COMMAND. INPUT must be a file input port."
(let*-values (((raw download-size)
(fetch uri))
((input pid)
((input pids)
(decompressed-port (narinfo-compression narinfo)
raw)))
;; Note that Hydra currently generates Nars on the fly and doesn't
@ -455,7 +439,7 @@ through COMMAND. INPUT must be a file input port."
;; Unpack the Nar at INPUT into DESTINATION.
(restore-file input destination)
(or (not pid) (zero? (cdr (waitpid pid)))))))
(every (compose zero? cdr waitpid) pids))))
(("--version")
(show-version-and-exit "guix substitute-binary"))))

View File

@ -25,6 +25,7 @@
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
#:use-module ((rnrs io ports) #:select (put-bytevector))
#:use-module ((guix build utils) #:select (dump-port))
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
#:autoload (ice-9 popen) (open-pipe*)
@ -62,7 +63,8 @@
package-name->name+version
file-extension
call-with-temporary-output-file
fold2))
fold2
filtered-port))
;;;
@ -153,6 +155,50 @@ evaluate to a simple datum."
(bytevector->pointer bv) (bytevector-length bv))
digest))))
;;;
;;; Filtering & pipes.
;;;
(define (filtered-port command input)
"Return an input port where data drained from INPUT is filtered through
COMMAND (a list). In addition, return a list of PIDs that the caller must
wait."
(let loop ((input input)
(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))
(child
(close-port out)
(values in (cons child pids))))))
;; INPUT is not a file port, so fork just for the sake of tunneling it
;; through a file port.
(match (pipe)
((in . out)
(match (primitive-fork)
(0
(dynamic-wind
(const #t)
(lambda ()
(close-port in)
(dump-port input out))
(lambda ()
(false-if-exception (close out))
(primitive-exit 0))))
(child
(close-port out)
(loop in (cons child pids)))))))))
;;;
;;; Nixpkgs.

View File

@ -17,12 +17,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-utils)
#:use-module ((guix config) #:select (%gzip))
#:use-module (guix utils)
#:use-module ((guix store) #:select (%store-prefix store-path-package-name))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 match))
(test-begin "utils")
@ -89,6 +91,31 @@
'(0 1 2 3)))
list))
(test-assert "filtered-port, file"
(let ((file (search-path %load-path "guix.scm")))
(call-with-input-file file
(lambda (input)
(let*-values (((compressed pids1)
(filtered-port `(,%gzip "-c" "--fast") input))
((decompressed pids2)
(filtered-port `(,%gzip "-d") compressed)))
(and (every (compose zero? cdr waitpid)
(append pids1 pids2))
(equal? (get-bytevector-all decompressed)
(call-with-input-file file get-bytevector-all))))))))
(test-assert "filtered-port, non-file"
(let ((data (call-with-input-file (search-path %load-path "guix.scm")
get-bytevector-all)))
(let*-values (((compressed pids1)
(filtered-port `(,%gzip "-c" "--fast")
(open-bytevector-input-port data)))
((decompressed pids2)
(filtered-port `(,%gzip "-d") compressed)))
(and (pk (every (compose zero? cdr waitpid)
(append pids1 pids2)))
(equal? (get-bytevector-all decompressed) data)))))
(test-assert "define-record-type*"
(begin
(define-record-type* <foo> foo make-foo