diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-01-06 18:36:50 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-01-06 18:36:50 +0100 |
| commit | e66ca1a5a898c4bfd0c2c3c2ec3284befde28ee6 (patch) | |
| tree | 20f6c7c30061981cf3cd21d403635dc760d67b0e | |
| parent | e47bac790228d4f622bce9981fc4b6ed4767b973 (diff) | |
| download | gnu-guix-e66ca1a5a898c4bfd0c2c3c2ec3284befde28ee6.tar gnu-guix-e66ca1a5a898c4bfd0c2c3c2ec3284befde28ee6.tar.gz | |
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'.
| -rw-r--r-- | guix/build/download.scm | 26 |
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))) |