* guix/cve.scm: Exploit cpe vendors information.
(cpe->package-name): Rename to cpe->package and use
cpe_vendor:cpe_name in place or cpe_name.
(filter-vendors): Add helper function.
(vulnerabilities->lookup-proc): Extract cpe_name for table
hashes. Add vendor and hidden-vendor arguments. Adapt condition to
pass vulnerabilities to result in the fold.
* guix/lint.scm (package-vulnerabilities): Use additional arguments
from vulnerabilities->lookup-proc.
* tests/cve.scm: Adapt tests.
---
guix/cve.scm | 71 +++++++++++++++++++++++++++++++++------------------
guix/lint.scm | 11 ++++++--
tests/cve.scm | 30 +++++++++++-----------
3 files changed, 70 insertions(+), 42 deletions(-)
Toggle diff (196 lines)
diff --git a/guix/cve.scm b/guix/cve.scm
index 9e1cf5b587..a2335f15ef 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -106,22 +106,22 @@ (define (reference-data->cve-references alist)
(define %cpe-package-rx
;; For applications: "cpe:2.3:a:VENDOR:PACKAGE:VERSION", or sometimes
;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
- (make-regexp "^cpe:2\\.3:a:([^:]+):([^:]+):([^:]+):([^:]+):"))
+ (make-regexp "^cpe:2\\.3:a:([^:]+:[^:]+):([^:]+):([^:]+):"))
-(define (cpe->package-name cpe)
+(define (cpe->package cpe)
"Converts the Common Platform Enumeration (CPE) string CPE to a package
-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."
+name, in a very naive way. Return two values: the package identifier
+(composed from the CPE vendor and 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 cpe)
=>
(lambda (matches)
- (values (match:substring matches 2)
- (match (match:substring matches 3)
+ (values (match:substring matches 1)
+ (match (match:substring matches 2)
("*" '_)
(version
(string-append version
- (match (match:substring matches 4)
+ (match (match:substring matches 3)
("" "")
(patch-level
;; Drop the colon from things like
@@ -142,7 +142,7 @@ (define (cpe-match->cve-configuration alist)
;; Normally "cpe23Uri" is here in each "cpe_match" item, but CVE-2020-0534
;; has a configuration that lacks it.
(and cpe
- (let-values (((package version) (cpe->package-name cpe)))
+ (let-values (((package version) (cpe->package cpe)))
(and package
`(,package
,(cond ((and (or starti starte) (or endi ende))
@@ -228,6 +228,24 @@ (define (version-matches? version sexp)
(('>= min)
(version>=? version min))))
+(define (filter-vendors vuln vendor hidden-vendors)
+
+ (define (vendor-matches? vendor+name)
+ (if vendor
+ (string-prefix? (string-append vendor ":") vendor+name)
+ (if hidden-vendors
+ (not (any (lambda (v)
+ (string-prefix? (string-append v ":") vendor+name))
+ hidden-vendors))
+ #t)))
+
+ (match vuln
+ (($ <vulnerability> id packages)
+ (any (match-lambda
+ (((? vendor-matches? vendor+name) . _) #t)
+ (_ #f))
+ packages))))
+
;;;
;;; High-level interface.
@@ -404,28 +422,31 @@ (define table
(($ <vulnerability> id packages)
(fold (lambda (package table)
(match package
- ((name . versions)
- (vhash-cons name (cons vuln versions)
+ ((vendor+name . versions)
+ (vhash-cons (match (string-split vendor+name #\:)
+ ((vendor name) name)
+ ((name) name))
+ (cons vuln versions)
table))))
table
packages))))
vlist-null
vulnerabilities))
- (lambda* (package #:optional version)
- (vhash-fold* (if version
- (lambda (pair result)
- (match pair
- ((vuln sexp)
- (if (version-matches? version sexp)
- (cons vuln result)
- result))))
- (lambda (pair result)
- (match pair
- ((vuln . _)
- (cons vuln result)))))
- '()
- package table)))
+ (lambda* (package #:key (version #f) (vendor #f) (hidden-vendors #f))
+ (vhash-fold*
+ (lambda (pair result)
+ (match pair
+ ((vuln sexp)
+ (if (and (or (not (or vendor hidden-vendors))
+ (and (or vendor hidden-vendors)
+ (filter-vendors vuln vendor hidden-vendors)))
+ (or (not version)
+ (and version (version-matches? version sexp))))
+ (cons vuln result)
+ result))))
+ '()
+ package table)))
;;; cve.scm ends here
diff --git a/guix/lint.scm b/guix/lint.scm
index 8c6c20c723..db3f59e3ec 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1551,8 +1551,15 @@ (define package-vulnerabilities
(package-name package)))
(version (or (assoc-ref (package-properties package)
'cpe-version)
- (package-version package))))
- ((force lookup) name version)))))
+ (package-version package)))
+ (vendor (assoc-ref (package-properties package)
+ 'cpe-vendor))
+ (hidden-vendors (assoc-ref (package-properties package)
+ 'lint-hidden-cpe-vendors)))
+ ((force lookup) name
+ #:version version
+ #:vendor vendor
+ #:hidden-vendors hidden-vendors)))))
;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
(set! package-vulnerabilities package-vulnerabilities)
diff --git a/tests/cve.scm b/tests/cve.scm
index b69da0e120..0b6346a4d4 100644
--- a/tests/cve.scm
+++ b/tests/cve.scm
@@ -34,19 +34,19 @@ (define %expected-vulnerabilities
(vulnerability "CVE-2019-0001"
;; Only the "a" CPE configurations are kept; the "o"
;; configurations are discarded.
- '(("junos" (or "18.21-s4" (or "18.21-s3" "18.2")))))
+ '(("juniper:junos" (or "18.21-s4" (or "18.21-s3" "18.2")))))
(vulnerability "CVE-2019-0005"
- '(("junos" (or "18.11" "18.1"))))
+ '(("juniper:junos" (or "18.11" "18.1"))))
;; CVE-2019-0005 has no "a" configurations.
(vulnerability "CVE-2019-14811"
- '(("ghostscript" (< "9.28"))))
+ '(("artifex:ghostscript" (< "9.28"))))
(vulnerability "CVE-2019-17365"
- '(("nix" (<= "2.3"))))
+ '(("nixos:nix" (<= "2.3"))))
(vulnerability "CVE-2019-1010180"
- '(("gdb" _))) ;any version
+ '(("gnu:gdb" _))) ;any version
(vulnerability "CVE-2019-1010204"
- '(("binutils" (and (>= "2.21") (<= "2.31.1")))
- ("binutils_gold" (and (>= "1.11") (<= "1.16")))))
+ '(("gnu:binutils" (and (>= "2.21") (<= "2.31.1")))
+ ("gnu:binutils_gold" (and (>= "1.11") (<= "1.16")))))
;; CVE-2019-18192 has no associated configurations.
))
@@ -92,15 +92,15 @@ (define %expected-vulnerabilities
(let* ((vulns (call-with-input-file %sample json->vulnerabilities))
(lookup (vulnerabilities->lookup-proc vulns)))
(list (lookup "ghostscript")
- (lookup "ghostscript" "9.27")
- (lookup "ghostscript" "9.28")
+ (lookup "ghostscript" #:version "9.27")
+ (lookup "ghostscript" #:version "9.28")
(lookup "gdb")
- (lookup "gdb" "42.0")
+ (lookup "gdb" #:version "42.0")
(lookup "nix")
- (lookup "nix" "2.4")
- (lookup "binutils" "2.31.1")
- (lookup "binutils" "2.10")
- (lookup "binutils_gold" "1.11")
- (lookup "binutils" "2.32"))))
+ (lookup "nix" #:version "2.4")
+ (lookup "binutils" #:version "2.31.1")
+ (lookup "binutils" #:version "2.10")
+ (lookup "binutils_gold" #:version "1.11")
+ (lookup "binutils" #:version "2.32"))))
(test-end "cve")
--
2.46.0
