aboutsummaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm33
1 files changed, 22 insertions, 11 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 315a3554ec..54163849a2 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -115,7 +115,7 @@ and 'guix publish', something like
(string-drop path 33)
path)))
-(define* (ftp-fetch uri file #:key timeout)
+(define* (ftp-fetch uri file #:key timeout print-build-trace?)
"Fetch data from URI and write it to FILE. Return FILE on success. Bail
out if the connection could not be established in less than TIMEOUT seconds."
(let* ((conn (match (and=> (uri-userinfo uri)
@@ -136,12 +136,17 @@ out if the connection could not be established in less than TIMEOUT seconds."
(lambda (out)
(dump-port* in out
#:buffer-size %http-receive-buffer-size
- #:reporter (progress-reporter/file
- (uri-abbreviation uri) size))))
-
- (ftp-close conn))
- (newline)
- file)
+ #:reporter
+ (if print-build-trace?
+ (progress-reporter/trace
+ file (uri->string uri) size)
+ (progress-reporter/file
+ (uri-abbreviation uri) size)))))
+
+ (ftp-close conn)
+ (unless print-build-trace?
+ (newline))
+ file))
;; Autoload GnuTLS so that this module can be used even when GnuTLS is
;; not available. At compile time, this yields "possibly unbound
@@ -723,7 +728,8 @@ Return a list of URIs."
#:key
(timeout 10) (verify-certificate? #t)
(mirrors '()) (content-addressed-mirrors '())
- (hashes '()))
+ (hashes '())
+ print-build-trace?)
"Fetch FILE from URL; URL may be either a single string, or a list of
string denoting alternate URLs for FILE. Return #f on failure, and FILE
on success.
@@ -759,13 +765,18 @@ otherwise simply ignore them."
(lambda (output)
(dump-port* port output
#:buffer-size %http-receive-buffer-size
- #:reporter (progress-reporter/file
- (uri-abbreviation uri) size))
+ #:reporter (if print-build-trace?
+ (progress-reporter/trace
+ file (uri->string uri) size)
+ (progress-reporter/file
+ (uri-abbreviation uri) size)))
(newline)))
file)))
((ftp)
(false-if-exception* (ftp-fetch uri file
- #:timeout timeout)))
+ #:timeout timeout
+ #:print-build-trace?
+ print-build-trace?)))
(else
(format #t "skipping URI with unsupported scheme: ~s~%"
uri)