substitute-binary: Pass `filtered-port' an unbuffered port.

This fixes a bug whereby `read-response' would read more than just the
response, with the extra data going into the port's buffer; the
"bzip2 -dc" process spawned by `filtered-port' would not see the those
buffered data, which are definitely lost, and would bail out with
"bzip2: (stdin) is not a bzip2 file."

* guix/utils.scm (filtered-port): Document that INPUT must be
  unbuffered.
* guix/web.scm (http-fetch): Add `buffered?' parameter.  Call
  `open-socket-for-uri' explicitly, and call `setvbuf' when BUFFERED? is
  false.  Pass the port to `http-get'.  Close it upon 301/302.
* guix/scripts/substitute-binary.scm (fetch): Add `buffered?'
  parameter.  Pass it to `http-fetch'; honor it for `file' URIs.
  (guix-substitute-binary): Call `fetch' with #:buffered? #f for port RAW.
* tests/utils.scm ("filtered-port, file"): Open FILE as unbuffered.

1 files changed, 17 insertions, 6 deletions

diff --git a/guix/web.scm b/guix/web.scm
index 2236bfd621..e9c69cb0c0 100644
--- a/guix/web.scm
+++ b/guix/web.scm
@@ -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