Nicolas Graves <ngraves@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.
Received: (at submit) by debbugs.gnu.org; 7 Mar 2025 18:40:24 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Mar 07 13:40:24 2025
Received: from localhost ([127.0.0.1]:50189 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tqccR-0006ff-BQ
for submit <at> debbugs.gnu.org; Fri, 07 Mar 2025 13:40:24 -0500
Received: from lists.gnu.org ([2001:470:142::17]:40934)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.84_2) (envelope-from <ngraves@HIDDEN>)
id 1tqcby-0006RC-Rw
for submit <at> debbugs.gnu.org; Fri, 07 Mar 2025 13:39:55 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <ngraves@HIDDEN>)
id 1tqcbi-0008N4-Pa
for guix-patches@HIDDEN; Fri, 07 Mar 2025 13:39:38 -0500
Received: from 8.mo581.mail-out.ovh.net ([46.105.77.114])
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <ngraves@HIDDEN>)
id 1tqcbV-0001vL-Kp
for guix-patches@HIDDEN; Fri, 07 Mar 2025 13:39:30 -0500
Received: from director1.ghost.mail-out.ovh.net (unknown [10.108.2.205])
by mo581.mail-out.ovh.net (Postfix) with ESMTP id 4Z8Znj2WB2z1SS7
for <guix-patches@HIDDEN>; Fri, 7 Mar 2025 18:39:21 +0000 (UTC)
Received: from ghost-submission-5b5ff79f4f-68rtn (unknown [10.110.178.161])
by director1.ghost.mail-out.ovh.net (Postfix) with ESMTPS id 097E21FE2D;
Fri, 7 Mar 2025 18:39:20 +0000 (UTC)
Received: from ngraves.fr ([37.59.142.104])
by ghost-submission-5b5ff79f4f-68rtn with ESMTPSA
id mTfcIVg9y2dzPQ0AdnnBjA
(envelope-from <ngraves@HIDDEN>); Fri, 07 Mar 2025 18:39:20 +0000
Authentication-Results: garm.ovh; auth=pass
(GARM-104R00532e2bf7d-725f-4576-8465-a1d836fd483b,
93CD87FFD4632086FD827B47E208BFE70AFEC0F0) smtp.auth=ngraves@HIDDEN
X-OVh-ClientIp: 90.92.117.144
From: Nicolas Graves <ngraves@HIDDEN>
To: 76819 <at> debbugs.gnu.org
Subject: [PATCH v7 01/35] cve: Add cpe-vendor and lint-hidden-cpe-vendors
properties.
Date: Fri, 7 Mar 2025 19:38:30 +0100
Message-ID: <20250307183914.8825-1-ngraves@HIDDEN>
X-Mailer: git-send-email 2.48.1
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-Ovh-Tracer-Id: 4420564509733413626
X-VR-SPAMSTATE: OK
X-VR-SPAMSCORE: -100
X-VR-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgeefvddrtddtgdduuddugedtucetufdoteggodetrfdotffvucfrrhhofhhilhgvmecuqfggjfdpvefjgfevmfevgfenuceurghilhhouhhtmecuhedttdenucesvcftvggtihhpihgvnhhtshculddquddttddmnecujfgurhephffvvefufffkofgggfestdekredtredttdenucfhrhhomheppfhitgholhgrshcuifhrrghvvghsuceonhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrqeenucggtffrrghtthgvrhhnpeekffegteffgfffjeegjedvfffgtddvueeutefgfeeuvdejgedvgeejjeevueeuveenucfkphepuddvjedrtddrtddruddpledtrdelvddruddujedrudeggedpfeejrdehledrudegvddruddtgeenucevlhhushhtvghrufhiiigvpedtnecurfgrrhgrmhepihhnvghtpeduvdejrddtrddtrddupdhmrghilhhfrhhomhepnhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrpdhnsggprhgtphhtthhopedupdhrtghpthhtohepghhuihigqdhprghttghhvghssehgnhhurdhorhhgpdfovfetjfhoshhtpehmohehkedumgdpmhhouggvpehsmhhtphhouhht
DKIM-Signature: a=rsa-sha256; bh=muMjbwVDCiYYfiuAo993TI6KKPCEw8KkB7LmX6JFkTU=;
c=relaxed/relaxed; d=ngraves.fr; h=From;
s=ovhmo4487190-selector1; t=1741372761; v=1;
b=PDiJ8Izz3NCFcYA8MKZJBf86X2p96O71NXACi69OWrEddLEELilH8EYwqedJDKmesJ8C04mh
n80QL3/I+Z69f5VDyyiXk0j4QimYgGJ+lGkqI18kRpSOHrtFyWnM674tRLTHcHUYUQuIx3/U0wA
es/R1IpdcbokBbjFwVCHhnd/Qoj3Jg1CP1ZHmY8ixWWHhSP9+s1hOCGgBvic4sSdj3CZ4cm7pCl
dBdN+nsshzXau4cKHDLNzfrY5l7JlUlyCfuMJuNDCIoc26lhgY9wUJW/aGVbg8cOsH55pB2xZ4V
qGhSu5z0luUos3xOnUVPb5TDa/RslY1/woFV4Tun6O6ig==
Received-SPF: pass client-ip=46.105.77.114; envelope-from=ngraves@HIDDEN;
helo=8.mo581.mail-out.ovh.net
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1,
RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001,
SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: 1.0 (+)
X-Debbugs-Envelope-To: submit
Cc: Nicolas Graves via Guix-patches via <guix-patches@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.0 (/)
From: Nicolas Graves via Guix-patches via <guix-patches@HIDDEN>
* guix/cve.scm: Exploit cpe vendors information.
(cpe->package-name): Rename to...
(cpe->package-identifier): Renamed from cpe->package-name. Use
cpe_vendor:cpe_name in place or cpe_name.
(vulnerabily-matches?): 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.
(write-cache, fetch-vulnerabilities): Update the format version.
* guix/lint.scm (package-vulnerabilities): Use additional arguments
from vulnerabilities->lookup-proc.
* tests/cve.scm (%expected-vulnerabilities): Adapt variable to changes
in guix/cve.scm.
---
guix/cve.scm | 160 ++++++++++++++++++++++++++++++--------------------
guix/lint.scm | 10 +++-
tests/cve.scm | 14 ++---
3 files changed, 112 insertions(+), 72 deletions(-)
diff --git a/guix/cve.scm b/guix/cve.scm
index 9e1cf5b587..5ea5219190 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)
@@ -108,15 +108,16 @@ (define %cpe-package-rx
;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
(make-regexp "^cpe:2\\.3:a:([^:]+):([^:]+):([^:]+):([^:]+):"))
-(define (cpe->package-name cpe)
+(define (cpe->package-identifier 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."
+identifier, in a very naive way. Return three values: the CPE vendor, the
+package name, and its version string.
+Return three #f values if CPE does not look like an application CPE string."
(cond ((regexp-exec %cpe-package-rx cpe)
=>
(lambda (matches)
- (values (match:substring matches 2)
+ (values (match:substring matches 1)
+ (match:substring matches 2)
(match (match:substring matches 3)
("*" '_)
(version
@@ -128,7 +129,7 @@ (define (cpe->package-name cpe)
;; "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-name 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\"
@@ -228,6 +230,25 @@ (define (version-matches? version sexp)
(('>= min)
(version>=? version min))))
+(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 hidden-vendor?
+ (if (list? hidden-vendors)
+ (cut member <> hidden-vendors)
+ (const #f)))
+
+ (match vuln
+ (($ <vulnerability> id packages)
+ (any (match-lambda
+ ((? (lambda (candidate)
+ (and vendor
+ (string=? candidate vendor)))) #t)
+ ((? hidden-vendor?) #f)
+ (otherwise (not vendor)))
+ (map car packages))))) ;candidate vendors
+
;;;
;;; High-level interface.
@@ -259,7 +280,7 @@ (define-record-type <vulnerability>
(vulnerability id packages)
vulnerability?
(id vulnerability-id) ;string
- (packages vulnerability-packages)) ;((p1 sexp1) (p2 sexp2) ...)
+ (packages vulnerability-packages)) ;((v1 p1 sexp1) (v2 p2 sexp2) ...)
(define vulnerability->sexp
(match-lambda
@@ -271,40 +292,53 @@ (define sexp->vulnerability
(('v id (packages ...))
(vulnerability id packages))))
+(define sexp-v1->vulnerability
+ (match-lambda
+ (('v id (packages ...))
+ (vulnerability id (map (cut cons #f <>) 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 '()))
+ (results '()))
(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 results configs))
+ (('and config _ ...) ;XXX
+ (loop config results))
+ (((? string? vendor) (? string? package) sexp)
+ (let ((pruned-results (remove (match-lambda
+ ((vendor package _) #t)
+ (otherwise #f))
+ results)))
+ (match sexp
+ ('_ ;any version
+ (cons `(,vendor ,package _) pruned-results))
+ (_
+ (match (assoc-ref (assoc-ref results vendor) package)
+ ((previous)
+ (cons `(,vendor ,package (or ,sexp ,previous)) pruned-results))
+ (_
+ (cons `(,vendor ,package ,sexp) results))))))))))
(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))
+ (remove (match-lambda
+ ((vendor package _) #t)
+ (otherwise #f))
+ result)))
+ (_
+ (cons `(,vendor ,package ,version) result)))))
result
plist))
'()
@@ -337,7 +371,7 @@ (define vulns
(json->vulnerabilities input))
(write `(vulnerabilities
- 1 ;format version
+ 2 ;format version
,(map vulnerability->sexp vulns))
cache))))
@@ -371,8 +405,10 @@ (define (read* port)
(sexp (read* port)))
(close-port port)
(match sexp
- (('vulnerabilities 1 vulns)
- (map sexp->vulnerability vulns)))))
+ (('vulnerabilities 2 vulns)
+ (map sexp->vulnerability vulns))
+ (('vulnerabilities 1 vulns) ;old format, lacks vendor info
+ (map sexp-v1->vulnerability vulns)))))
(define* (current-vulnerabilities #:key (timeout 10))
"Return the current list of Common Vulnerabilities and Exposures (CVE) as
@@ -404,28 +440,26 @@ (define table
(($ <vulnerability> id packages)
(fold (lambda (package table)
(match package
- ((name . versions)
- (vhash-cons name (cons vuln versions)
+ ((vendor name versions)
+ (vhash-cons 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 #:optional version #:key (vendor #f) (hidden-vendors '()))
+ (vhash-fold*
+ (lambda (pair result)
+ (match pair
+ ((vuln sexp)
+ (if (and (or (and (not vendor) (null? hidden-vendors))
+ (vulnerability-matches? vuln vendor hidden-vendors))
+ (or (not 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 d54db725b5..095694ed49 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1585,8 +1585,14 @@ (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
+ #: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..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.
- '(("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"
- '(("junos" (or "18.11" "18.1"))))
+ '(("juniper" "junos" (or "18.1" "18.11"))))
;; 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.
))
--
2.48.1
Nicolas Graves <ngraves@HIDDEN>:guix-patches@HIDDEN.
Full text available.guix-patches@HIDDEN:bug#76823; Package guix-patches.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.