From 101d9f3fd43b436d5dc7ef13e644c7fbbc7f62d5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 15 May 2013 23:40:09 +0200 Subject: 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. --- guix/web.scm | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) (limited to 'guix/web.scm') 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 -- cgit v1.2.3