summaryrefslogtreecommitdiff
path: root/guix/scripts/substitute-binary.scm
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 /guix/scripts/substitute-binary.scm
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.
Diffstat (limited to 'guix/scripts/substitute-binary.scm')
-rwxr-xr-xguix/scripts/substitute-binary.scm8
1 files changed, 5 insertions, 3 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)))