Subject: [bug#74034] [PATCH v3 02/17] cve: Separate vendor and string.

From: Nicolas Graves <[email-masked]>
Date: Fri, 8 Nov 2024 19:02:25 +0100

---
 guix/cve.scm  | 111 +++++++++++++++++++++++++-------------------------
 tests/cve.scm |  14 +++----
 2 files changed, 63 insertions(+), 62 deletions(-)

diff --git a/guix/cve.scm b/guix/cve.scm
index f7984be0ad..4f410ccc5e 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -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))))
diff --git a/tests/cve.scm b/tests/cve.scm
index 6567d73c69..90ada2b647 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.
-                  '(("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.
    ))
 
-- 
2.46.0