summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-05-15 22:52:25 +0200
committerLudovic Courtès <ludo@gnu.org>2023-05-31 23:25:24 +0200
commit4663cfd381e278747b28bbb7aebe45ab76e8c984 (patch)
tree6e8ea9c26953159b6f2af85915301a60f5b9f25e /guix/import
parentd2f36abd02088cdf1ceb26de2de9c2b33f50c09e (diff)
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'.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/utils.scm33
1 files changed, 21 insertions, 12 deletions
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 177817b10c..e9a0a7ecd7 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -45,6 +45,7 @@
#: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 @@ of the string VERSION is replaced by the symbol 'version."
(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."