aboutsummaryrefslogtreecommitdiff
path: root/guix/utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-29 23:25:19 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-29 23:25:19 +0200
commite0fbbc889d724678e9e310432ad3a3fb8345cf9a (patch)
treed8a2fdc62f16c285e24d40c041ae80b0247ccab8 /guix/utils.scm
parentdab5d51be739d23d8ce98f15d195c8e3c91bbd7e (diff)
downloadgnu-guix-e0fbbc889d724678e9e310432ad3a3fb8345cf9a.tar
gnu-guix-e0fbbc889d724678e9e310432ad3a3fb8345cf9a.tar.gz
substitute-binary: Support decompression from non-file ports.
* guix/scripts/substitute-binary.scm (filtered-port): Move to utils.scm. (decompressed-port): Upon "none", return '() as the second value. (guix-substitute-binary): Expect `decompressed-port' to return a list of PIDs as its second value. * guix/utils.scm (filtered-port): New procedure. Add case for when INPUT is not `file-port?'. * tests/utils.scm ("filtered-port, file", "filtered-port, non-file"): New tests.
Diffstat (limited to 'guix/utils.scm')
-rw-r--r--guix/utils.scm48
1 files changed, 47 insertions, 1 deletions
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.
;;;