From 8c321299c532e620c0d2327dd15acad3d6b4476c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 22 Mar 2016 09:57:15 +0100 Subject: [PATCH] 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 file changed, 13 insertions(+), 5 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 4563f3df0f..82ce069598 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -780,16 +780,24 @@ (define (read! bv start count) (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))))))) ;;;