diff options
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 13 | ||||
| -rw-r--r-- | guix/utils.scm | 25 | ||||
| -rw-r--r-- | tests/utils.scm | 11 |
3 files changed, 37 insertions, 12 deletions
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 15a4390074..f786c83f47 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -70,7 +70,10 @@ call-with-temporary-output-file with-atomic-file-output fold2 - filtered-port)) + + filtered-port + compressed-port + decompressed-port)) ;;; @@ -200,6 +203,26 @@ buffered data is lost." (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)))) + ;;; ;;; Nixpkgs. diff --git a/tests/utils.scm b/tests/utils.scm index 85daa3db91..39cad701b8 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -150,6 +150,17 @@ (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-equal "fcntl-flock wait" 42 ; the child's exit status |