aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-01-06 18:24:53 +0100
committerLudovic Courtès <ludo@gnu.org>2013-01-06 18:35:23 +0100
commite47bac790228d4f622bce9981fc4b6ed4767b973 (patch)
tree58027b01a1827d3a76ad2f591a1f6e00fa49847e
parentfb83842efba5b4f08a151d2f8a0fd43de6c62778 (diff)
downloadguix-e47bac790228d4f622bce9981fc4b6ed4767b973.tar
guix-e47bac790228d4f622bce9981fc4b6ed4767b973.tar.gz
download: Report the progress of FTP downloads.
* guix/build/download.scm (progress-proc): New procedure. (ftp-fetch): Call `ftp-size' on URI. Use `progress-proc', and pass the result to `dump-port', along with #:buffer-size.
-rw-r--r--guix/build/download.scm29
1 files changed, 26 insertions, 3 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 27f5557692..8a715cf50b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,6 +27,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:export (url-fetch))
;;; Commentary:
@@ -35,17 +36,39 @@
;;;
;;; Code:
+(define* (progress-proc file size #:optional (log-port (current-output-port)))
+ "Return a procedure to show the progress of FILE's download, which is
+SIZE byte long. The returned procedure is suitable for use as an
+argument to `dump-port'. The progress report is written to LOG-PORT."
+ (if (number? size)
+ (lambda (transferred cont)
+ (let ((% (* 100.0 (/ transferred size))))
+ (display #\cr log-port)
+ (format log-port "~a\t~5,1f% of ~,1f KiB"
+ file % (/ size 1024.0))
+ (flush-output-port log-port)
+ (cont)))
+ (lambda (transferred cont)
+ (display #\cr log-port)
+ (format log-port "~a\t~6,1f KiB transferred"
+ file (/ transferred 1024.0))
+ (flush-output-port log-port)
+ (cont))))
+
(define (ftp-fetch uri file)
"Fetch data from URI and write it to FILE. Return FILE on success."
(let* ((conn (ftp-open (uri-host uri)))
+ (size (false-if-exception (ftp-size conn (uri-path uri))))
(in (ftp-retr conn (basename (uri-path uri))
(dirname (uri-path uri)))))
(call-with-output-file file
(lambda (out)
- ;; TODO: Show a progress bar.
- (dump-port in out)))
+ (dump-port in out
+ #:buffer-size 65536 ; don't flood the log
+ #:progress (progress-proc (uri->string uri) size))))
(ftp-close conn))
+ (newline)
file)
(define (open-connection-for-uri uri)