TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

cve: Include the 3 previous years of vulnerabilities.

Browse source 
* guix/cve.scm (fetch-vulnerabilities): Add 'format' call.
(current-vulnerabilities): Include the 3 previous years.
This commit is contained in:
Ludovic Courtès 2016-05-26 23:00:08 +02:00
parent 159a5e0197
commit 3af7a7a879
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/cve.scm
View file

@ -25,6 +25,7 @@ (define-module (guix cve)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
@ -179,6 +180,7 @@ (define (do-fetch)
(lambda (port) (lambda (port)
;; XXX: The SSAX "error port" is used to send pointless warnings such as ;; XXX: The SSAX "error port" is used to send pointless warnings such as
;; "warning: Skipping PI". Turn that off. ;; "warning: Skipping PI". Turn that off.
(format (current-error-port) "fetching CVE database for ~a...~%" year)
(parameterize ((current-ssax-error-port (%make-void-port "w"))) (parameterize ((current-ssax-error-port (%make-void-port "w")))
(xml->vulnerabilities port))))) (xml->vulnerabilities port)))))
@ -214,9 +216,19 @@ (define (old? file)
(define (current-vulnerabilities) (define (current-vulnerabilities)
"Return the current list of Common Vulnerabilities and Exposures (CVE) as "Return the current list of Common Vulnerabilities and Exposures (CVE) as
published by the US NIST." published by the US NIST."
(append-map fetch-vulnerabilities (let ((past-years (unfold (cut > <> 3)
(list %past-year %current-year) (lambda (n)
(list %past-year-ttl %current-year-ttl))) (- %current-year n))
1+
1))
(past-ttls (unfold (cut > <> 3)
(lambda (n)
(* n %past-year-ttl))
1+
1)))
(append-map fetch-vulnerabilities
(cons %current-year past-years)
(cons %current-year-ttl past-ttls))))
(define (vulnerabilities->lookup-proc vulnerabilities) (define (vulnerabilities->lookup-proc vulnerabilities)
"Return a lookup procedure built from VULNERABILITIES that takes a package "Return a lookup procedure built from VULNERABILITIES that takes a package