summaryrefslogtreecommitdiff
path: root/guix/utils.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/utils.scm')
-rw-r--r--guix/utils.scm44
1 files changed, 43 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.