summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/download.scm36
1 files changed, 21 insertions, 15 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index b14db42352..54627eefa2 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -281,21 +281,27 @@ host name without trailing dot."
;;(set-log-level! 10)
;;(set-log-procedure! log)
- (catch 'gnutls-error
- (lambda ()
- (handshake session))
- (lambda (key err proc . rest)
- (cond ((eq? err error/warning-alert-received)
- ;; Like Wget, do no stop upon non-fatal alerts such as
- ;; 'alert-description/unrecognized-name'.
- (format (current-error-port)
- "warning: TLS warning alert received: ~a~%"
- (alert-description->string (alert-get session)))
- (handshake session))
- (else
- ;; XXX: We'd use 'gnutls_error_is_fatal' but (gnutls) doesn't
- ;; provide a binding for this.
- (apply throw key err proc rest)))))
+ (let loop ((retries 5))
+ (catch 'gnutls-error
+ (lambda ()
+ (handshake session))
+ (lambda (key err proc . rest)
+ (cond ((eq? err error/warning-alert-received)
+ ;; Like Wget, do no stop upon non-fatal alerts such as
+ ;; 'alert-description/unrecognized-name'.
+ (format (current-error-port)
+ "warning: TLS warning alert received: ~a~%"
+ (alert-description->string (alert-get session)))
+ (handshake session))
+ (else
+ (if (or (fatal-error? err) (zero? retries))
+ (apply throw key err proc rest)
+ (begin
+ ;; We got 'error/again' or similar; try again.
+ (format (current-error-port)
+ "warning: TLS non-fatal error: ~a~%"
+ (error->string err))
+ (loop (- retries 1)))))))))
;; Verify the server's certificate if needed.
(when verify-certificate?