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:
parent
b98293ebed
commit
8c321299c5
|
@ -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)))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Reference in New Issue