diff options
| -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*))))) |