01/05: substitute: Gracefully handle TLS errors.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 8c321299c532e620c0d2327dd15acad3d6b4476c
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 22 09:57:15 2016 +0100

    substitute: Gracefully handle TLS errors.
    
    * guix/scripts/substitute.scm (with-networking): Use 'match-lambda*' and
    add case for 'gnutls-error'.
---
 guix/scripts/substitute.scm |   18 +++++++++++++-----
 1 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 4563f3d..82ce069 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -780,16 +780,24 @@ PORT.  REPORT-PROGRESS is a two-argument procedure such 
as that returned by
 
 (define-syntax with-networking
   (syntax-rules ()
-    "Catch DNS lookup errors and gracefully exit."
+    "Catch DNS lookup errors and TLS errors and gracefully exit."
     ;; Note: no attempt is made to catch other networking errors, because DNS
     ;; lookup errors are typically the first one, and because other errors are
     ;; a subset of `system-error', which is harder to filter.
     ((_ exp ...)
-     (catch 'getaddrinfo-error
+     (catch #t
        (lambda () exp ...)
-       (lambda (key error)
-         (leave (_ "host name lookup error: ~a~%")
-                (gai-strerror error)))))))
+       (match-lambda*
+         (('getaddrinfo-error error)
+          (leave (_ "host name lookup error: ~a~%")
+                 (gai-strerror error)))
+         (('gnutls-error error proc . rest)
+          (let ((error->string (module-ref (resolve-interface '(gnutls))
+                                           'error->string)))
+            (leave (_ "TLS error in procedure '~a': ~a~%")
+                   proc (error->string error))))
+         (args
+          (apply throw args)))))))
 
 
 ;;;