From 7b9ac883ea62a816afbfa747c1377dc273c15c20 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 2 May 2017 21:43:18 +0200 Subject: [PATCH] download: Continue handshake upon TLS warning alerts. This allows us to download from site such as where the server does not recognize the server name passed via the 'server_name' extension. * guix/build/download.scm (tls-wrap): Catch 'gnutls-error' around 'handshake'. Upon ERROR/WARNING-ALERT-RECEIVED, print a message and call 'handshake'. --- guix/build/download.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index 67a8952599..ce4708a873 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -396,7 +396,21 @@ host name without trailing dot." ;;(set-log-level! 10) ;;(set-log-procedure! log) - (handshake session) + (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))))) ;; Verify the server's certificate if needed. (when verify-certificate?