utils: Add 'decompressed-port' and 'compressed-port'.

* guix/utils.scm (decompressed-port, compressed-port): New procedures.
* guix/scripts/substitute-binary.scm (decompressed-port): Remove.
  (guix-substitute-binary): Pass a symbol or #f as the first argument to
  'decompress-port'.
* tests/utils.scm ("compressed-port, decompressed-port, non-file"): New
  test.
This commit is contained in:
Ludovic Courtès 2014-03-22 21:58:23 +01:00
parent 443eb4e950
commit 7a8024a33a
3 changed files with 37 additions and 12 deletions

View File

@ -400,16 +400,6 @@ indefinitely."
(call-with-output-file expiry-file (call-with-output-file expiry-file
(cute write (time-second now) <>)))) (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) (define (progress-report-port report-progress port)
"Return a port that calls REPORT-PROGRESS every time something is read from "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 PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by
@ -598,7 +588,8 @@ substituter disabled~%")
(current-error-port)))) (current-error-port))))
(progress-report-port progress raw))) (progress-report-port progress raw)))
((input pids) ((input pids)
(decompressed-port (narinfo-compression narinfo) (decompressed-port (and=> (narinfo-compression narinfo)
string->symbol)
progress))) progress)))
;; Unpack the Nar at INPUT into DESTINATION. ;; Unpack the Nar at INPUT into DESTINATION.
(restore-file input destination) (restore-file input destination)

View File

@ -70,7 +70,10 @@
call-with-temporary-output-file call-with-temporary-output-file
with-atomic-file-output with-atomic-file-output
fold2 fold2
filtered-port))
filtered-port
compressed-port
decompressed-port))
;;; ;;;
@ -200,6 +203,26 @@ buffered data is lost."
(close-port out) (close-port out)
(loop in (cons child pids))))))))) (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))))
;;; ;;;
;;; Nixpkgs. ;;; Nixpkgs.

View File

@ -150,6 +150,17 @@
(any (compose (negate zero?) cdr waitpid) (any (compose (negate zero?) cdr waitpid)
pids)))) 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)) (false-if-exception (delete-file temp-file))
(test-equal "fcntl-flock wait" (test-equal "fcntl-flock wait"
42 ; the child's exit status 42 ; the child's exit status