From 101d9f3fd43b436d5dc7ef13e644c7fbbc7f62d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 May 2013 23:40:09 +0200 Subject: [PATCH] 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/scripts/substitute-binary.scm | 8 +++++--- guix/utils.scm | 3 ++- guix/web.scm | 23 +++++++++++++++++------ tests/utils.scm | 21 ++++++++++----------- 4 files changed, 34 insertions(+), 21 deletions(-) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 27a43b9e3f..1317a72fb1 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.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 (%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))) diff --git a/guix/utils.scm b/guix/utils.scm index c2d2808f76..25a392e6a8 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -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) 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 diff --git a/tests/utils.scm b/tests/utils.scm index c2fb274193..e8549204d0 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -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")