substitute: Gracefully handle TLS errors.

* guix/scripts/substitute.scm (with-networking): Use 'match-lambda*' and
add case for 'gnutls-error'.
This commit is contained in:
Ludovic Courtès 2016-03-22 09:57:15 +01:00
parent b98293ebed
commit 8c321299c5

View File

@ -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)))))))
;;;