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

From: Nicolas Graves <[email-masked]>
Date: Fri, 08 Nov 2024 19:13:19 +0100

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 <[email-masked]>
To: [email-masked]
Cc: Nicolas Graves <[email-masked]>
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(-)

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

-------------------- End of forwarded message --------------------

-- 
Best regards,
Nicolas Graves