summaryrefslogtreecommitdiff
path: root/guix/cve.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-05-28 00:44:36 +0200
committerLudovic Courtès <ludo@gnu.org>2016-05-28 01:07:12 +0200
commit870bf71eb0983f0f7f7221434db3ff5f785b3b2c (patch)
treec7556c43f2545dba2b5224b3bb24b3f633e1f9b1 /guix/cve.scm
parent494dc2fc628b754a9cc86a54c90202b13e0b68c6 (diff)
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.
Diffstat (limited to 'guix/cve.scm')
-rw-r--r--guix/cve.scm79
1 files changed, 55 insertions, 24 deletions
diff --git a/guix/cve.scm b/guix/cve.scm
index 2167028ede..088e39837a 100644
--- a/guix/cve.scm
+++ b/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)))