bug#52577: ‘guix lint’ throws an ugly backtrace if the GitHub updater receives “rate limit exceeded” error

[Xinglu Chen <public@yoctocell.xyz>]

[-- Attachment #1.1: Type: text/plain, Size: 4276 bytes --]

On So, Dez 19 2021, Maxime Devos wrote:

> Xinglu Chen schreef op vr 17-12-2021 om 21:57 [+0100]:
>> On Fri, Dec 17 2021, Maxime Devos wrote:
>> 
>> > Xinglu Chen schreef op vr 17-12-2021 om 15:03 [+0100]:
>> > > (guard (c ((and (http-get-error? c)
>> > >                 (string=? "rate limit exceeded"
>> > >                           (http-get-error-reason c)))
>> > >            (warning (G_ "GitHub rate limit exceeded"))
>> > >            #f))
>> > >   (with-networking-fail-safe ...))
>> > 
>> > Shouldn't this be wrapped the other way around?
>> > Or maybe even move the http-get-error?+string=?+warning inside
>> > call-with-networking-fail-safe?
>> 
>> Thanks for the pointer, it seems that ‘throw’ in
>> ‘call-with-networking-fail-safe’ wraps the original exception an
>> additional ‘&compound-exception’.  Before the ‘throw’, the exception
>> looks like this:
>> 
>> --8<---------------cut here---------------start------------->8---
>> (%exception #<&compound-exception components: (#<&http-get-error uri:
>> #<<uri> scheme: https userinfo: #f host: "api.github.com" port: #f
>> path: "/repos/PipeWire/pipewire/releases" query: #f fragment: #f>
>> code: 403 reason: "rate limit exceeded"> #<&message message: "
>> https://api.github.com/repos/PipeWire/pipewire/releases: HTTP
>> download failed: 403 (\"rate limit exceeded\")">)>)
>> --8<---------------cut here---------------end--------------->8---
>> 
>> After the ‘throw’, it becomes this:
>> 
>> --8<---------------cut here---------------start------------->8---
>> #<&compound-exception components: (#<&error> #<&irritants irritants:
>> (#<&compound-exception
>> components: (#<&http-get-error uri: #<<uri> scheme: https userinfo:
>> #f host:
>> "api.github.com" port: #f path: "/repos/PipeWire/pipewire/releases"
>> query: #f fragment: #f>
>> code: 403 reason: "rate limit exceeded"> #<&message message:
>> "https://api.github.com/repos/PipeWire/pipewire/releases: HTTP
>> download failed: 403 (\"rate
>> limit exceeded\")">)>)> #<&exception-with-kind-and-args kind:
>> %exception args:
>> (#<&compound-exception components: (#<&http-get-error uri: #<<uri>
>> scheme: https userinfo:
>> #f host: "api.github.com" port: #f path:
>> "/repos/PipeWire/pipewire/releases" query: #f
>> fragment: #f> code: 403 reason: "rate limit exceeded"> #<&message
>> message:
>> "https://api.github.com/repos/PipeWire/pipewire/releases: HTTP
>> download failed: 403 (\"rate
>> limit exceeded\")">)>)>)>
>> --8<---------------cut here---------------end--------------->8---
>> 
>> This means that the ‘guard’ form in ‘call-with-networking-fail-safe’
>> is
>> never going to match anything since the real exception will always be
>> nested
>> in another ‘&compound-exception’.
>
> Actually, being wrapped in &compound-exception shouldn't be a problem:
> &compound-exception just means that the exception is of multiple types,
> e.g. both &message and &http-get-error or something like that. In that
> case, the exception could be both message? and http-get-error?.
>
> I think the problem is, that for some unknown reason, the
> &http-get-error/&message exception gets wrapped in a
> &exception-with-and-args --- I guess there's a bad interaction with
> the throw/catch exception handling system and the raise/guard system,
> because only 'system-error'/'tls-certificate-error'/...-style
> exceptions should get wrapped in a &exception-with-kind-and-arguments.

Yeah, the catch/throw system doesn’t really work well with ‘raise’.
Here is what I found after some digging:

(catch KIND THUNK HANDLER) uses ‘exception-kind’ to determine the kind
of the exception.  Since ‘&http-get-error’ was created using ‘raise’, it
doesn’t really have a notion of a “kind”, therefore, ‘exception-kind’
returns the ‘%exception’ symbol.  I guess that’s why I had to match on
('%exception exception) to match the ‘&http-get-error’

Excerpt from the patch I attached:

  (catch #t
    proc
    (match-lambda*
      ...
      ((and ('%exception exception)
            (http-get-error? exception))
        ...)
        ...))


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-lint-Fix-handling-of-HTTP-errors.patch --]
[-- Type: text/x-patch, Size: 4992 bytes --]

From cf1f08ba8f4c9866ab0077cc50941133ba4ff77b Mon Sep 17 00:00:00 2001
Message-Id: <cf1f08ba8f4c9866ab0077cc50941133ba4ff77b.1639773195.git.public@yoctocell.xyz>
From: Xinglu Chen <public@yoctocell.xyz>
Date: Fri, 17 Dec 2021 21:32:51 +0100
Subject: [PATCH] lint: Fix handling of HTTP errors.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The 'catch' call would wrap the '&http-get-error' error in an '%exception'
meaning that the 'guard' form would never catch a '&http-get-error'.  It seems
that the throw/catch system doesn't play nicely with the raise/guard system.

* guix/lint.scm (call-with-networking-fail-safe): Add pattern to match
  '&http-get-error'; handle GitHub rate limit error; remove 'guard' form.

Fixes: <https://issues.guix.gnu.org/52577>
---
 guix/lint.scm | 80 ++++++++++++++++++++++++++++-----------------------
 1 file changed, 44 insertions(+), 36 deletions(-)

diff --git a/guix/lint.scm b/guix/lint.scm
index 403f343b6c..67b2bb7221 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -801,43 +801,51 @@ (define response
 (define (call-with-networking-fail-safe message error-value proc)
   "Call PROC catching any network-related errors.  Upon a networking error,
 display a message including MESSAGE and return ERROR-VALUE."
-  (guard (c ((http-get-error? c)
-             (warning (G_ "~a: HTTP GET error for ~a: ~a (~s)~%")
-                      message
-                      (uri->string (http-get-error-uri c))
-                      (http-get-error-code c)
-                      (http-get-error-reason c))
-             error-value))
-    (catch #t
-      proc
-      (match-lambda*
-        (('getaddrinfo-error errcode)
-         (warning (G_ "~a: host lookup failure: ~a~%")
-                  message
-                  (gai-strerror errcode))
-         error-value)
-        (('tls-certificate-error args ...)
-         (warning (G_ "~a: TLS certificate error: ~a")
-                  message
-                  (tls-certificate-error-string args))
-         error-value)
-        (('gnutls-error error function _ ...)
-         (warning (G_ "~a: TLS error in '~a': ~a~%")
+  (catch #t
+    proc
+    (match-lambda*
+      (('getaddrinfo-error errcode)
+       (warning (G_ "~a: host lookup failure: ~a~%")
+                message
+                (gai-strerror errcode))
+       error-value)
+      (('tls-certificate-error args ...)
+       (warning (G_ "~a: TLS certificate error: ~a")
+                message
+                (tls-certificate-error-string args))
+       error-value)
+      (('gnutls-error error function _ ...)
+       (warning (G_ "~a: TLS error in '~a': ~a~%")
+                message
+                function (error->string error))
+       error-value)
+      ((and ('system-error _ ...) args)
+       (let ((errno (system-error-errno args)))
+         (if (member errno (list ECONNRESET ECONNABORTED ECONNREFUSED))
+             (let ((details (call-with-output-string
+                             (lambda (port)
+                               (print-exception port #f (car args)
+                                                (cdr args))))))
+               (warning (G_ "~a: ~a~%") message details)
+               error-value)
+             (apply throw args))))
+      ((and ('%exception exception)
+            (http-get-error? exception))
+       (cond
+        ((and (string-contains (uri->string (http-get-error-uri exception))
+                               "api.github.com")
+              (string=? (http-get-error-reason exception)
+                        "rate limit exceeded"))
+         (warning (G_ "GitHub rate limit exceeded")))
+        (else
+         (warning (G_ "~a: HTTP GET error for ~a: ~a (~s)~%")
                   message
-                  function (error->string error))
-         error-value)
-        ((and ('system-error _ ...) args)
-         (let ((errno (system-error-errno args)))
-           (if (member errno (list ECONNRESET ECONNABORTED ECONNREFUSED))
-               (let ((details (call-with-output-string
-                                (lambda (port)
-                                  (print-exception port #f (car args)
-                                                   (cdr args))))))
-                 (warning (G_ "~a: ~a~%") message details)
-                 error-value)
-               (apply throw args))))
-        (args
-         (apply throw args))))))
+                  (uri->string (http-get-error-uri exception))
+                  (http-get-error-code exception)
+                  (http-get-error-reason exception))))
+       error-value)
+      (args
+       (apply throw args)))))
 
 (define-syntax-rule (with-networking-fail-safe message error-value exp ...)
   (call-with-networking-fail-safe message error-value

base-commit: 6718fe7e872e78f8f15dd596fcf15c594a039bfe
-- 
2.33.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]