@@ -25,11 +25,11 @@ (define-module (guix cve)
#: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 (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
@@ -106,7 +106,7 @@ (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-identifier cpe)
"Converts the Common Platform Enumeration (CPE) string CPE to a package
@@ -117,18 +117,19 @@ (define (cpe->package-identifier cpe)
=>
(lambda (matches)
(values (match:substring matches 1)
- (match (match:substring matches 2)
+ (match:substring matches 2)
+ (match (match:substring matches 3)
("*" '_)
(version
(string-append version
- (match (match:substring matches 3)
+ (match (match:substring matches 4)
("" "")
(patch-level
;; Drop the colon from things like
;; "cpe:2.3:a:openbsd:openssh:6.8:p1".
(string-drop patch-level 1)))))))))
(else
- (values #f #f))))
+ (values #f #f #f))))
(define (cpe-match->cve-configuration alist)
"Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package
@@ -142,17 +143,18 @@ (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-identifier cpe)))
+ (let ((vendor package version (cpe->package-identifier cpe)))
(and package
- `(,package
- ,(cond ((and (or starti starte) (or endi ende))
- `(and ,(if starti `(>= ,starti) `(> ,starte))
- ,(if endi `(<= ,endi) `(< ,ende))))
- (starti `(>= ,starti))
- (starte `(> ,starte))
- (endi `(<= ,endi))
- (ende `(< ,ende))
- (else version))))))))
+ `(,vendor
+ ,package
+ ,(cond ((and (or starti starte) (or endi ende))
+ `(and ,(if starti `(>= ,starti) `(> ,starte))
+ ,(if endi `(<= ,endi) `(< ,ende))))
+ (starti `(>= ,starti))
+ (starte `(> ,starte))
+ (endi `(<= ,endi))
+ (ende `(< ,ende))
+ (else version))))))))
(define (configuration-data->cve-configurations alist)
"Given ALIST, a JSON dictionary for the baroque \"configurations\"
@@ -232,18 +234,12 @@ (define (vulnerability-matches? vuln vendor hidden-vendors)
"Checks if a VENDOR matches at least one of <vulnerability> VULN
packages. When VENDOR is #f, ignore packages that have a vendor among
HIDDEN-VENDORS."
- (define (vendor-matches? vendor+name)
- (if vendor
- (string-prefix? (string-append vendor ":") vendor+name)
- (or (null? hidden-vendors)
- (not (any (cut string-prefix? (string-append <> ":") vendor+name)
- hidden-vendors)))))
-
(match vuln
(($ <vulnerability> id packages)
(any (match-lambda
- (((? vendor-matches? vendor+name) . _) #t)
- (_ #f))
+ (((? (cut string=? <> vendor)) _) #t)
+ (((? (cut member <> hidden-vendors)) _) #t)
+ (_ #f))
packages))))
@@ -290,39 +286,47 @@ (define sexp->vulnerability
(vulnerability id packages))))
(define (cve-configuration->package-list config)
- "Parse CONFIG, a config sexp, and return a list of the form (P SEXP)
-where P is a package name and SEXP expresses constraints on the matching
-versions."
+ "Parse CONFIG, a config sexp, and return a list of the form (V P SEXP)
+where V is a CPE vendor, P is a package name and SEXP expresses constraints on
+the matching versions."
(let loop ((config config)
- (packages '()))
+ (vendor+package-list '()))
(match config
(('or configs ...)
- (fold loop packages configs))
- (('and config _ ...) ;XXX
- (loop config packages))
- (((? string? package) '_) ;any version
- (cons `(,package _)
- (alist-delete package packages)))
- (((? string? package) sexp)
- (let ((previous (assoc-ref packages package)))
- (if previous
- (cons `(,package (or ,sexp ,@previous))
- (alist-delete package packages))
- (cons `(,package ,sexp) packages)))))))
+ (fold loop vendor+package-list configs))
+ (('and config _ ...) ;XXX
+ (loop config vendor+package-list))
+ (((? string? vendor) (? string? package) sexp)
+ (let ((filtered-list (filter (match-lambda
+ ((vendor package _) #f)
+ (otherwise otherwise))
+ vendor+package-list)))
+ (match sexp
+ ('_ ;any version
+ (cons `(,vendor ,package _) filtered-list))
+ (_
+ (match (assoc-ref (assoc-ref vendor+package-list vendor) package)
+ ((previous)
+ (cons `(,vendor ,package (or ,sexp ,previous)) filtered-list))
+ (_
+ (cons `(,vendor ,package ,sexp) vendor+package-list))))))))))
(define (merge-package-lists lst)
- "Merge the list in LST, each of which has the form (p sexp), where P
-is the name of a package and SEXP is an sexp that constrains matching
-versions."
+ "Merge the list in LST, each of which has the form (V P SEXP), where V is a
+CPE vendor, P is the name of a package and SEXP is an sexp that constrains
+matching versions."
(fold (lambda (plist result) ;XXX: quadratic
(fold (match-lambda*
- (((package version) result)
- (match (assoc-ref result package)
- (#f
- (cons `(,package ,version) result))
- ((previous)
- (cons `(,package (or ,version ,previous))
- (alist-delete package result))))))
+ (((vendor package version) result)
+ (match (assoc-ref result vendor)
+ (((? (cut string=? package <>)) previous)
+ (cons `(,vendor ,package (or ,version ,previous))
+ (filter (match-lambda
+ ((vendor package _) #f)
+ (otherwise otherwise))
+ result)))
+ (_
+ (cons `(,vendor ,package ,version) result)))))
result
plist))
'()
@@ -422,11 +426,8 @@ (define table
(($ <vulnerability> id packages)
(fold (lambda (package table)
(match package
- ((vendor+name . versions)
- (vhash-cons (match (string-split vendor+name #\:)
- ((vendor name) name)
- ((name) name))
- (cons vuln versions)
+ ((vendor name versions)
+ (vhash-cons name (cons vuln `(,versions))
table))))
table
packages))))
@@ -34,19 +34,19 @@ (define %expected-vulnerabilities
(vulnerability "CVE-2019-0001"
;; Only the "a" CPE configurations are kept; the "o"
;; configurations are discarded.
- '(("juniper:junos" (or "18.21-s4" (or "18.21-s3" "18.2")))))
+ '(("juniper" "junos" (or "18.2" (or "18.21-s3" "18.21-s4")))))
(vulnerability "CVE-2019-0005"
- '(("juniper:junos" (or "18.11" "18.1"))))
+ '(("juniper" "junos" (or "18.1" "18.11"))))
;; CVE-2019-0005 has no "a" configurations.
(vulnerability "CVE-2019-14811"
- '(("artifex:ghostscript" (< "9.28"))))
+ '(("artifex" "ghostscript" (< "9.28"))))
(vulnerability "CVE-2019-17365"
- '(("nixos:nix" (<= "2.3"))))
+ '(("nixos" "nix" (<= "2.3"))))
(vulnerability "CVE-2019-1010180"
- '(("gnu:gdb" _))) ;any version
+ '(("gnu" "gdb" _))) ;any version
(vulnerability "CVE-2019-1010204"
- '(("gnu:binutils" (and (>= "2.21") (<= "2.31.1")))
- ("gnu: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.
))
This commit has currently no proper commit message, but it's because it should probably be squashed if we want to go this way. In the end, I've done it, quite tedious (for me at least!) but done. I'm not super sure however that it's clearer (vulnerability-matches? definitely is, but the whole, I doubt that). Just pick your preference I guess! Nicolas -------------------- Start of forwarded message -------------------- From: Nicolas Graves <ngraves@ngraves.fr> To: 74034@debbugs.gnu.org Cc: Nicolas Graves <ngraves@ngraves.fr> Subject: [PATCH v3 02/17] cve: Separate vendor and string. Date: Fri, 8 Nov 2024 19:02:25 +0100 --- guix/cve.scm | 111 +++++++++++++++++++++++++------------------------- tests/cve.scm | 14 +++---- 2 files changed, 63 insertions(+), 62 deletions(-)