ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 23:46:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

lint: Extract network-related exception handling.

Browse source 
* 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 @@ (define (patch-file-name patch)
((? 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*)))))