import: utils: 'call-with-networking-exception-handler' doesn't unwind.
That way backtraces show where the error actually originates from. * guix/import/utils.scm (call-with-networking-exception-handler): Rewrite using 'with-exception-handler'.
This commit is contained in:
parent
d2f36abd02
commit
4663cfd381
1 changed files with 21 additions and 12 deletions
|
@ -45,6 +45,7 @@ (define-module (guix import utils)
|
|||
#:use-module (guix sets)
|
||||
#:use-module ((guix ui) #:select (fill-paragraph))
|
||||
#:use-module (gnu packages)
|
||||
#:autoload (ice-9 control) (let/ec)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 receive)
|
||||
|
@ -126,18 +127,26 @@ (define (flatten lst)
|
|||
(define (call-with-networking-exception-handler thunk)
|
||||
"Invoke THUNK, returning #f if one of the usual networking exception is
|
||||
thrown."
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(guard (c ((http-get-error? c) #f))
|
||||
(thunk)))
|
||||
(lambda (key . args)
|
||||
;; Return false and move on upon connection failures and bogus HTTP
|
||||
;; servers.
|
||||
(unless (memq key '(gnutls-error tls-certificate-error
|
||||
system-error getaddrinfo-error
|
||||
bad-header bad-header-component))
|
||||
(apply throw key args))
|
||||
#f)))
|
||||
(let/ec return
|
||||
(with-exception-handler
|
||||
(lambda (exception)
|
||||
(cond ((http-get-error? exception)
|
||||
(return #f))
|
||||
(((exception-predicate &exception-with-kind-and-args) exception)
|
||||
;; Return false and move on upon connection failures and bogus
|
||||
;; HTTP servers.
|
||||
(if (memq (exception-kind exception)
|
||||
'(gnutls-error tls-certificate-error
|
||||
system-error getaddrinfo-error
|
||||
bad-header bad-header-component))
|
||||
(return #f)
|
||||
(raise-exception exception)))
|
||||
(else
|
||||
(raise-exception exception))))
|
||||
thunk
|
||||
|
||||
;; Do not unwind to preserve meaningful backtraces.
|
||||
#:unwind? #f)))
|
||||
|
||||
(define-syntax-rule (false-if-networking-error exp)
|
||||
"Evaluate EXP, returning #f if a networking-related exception is thrown."
|
||||
|
|
Loading…
Reference in a new issue