diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-07-18 16:05:21 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-07-18 19:50:01 +0200 |
commit | 0e47fcced442d8e7c1b05184fdc1c14f10ed04ec (patch) | |
tree | 4ae844bc0ec3c670f8697bdc24362c122fa718ad /guix/build/download.scm | |
parent | e4b70bc55a538569465bcedee19d1f2607308e65 (diff) | |
parent | 8b1bde7bb3936a64244824500ffe60f123704437 (diff) | |
download | guix-patches-0e47fcced442d8e7c1b05184fdc1c14f10ed04ec.tar guix-patches-0e47fcced442d8e7c1b05184fdc1c14f10ed04ec.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r-- | guix/build/download.scm | 36 |
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? |