02/04: download: Continue handshake upon TLS warning alerts.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 7b9ac883ea62a816afbfa747c1377dc273c15c20
Author: Ludovic Courtès <address@hidden>
Date:   Tue May 2 21:43:18 2017 +0200

    download: Continue handshake upon TLS warning alerts.
    
    This allows us to download from site such as
    <https://fusionforge.int-evry.fr> 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 67a8952..ce4708a 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?