diff options
Diffstat (limited to 'guix')
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 22 | ||||
| -rw-r--r-- | guix/utils.scm | 48 |
2 files changed, 50 insertions, 20 deletions
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 87561db4b3..995078e630 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -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")))) diff --git a/guix/utils.scm b/guix/utils.scm index 3cbed2fd0f..aec07301da 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -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)) ;;; @@ -155,6 +157,50 @@ evaluate to a simple datum." ;;; +;;; 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. ;;; |