diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-10-27 14:23:40 -0700 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-10-28 09:45:54 +0200 |
commit | 4b879e0acf30e7ac941cff5581107b23c29e1883 (patch) | |
tree | 20bbf072f81f3d497aa01d346758af8d4ada7d31 | |
parent | a1ff7e1d8dfb86ae1817d4e0db4ddeebd2083e83 (diff) | |
download | gnu-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.scm | 41 |
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*))))) |