GNU bug report logs - #63571
[PATCH 00/14] 'guix refresh -u' updates input fields

Previous Next

Full log

Message #68 received at 63571 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63571 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH v2 04/19] import: utils:
 'call-with-networking-exception-handler' doesn't unwind.
Date: Mon, 29 May 2023 16:45:15 +0200

That way backtraces show where the error actually originates from.

* guix/import/utils.scm (call-with-networking-exception-handler):
Rewrite using 'with-exception-handler'.
---
 guix/import/utils.scm | 33 +++++++++++++++++++++------------
 1 file 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 @@ (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."
-- 
2.40.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.