summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-01-06 18:36:50 +0100
committerLudovic Courtès <ludo@gnu.org>2013-01-06 18:36:50 +0100
commite66ca1a5a898c4bfd0c2c3c2ec3284befde28ee6 (patch)
tree20f6c7c30061981cf3cd21d403635dc760d67b0e /guix/build
parente47bac790228d4f622bce9981fc4b6ed4767b973 (diff)
download: Report the progress of HTTP downloads.
* guix/build/download.scm (http-fetch): Rename `bv' to `bv-or-port'. Use `http-get*' followed by `dump-port' when the former is available, and pass a progress procedure to `dump-port'.
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/download.scm26
1 files changed, 20 insertions, 6 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 8a715cf50b..7c48d7bff5 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -126,20 +126,34 @@ which is not available during bootstrap."
(define (http-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success."
- ;; FIXME: Use a variant of `http-get' that returns a port instead of
- ;; loading everything in memory.
(let*-values (((connection)
(open-connection-for-uri uri))
- ((resp bv)
- (http-get uri #:port connection #:decode-body? #f))
+ ((resp bv-or-port)
+ ;; XXX: `http-get*' was introduced in 2.0.7. We know
+ ;; we're using it within the chroot, but
+ ;; `guix-download' might be using a different version.
+ ;; So keep this compatibility hack for now.
+ (if (module-defined? (resolve-interface '(web client))
+ 'http-get*)
+ (http-get* uri #:port connection #:decode-body? #f)
+ (http-get uri #:port connection #:decode-body? #f)))
((code)
- (response-code resp)))
+ (response-code resp))
+ ((size)
+ (response-content-length resp)))
(case code
((200) ; OK
(begin
(call-with-output-file file
(lambda (p)
- (put-bytevector p bv)))
+ (if (port? bv-or-port)
+ (begin
+ (dump-port bv-or-port p
+ #:buffer-size 65536 ; don't flood the log
+ #:progress (progress-proc (uri->string uri)
+ size))
+ (newline))
+ (put-bytevector p bv-or-port))))
file))
((302) ; found (redirection)
(let ((uri (response-location resp)))