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 @@ (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)))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
Loading…
Reference in New Issue
Block a user