aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-27 14:23:40 -0700
committerLudovic Courtès <ludo@gnu.org>2017-10-28 09:45:54 +0200
commit4b879e0acf30e7ac941cff5581107b23c29e1883 (patch)
tree20bbf072f81f3d497aa01d346758af8d4ada7d31
parenta1ff7e1d8dfb86ae1817d4e0db4ddeebd2083e83 (diff)
downloadgnu-guix-4b879e0acf30e7ac941cff5581107b23c29e1883.tar
gnu-guix-4b879e0acf30e7ac941cff5581107b23c29e1883.tar.gz
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'.
-rw-r--r--guix/scripts/lint.scm41
1 files 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*)))))