4 files changed, 34 insertions(+), 21 deletions(-)

M guix/scripts/substitute-binary.scm
M guix/utils.scm
M guix/web.scm
M tests/utils.scm

@@ 117,15 117,17 @@ pairs."
           (else
            (error "unmatched line" line)))))
 
-(define (fetch uri)
+(define* (fetch uri #:key (buffered? #t))
   "Return a binary input port to URI and the number of bytes it's expected to
 provide."
   (case (uri-scheme uri)
     ((file)
      (let ((port (open-input-file (uri-path uri))))
+       (unless buffered?
+         (setvbuf port _IONBF))
        (values port (stat:size (stat port)))))
     ((http)
-     (http-fetch uri #:text? #f))))
+     (http-fetch uri #:text? #f #:buffered? buffered?))))
 
 (define-record-type <cache>
   (%make-cache url store-directory wants-mass-query?)


@@ 423,7 425,7 @@ indefinitely."
        (format #t "~a~%" (narinfo-hash narinfo))
 
        (let*-values (((raw download-size)
-                      (fetch uri))
+                      (fetch uri #:buffered? #f))
                      ((input pids)
                       (decompressed-port (narinfo-compression narinfo)
                                          raw)))

@@ 163,7 163,8 @@ evaluate to a simple datum."
 (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."
+wait.  When INPUT is a file port, it must be unbuffered; otherwise, any
+buffered data is lost."
   (let loop ((input input)
              (pids '()))
     (if (file-port? input)

@@ 141,20 141,30 @@ closed it will also close PORT, unless the KEEP-ALIVE? is true."
 (module-define! (resolve-module '(web client))
                 'shutdown (const #f))
 
-(define* (http-fetch uri #:key (text? #f))
+(define* (http-fetch uri #:key (text? #f) (buffered? #t))
   "Return an input port containing the data at URI, and the expected number of
 bytes available or #f.  If TEXT? is true, the data at URI is considered to be
-textual.  Follow any HTTP redirection."
+textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
+unbuffered port, suitable for use in `filtered-port'."
   (let loop ((uri uri))
+    (define port
+      (let ((s (open-socket-for-uri uri)))
+        (unless buffered?
+          (setvbuf s _IONBF))
+        s))
+
     (let*-values (((resp data)
                    ;; Try hard to use the API du jour to get an input port.
                    ;; On Guile 2.0.5 and before, we can only get a string or
                    ;; bytevector, and not an input port.  Work around that.
                    (if (version>? "2.0.7" (version))
                        (if (defined? 'http-get*)
-                           (http-get* uri #:decode-body? text?) ; 2.0.7
-                           (http-get uri #:decode-body? text?)) ; 2.0.5-
-                       (http-get uri #:streaming? #t)))         ; 2.0.9+
+                           (http-get* uri #:decode-body? text?
+                                      #:port port)              ; 2.0.7
+                           (http-get uri #:decode-body? text?
+                                     #:port port))              ; 2.0.5-
+                       (http-get uri #:streaming? #t
+                                 #:port port)))                 ; 2.0.9+
                   ((code)
                    (response-code resp)))
       (case code


@@ 182,7 192,8 @@ textual.  Follow any HTTP redirection."
         ((301                                      ; moved permanently
           302)                                     ; found (redirection)
          (let ((uri (response-location resp)))
-           (format #t "following redirection to `~a'...~%"
+           (close-port port)
+           (format #t (_ "following redirection to `~a'...~%")
                    (uri->string uri))
            (loop uri)))
         (else

@@ 102,17 102,16 @@
     list))
 
 (test-assert "filtered-port, file"
-  (let ((file (search-path %load-path "guix.scm")))
-    (call-with-input-file file
-      (lambda (input)
-        (let*-values (((compressed pids1)
-                       (filtered-port `(,%gzip "-c" "--fast") input))
-                      ((decompressed pids2)
-                       (filtered-port `(,%gzip "-d") compressed)))
-          (and (every (compose zero? cdr waitpid)
-                      (append pids1 pids2))
-               (equal? (get-bytevector-all decompressed)
-                       (call-with-input-file file get-bytevector-all))))))))
+  (let* ((file  (search-path %load-path "guix.scm"))
+         (input (open-file file "r0")))
+    (let*-values (((compressed pids1)
+                   (filtered-port `(,%gzip "-c" "--fast") input))
+                  ((decompressed pids2)
+                   (filtered-port `(,%gzip "-d") compressed)))
+      (and (every (compose zero? cdr waitpid)
+                  (append pids1 pids2))
+           (equal? (get-bytevector-all decompressed)
+                   (call-with-input-file file get-bytevector-all))))))
 
 (test-assert "filtered-port, non-file"
   (let ((data (call-with-input-file (search-path %load-path "guix.scm")