From e66ca1a5a898c4bfd0c2c3c2ec3284befde28ee6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Jan 2013 18:36:50 +0100 Subject: 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'. --- guix/build/download.scm | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) (limited to 'guix/build/download.scm') 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 @@ (define addresses (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))) -- cgit v1.2.3