From 4b879e0acf30e7ac941cff5581107b23c29e1883 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 27 Oct 2017 14:23:40 -0700
Subject: lint: Extract network-related exception handling.

* guix/scripts/lint.scm (call-with-networking-fail-safe): New procedure.
(with-networking-fail-safe): New macro.
(current-vulnerabilities*): Rewrite in terms of 'with-networking-fail-safe'.
---
 guix/scripts/lint.scm | 41 +++++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 16 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 0338d4cb13..ec6446ef47 100644
--- a/guix/scripts/lint.scm
+++ b/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*)))))
-- 
cgit 1.4.1