Package: guix-patches;
Reported by: Nicolas Graves <ngraves <at> ngraves.fr>
Date: Sat, 26 Oct 2024 22:31:02 UTC
Severity: normal
Tags: patch
Done: Nicolas Graves <ngraves <at> ngraves.fr>
Bug is archived. No further changes may be made.
Message #147 received at 74034 <at> debbugs.gnu.org (full text, mbox):
From: Nicolas Graves <ngraves <at> ngraves.fr> To: 74034 <at> debbugs.gnu.org Cc: Nicolas Graves <ngraves <at> 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(-)
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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.