1 files changed, 25 insertions(+), 16 deletions(-)

M guix/scripts/lint.scm

@@ 792,35 792,44 @@ be determined."
     ((? origin?)
      (and=> (origin-actual-file-name patch) basename))))
 
-(define (current-vulnerabilities*)
-  "Like 'current-vulnerabilities', but return the empty list upon networking
-or HTTP errors.  This allows network-less operation and makes problems with
-the NIST server non-fatal.."
+(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_ "failed to retrieve CVE vulnerabilities \
-from ~s: ~a (~s)~%")
+             (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))
-             (warning (G_ "assuming no CVE vulnerabilities~%"))
-             '()))
+             error-value))
     (catch #t
-      (lambda ()
-        (current-vulnerabilities))
+      proc
       (match-lambda*
         (('getaddrinfo-error errcode)
-         (warning (G_ "failed to lookup NIST host: ~a~%")
+         (warning (G_ "~a: host lookup failure: ~a~%")
+                  message
                   (gai-strerror errcode))
-         (warning (G_ "assuming no CVE vulnerabilities~%"))
-         '())
+         error-value)
         (('tls-certificate-error args ...)
-         (warning (G_ "TLS certificate error: ~a")
+         (warning (G_ "~a: TLS certificate error: ~a")
+                  message
                   (tls-certificate-error-string args))
-         (warning (G_ "assuming no CVE vulnerabilities~%"))
-         '())
+         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
+                                  (lambda () exp ...)))
+
+(define (current-vulnerabilities*)
+  "Like 'current-vulnerabilities', but return the empty list upon networking
+or HTTP errors.  This allows network-less operation and makes problems with
+the NIST server non-fatal."
+  (with-networking-fail-safe (G_ "while retrieving CVE vulnerabilities")
+                             '()
+                             (current-vulnerabilities)))
+
 (define package-vulnerabilities
   (let ((lookup (delay (vulnerabilities->lookup-proc
                         (current-vulnerabilities*)))))