summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-15 23:40:09 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-15 23:40:09 +0200
commit101d9f3fd43b436d5dc7ef13e644c7fbbc7f62d5 (patch)
treee3a4eed4c2e50b932d333fa5344d343125c42cfd
parent3d6b71e87eca505262f9756644d72e545c7e48f8 (diff)
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.
-rwxr-xr-xguix/scripts/substitute-binary.scm8
-rw-r--r--guix/utils.scm3
-rw-r--r--guix/web.scm23
-rw-r--r--tests/utils.scm21
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 <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)))
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")