lint: cve: Set a connection timeout.

This (notably) works around the fact that nvd.nist.gov is currently
inaccessible over IPv6.

* guix/cve.scm (fetch-vulnerabilities): Add #:timeout and pass it to
'http-fetch/cached'.
(current-vulnerabilities): Add #:timeout and pass it to
'fetch-vulnerabilities'.
* guix/lint.scm (current-vulnerabilities*): Pass #:timeout to
'current-vulnerabilities'.
This commit is contained in:
Ludovic Courtès 2020-10-12 11:25:09 +02:00
parent d11f7f62b6
commit baa4a2ef81
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 8 additions and 6 deletions

View file

@ -336,7 +336,7 @@ (define vulns
,(map vulnerability->sexp vulns))
cache))))
(define (fetch-vulnerabilities year ttl)
(define* (fetch-vulnerabilities year ttl #:key (timeout 10))
"Return the list of <vulnerability> for YEAR, assuming the on-disk cache has
the given TTL (fetch from the NIST web site when TTL has expired)."
(define (cache-miss uri)
@ -361,16 +361,18 @@ (define (read* port)
(let* ((port (http-fetch/cached (yearly-feed-uri year)
#:ttl ttl
#:write-cache write-cache
#:cache-miss cache-miss))
#:cache-miss cache-miss
#:timeout timeout))
(sexp (read* port)))
(close-port port)
(match sexp
(('vulnerabilities 1 vulns)
(map sexp->vulnerability vulns)))))
(define (current-vulnerabilities)
(define* (current-vulnerabilities #:key (timeout 10))
"Return the current list of Common Vulnerabilities and Exposures (CVE) as
published by the US NIST."
published by the US NIST. TIMEOUT specifies the timeout in seconds for
connection establishment."
(let ((past-years (unfold (cut > <> 3)
(lambda (n)
(- %current-year n))
@ -381,7 +383,7 @@ (define (current-vulnerabilities)
(* n %past-year-ttl))
1+
1)))
(append-map fetch-vulnerabilities
(append-map (cut fetch-vulnerabilities <> <> #:timeout timeout)
(cons %current-year past-years)
(cons %current-year-ttl past-ttls))))

View file

@ -1084,7 +1084,7 @@ (define (current-vulnerabilities*)
the NIST server non-fatal."
(with-networking-fail-safe (G_ "while retrieving CVE vulnerabilities")
'()
(current-vulnerabilities)))
(current-vulnerabilities #:timeout 4)))
(define package-vulnerabilities
(let ((lookup (delay (vulnerabilities->lookup-proc