nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2017-10-27 14:23:40 -07:00
parent a1ff7e1d8d
commit 4b879e0acf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
guix/scripts/lint.scm
View File

@ -792,35 +792,44 @@ be determined."
((? origin?) ((? origin?)
(and=> (origin-actual-file-name patch) basename)))) (and=> (origin-actual-file-name patch) basename))))
(define (current-vulnerabilities*) (define (call-with-networking-fail-safe message error-value proc)
"Like 'current-vulnerabilities', but return the empty list upon networking "Call PROC catching any network-related errors. Upon a networking error,
or HTTP errors. This allows network-less operation and makes problems with display a message including MESSAGE and return ERROR-VALUE."
the NIST server non-fatal.."
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
(warning (G_ "failed to retrieve CVE vulnerabilities \ (warning (G_ "~a: HTTP GET error for ~a: ~a (~s)~%")
from ~s: ~a (~s)~%") message
(uri->string (http-get-error-uri c)) (uri->string (http-get-error-uri c))
(http-get-error-code c) (http-get-error-code c)
(http-get-error-reason c)) (http-get-error-reason c))
(warning (G_ "assuming no CVE vulnerabilities~%")) error-value))
'()))
(catch #t (catch #t
(lambda () proc
(current-vulnerabilities))
(match-lambda* (match-lambda*
(('getaddrinfo-error errcode) (('getaddrinfo-error errcode)
(warning (G_ "failed to lookup NIST host: ~a~%") (warning (G_ "~a: host lookup failure: ~a~%")
message
(gai-strerror errcode)) (gai-strerror errcode))
(warning (G_ "assuming no CVE vulnerabilities~%")) error-value)
'())
(('tls-certificate-error args ...) (('tls-certificate-error args ...)
(warning (G_ "TLS certificate error: ~a") (warning (G_ "~a: TLS certificate error: ~a")
message
(tls-certificate-error-string args)) (tls-certificate-error-string args))
(warning (G_ "assuming no CVE vulnerabilities~%")) error-value)
'())
(args (args
(apply throw 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 (define package-vulnerabilities
(let ((lookup (delay (vulnerabilities->lookup-proc (let ((lookup (delay (vulnerabilities->lookup-proc
(current-vulnerabilities*))))) (current-vulnerabilities*)))))