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.
master
Ludovic Courtès 2013-05-15 23:40:09 +02:00
parent 3d6b71e87e
commit 101d9f3fd4
4 changed files with 34 additions and 21 deletions

View File

@ -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)))

View File

@ -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)

View File

@ -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

View File

@ -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")