diff options
| -rw-r--r-- | guix/utils.scm | 44 | ||||
| -rw-r--r-- | tests/utils.scm | 19 |
2 files changed, 62 insertions, 1 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index f786c83f47..44060c46b5 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -73,7 +73,8 @@ filtered-port compressed-port - decompressed-port)) + decompressed-port + compressed-output-port)) ;;; @@ -223,6 +224,47 @@ a symbol such as 'xz." ('gzip (filtered-port `(,%gzip "-c") input)) (else (error "unsupported compression scheme" compression)))) +(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)))) + ;;; ;;; Nixpkgs. diff --git a/tests/utils.scm b/tests/utils.scm index 39cad701b8..adbfdf55ba 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -162,6 +162,25 @@ (equal? (get-bytevector-all decompressed) data))))) (false-if-exception (delete-file temp-file)) +(test-equal "compressed-output-port + decompressed-port" + '((0) "Hello, compressed port!") + (let ((text "Hello, compressed port!") + (output (open-file temp-file "w0b"))) + (let-values (((compressed pids) + (compressed-output-port 'xz output))) + (display text compressed) + (close-port compressed) + (close-port output) + (and (every (compose zero? cdr waitpid) pids) + (let*-values (((input) + (open-file temp-file "r0b")) + ((decompressed pids) + (decompressed-port 'xz input))) + (let ((str (get-string-all decompressed))) + (list (map (compose cdr waitpid) pids) + str))))))) + +(false-if-exception (delete-file temp-file)) (test-equal "fcntl-flock wait" 42 ; the child's exit status (let ((file (open-file temp-file "w0"))) |