From e0fbbc889d724678e9e310432ad3a3fb8345cf9a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 29 Apr 2013 23:25:19 +0200
Subject: 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.
---
 guix/utils.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

(limited to 'guix/utils.scm')

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))
 
 
 ;;;
@@ -153,6 +155,50 @@ evaluate to a simple datum."
               (bytevector->pointer bv) (bytevector-length bv))
         digest))))
 
+
+;;;
+;;; 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.
-- 
cgit v1.2.3