03/03: lint: cve: Set a connection timeout.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit baa4a2ef8109601dcd6d28b16d2d41c203f849e4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Oct 12 11:25:09 2020 +0200

    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'.
---
 guix/cve.scm  | 12 +++++++-----
 guix/lint.scm |  2 +-
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/guix/cve.scm b/guix/cve.scm
index 57b8459..b3a8b13 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -336,7 +336,7 @@ sexp to CACHE."
                ,(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 @@ the given TTL (fetch from the NIST web site when TTL has 
expired)."
   (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 @@ published by the US NIST."
                               (* 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))))
 
diff --git a/guix/lint.scm b/guix/lint.scm
index ec43a4d..e1a77e8 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1084,7 +1084,7 @@ 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)))
+                             (current-vulnerabilities #:timeout 4)))
 
 (define package-vulnerabilities
   (let ((lookup (delay (vulnerabilities->lookup-proc