cve: Use a more compact format for the list of package/versions.
On a warm cache, "guix lint -c cve vorbis-tools" goes down
from 6.5s to 2.4s.
* guix/cve.scm (cpe->package-name): Change to return two values instead
of a pair.
(cpe->product-alist): New procedure.
(%parse-vulnerability-feed): Use it instead of 'filter-map'.
(fetch-vulnerabilities): Bump sexp format version to 1.
(vulnerabilities->lookup-proc): Adjust accordingly. When #:version is
omitted, return a list of vulnerabilities instead of a list of
version/vulnerability pairs.
* tests/cve.scm (%expected-vulnerabilities)
("vulnerabilities->lookup-proc): Adjust accordingly.
master
Ludovic Courtès
parent
494dc2fc62
commit
870bf71eb0
79
guix/cve.scm
79
guix/cve.scm
|
|
@ -24,6 +24,7 @@
|
|||
#:use-module (web uri)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 match)
|
||||
|
|
@ -48,8 +49,8 @@
|
|||
(define-record-type <vulnerability>
|
||||
(vulnerability id packages)
|
||||
vulnerability?
|
||||
(id vulnerability-id)
|
||||
(packages vulnerability-packages))
|
||||
(id vulnerability-id) ;string
|
||||
(packages vulnerability-packages)) ;((p1 v1 v2 v3) (p2 v1) ...)
|
||||
|
||||
(define %now
|
||||
(current-date))
|
||||
|
|
@ -93,18 +94,45 @@
|
|||
|
||||
(define (cpe->package-name cpe)
|
||||
"Converts the Common Platform Enumeration (CPE) string CPE to a package
|
||||
name, in a very naive way. Return #f if CPE does not look like an application
|
||||
CPE string."
|
||||
(and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
|
||||
name, in a very naive way. Return two values: the package name, and its
|
||||
version string. Return #f and #f if CPE does not look like an application CPE
|
||||
string."
|
||||
(cond ((regexp-exec %cpe-package-rx (string-trim-both cpe))
|
||||
=>
|
||||
(lambda (matches)
|
||||
(cons (match:substring matches 2)
|
||||
(string-append (match:substring matches 3)
|
||||
(match (match:substring matches 4)
|
||||
("" "")
|
||||
(patch-level
|
||||
;; Drop the colon from things like
|
||||
;; "cpe:/a:openbsd:openssh:6.8:p1".
|
||||
(string-drop patch-level 1))))))))
|
||||
(values (match:substring matches 2)
|
||||
(string-append (match:substring matches 3)
|
||||
(match (match:substring matches 4)
|
||||
("" "")
|
||||
(patch-level
|
||||
;; Drop the colon from things like
|
||||
;; "cpe:/a:openbsd:openssh:6.8:p1".
|
||||
(string-drop patch-level 1)))))))
|
||||
(else
|
||||
(values #f #f))))
|
||||
|
||||
(define (cpe->product-alist products)
|
||||
"Given PRODUCTS, a list of CPE names, return the subset limited to the
|
||||
applications listed in PRODUCTS, with names converted to package names:
|
||||
|
||||
(cpe->product-alist
|
||||
'(\"cpe:/a:gnu:libtasn1:4.7\" \"cpe:/a:gnu:libtasn1:4.6\" \"cpe:/a:gnu:cpio:2.11\"))
|
||||
=> ((\"libtasn1\" \"4.7\" \"4.6\") (\"cpio\" \"2.11\"))
|
||||
"
|
||||
(fold (lambda (product result)
|
||||
(let-values (((name version) (cpe->package-name product)))
|
||||
(if name
|
||||
(match result
|
||||
(((previous . versions) . tail)
|
||||
;; Attempt to coalesce NAME and PREVIOUS.
|
||||
(if (string=? name previous)
|
||||
(alist-cons name (cons version versions) tail)
|
||||
(alist-cons name (list version) result)))
|
||||
(()
|
||||
(alist-cons name (list version) result)))
|
||||
result)))
|
||||
'()
|
||||
(sort products string<?)))
|
||||
|
||||
(define %parse-vulnerability-feed
|
||||
;; Parse the XML vulnerability feed from
|
||||
|
|
@ -132,12 +160,12 @@ CPE string."
|
|||
;; Some entries have no vulnerable-software-list.
|
||||
rest)
|
||||
((products id . rest)
|
||||
(match (filter-map cpe->package-name products)
|
||||
(match (cpe->product-alist products)
|
||||
(()
|
||||
;; No application among PRODUCTS.
|
||||
rest)
|
||||
(packages
|
||||
(cons (vulnerability id (reverse packages))
|
||||
(cons (vulnerability id packages)
|
||||
rest))))))
|
||||
(x
|
||||
seed)))
|
||||
|
|
@ -190,7 +218,7 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
|
|||
(with-atomic-file-output cache
|
||||
(lambda (port)
|
||||
(write `(vulnerabilities
|
||||
0 ;format version
|
||||
1 ;format version
|
||||
,(map vulnerability->sexp vulns))
|
||||
port)))
|
||||
vulns))
|
||||
|
|
@ -206,7 +234,7 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
|
|||
(if (old? cache)
|
||||
(update-cache)
|
||||
(match (call-with-input-file cache read)
|
||||
(('vulnerabilities 0 vulns)
|
||||
(('vulnerabilities 1 vulns)
|
||||
(map sexp->vulnerability vulns))
|
||||
(x
|
||||
(update-cache)))))
|
||||
|
|
@ -233,8 +261,8 @@ published by the US NIST."
|
|||
(define (vulnerabilities->lookup-proc vulnerabilities)
|
||||
"Return a lookup procedure built from VULNERABILITIES that takes a package
|
||||
name and optionally a version number. When the version is omitted, the lookup
|
||||
procedure returns a list of version/vulnerability pairs; otherwise, it returns
|
||||
a list of vulnerabilities affection the given package version."
|
||||
procedure returns a list of vulnerabilities; otherwise, it returns a list of
|
||||
vulnerabilities affecting the given package version."
|
||||
(define table
|
||||
;; Map package names to lists of version/vulnerability pairs.
|
||||
(fold (lambda (vuln table)
|
||||
|
|
@ -242,8 +270,8 @@ a list of vulnerabilities affection the given package version."
|
|||
(($ <vulnerability> id packages)
|
||||
(fold (lambda (package table)
|
||||
(match package
|
||||
((name . version)
|
||||
(vhash-cons name (cons version vuln)
|
||||
((name . versions)
|
||||
(vhash-cons name (cons vuln versions)
|
||||
table))))
|
||||
table
|
||||
packages))))
|
||||
|
|
@ -254,11 +282,14 @@ a list of vulnerabilities affection the given package version."
|
|||
(vhash-fold* (if version
|
||||
(lambda (pair result)
|
||||
(match pair
|
||||
((v . vuln)
|
||||
(if (string=? v version)
|
||||
((vuln . versions)
|
||||
(if (member version versions)
|
||||
(cons vuln result)
|
||||
result))))
|
||||
cons)
|
||||
(lambda (pair result)
|
||||
(match pair
|
||||
((vuln . _)
|
||||
(cons vuln result)))))
|
||||
'()
|
||||
package table)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -32,12 +32,10 @@
|
|||
(list
|
||||
;; CVE-2003-0001 has no "/a" in its product list so it is omitted.
|
||||
;; CVE-2004-0230 lists "tcp" as an application, but lacks a version number.
|
||||
(vulnerability "CVE-2008-2335" '(("phpvid" . "1.1") ("phpvid" . "1.2")))
|
||||
(vulnerability "CVE-2008-3522" '(("enterprise_virtualization" . "3.5")
|
||||
("jasper" . "1.900.1")))
|
||||
(vulnerability "CVE-2009-3301" '(("openoffice.org" . "2.1.0")
|
||||
("openoffice.org" . "2.3.0")
|
||||
("openoffice.org" . "2.2.1")))
|
||||
(vulnerability "CVE-2008-2335" '(("phpvid" "1.2" "1.1")))
|
||||
(vulnerability "CVE-2008-3522" '(("enterprise_virtualization" "3.5")
|
||||
("jasper" "1.900.1")))
|
||||
(vulnerability "CVE-2009-3301" '(("openoffice.org" "2.3.0" "2.2.1" "2.1.0")))
|
||||
;; CVE-2015-8330 has no software list.
|
||||
))
|
||||
|
||||
|
|
@ -48,9 +46,8 @@
|
|||
%expected-vulnerabilities
|
||||
(call-with-input-file %sample xml->vulnerabilities))
|
||||
|
||||
(test-equal ""
|
||||
(list `(("1.1" . ,(first %expected-vulnerabilities))
|
||||
("1.2" . ,(first %expected-vulnerabilities)))
|
||||
(test-equal "vulnerabilities->lookup-proc"
|
||||
(list (list (first %expected-vulnerabilities))
|
||||
'()
|
||||
'()
|
||||
(list (second %expected-vulnerabilities))
|
||||
|
|
|
|||
Loading…
Reference in New Issue