download: 'tls-wrap' retries handshake upon non-fatal errors.
Fixes <https://bugs.gnu.org/49223>. Reported by Domagoj Stolfa <ds815@gmx.com>. * guix/build/download.scm (tls-wrap): Retry up to 5 times when 'handshake' throws a non-fatal error.
This commit is contained in:
parent
7fe195f3b7
commit
b36267b1d9
@ -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?
|
||||
|
Loading…
Reference in New Issue
Block a user