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
1 changed files with 13 additions and 5 deletions

View File

@ -780,16 +780,24 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by
(define-syntax with-networking (define-syntax with-networking
(syntax-rules () (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 ;; Note: no attempt is made to catch other networking errors, because DNS
;; lookup errors are typically the first one, and because other errors are ;; lookup errors are typically the first one, and because other errors are
;; a subset of `system-error', which is harder to filter. ;; a subset of `system-error', which is harder to filter.
((_ exp ...) ((_ exp ...)
(catch 'getaddrinfo-error (catch #t
(lambda () exp ...) (lambda () exp ...)
(lambda (key error) (match-lambda*
(leave (_ "host name lookup error: ~a~%") (('getaddrinfo-error error)
(gai-strerror 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)))))))
;;; ;;;