cve: Add cpe-vendor and lint-hidden-cpe-vendors properties.

* 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.

Signed-off-by: Zheng Junjie <z572@z572.online>
This commit is contained in:
Nicolas Graves via Guix-patches via 2024-11-24 21:16:19 +01:00 committed by Zheng Junjie
parent f511be7bcc
commit 229674573c
No known key found for this signature in database
GPG key ID: 3B5AA993E1A2DFF0
3 changed files with 115 additions and 71 deletions

View file

@ -25,11 +25,11 @@
#:use-module (web uri) #:use-module (web uri)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
@ -108,15 +108,16 @@
;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". ;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
(make-regexp "^cpe:2\\.3:a:([^:]+):([^:]+):([^:]+):([^:]+):")) (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 "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 identifier, in a very naive way. Return three values: the CPE vendor, the
version string. Return #f and #f if CPE does not look like an application CPE package name, and its version string.
string." Return three #f values if CPE does not look like an application CPE string."
(cond ((regexp-exec %cpe-package-rx cpe) (cond ((regexp-exec %cpe-package-rx cpe)
=> =>
(lambda (matches) (lambda (matches)
(values (match:substring matches 2) (values (match:substring matches 1)
(match:substring matches 2)
(match (match:substring matches 3) (match (match:substring matches 3)
("*" '_) ("*" '_)
(version (version
@ -128,7 +129,7 @@ string."
;; "cpe:2.3:a:openbsd:openssh:6.8:p1". ;; "cpe:2.3:a:openbsd:openssh:6.8:p1".
(string-drop patch-level 1))))))))) (string-drop patch-level 1)))))))))
(else (else
(values #f #f)))) (values #f #f #f))))
(define (cpe-match->cve-configuration alist) (define (cpe-match->cve-configuration alist)
"Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package "Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package
@ -142,17 +143,18 @@ package."
;; Normally "cpe23Uri" is here in each "cpe_match" item, but CVE-2020-0534 ;; Normally "cpe23Uri" is here in each "cpe_match" item, but CVE-2020-0534
;; has a configuration that lacks it. ;; has a configuration that lacks it.
(and cpe (and cpe
(let-values (((package version) (cpe->package-name cpe))) (let ((vendor package version (cpe->package-identifier cpe)))
(and package (and package
`(,package `(,vendor
,(cond ((and (or starti starte) (or endi ende)) ,package
`(and ,(if starti `(>= ,starti) `(> ,starte)) ,(cond ((and (or starti starte) (or endi ende))
,(if endi `(<= ,endi) `(< ,ende)))) `(and ,(if starti `(>= ,starti) `(> ,starte))
(starti `(>= ,starti)) ,(if endi `(<= ,endi) `(< ,ende))))
(starte `(> ,starte)) (starti `(>= ,starti))
(endi `(<= ,endi)) (starte `(> ,starte))
(ende `(< ,ende)) (endi `(<= ,endi))
(else version)))))))) (ende `(< ,ende))
(else version))))))))
(define (configuration-data->cve-configurations alist) (define (configuration-data->cve-configurations alist)
"Given ALIST, a JSON dictionary for the baroque \"configurations\" "Given ALIST, a JSON dictionary for the baroque \"configurations\"
@ -228,6 +230,30 @@ records."
(('>= min) (('>= min)
(version>=? version 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)))
(define vendor=?
(if vendor
(cut string=? <> vendor)
(const #f)))
(match vuln
(($ <vulnerability> id packages)
(any (match-lambda
((? vendor=?)
#t)
((? hidden-vendor?)
#f)
(otherwise
(not vendor)))
(map car packages))))) ;candidate vendors
;;; ;;;
;;; High-level interface. ;;; High-level interface.
@ -259,7 +285,7 @@ records."
(vulnerability id packages) (vulnerability id packages)
vulnerability? vulnerability?
(id vulnerability-id) ;string (id vulnerability-id) ;string
(packages vulnerability-packages)) ;((p1 sexp1) (p2 sexp2) ...) (packages vulnerability-packages)) ;((v1 p1 sexp1) (v2 p2 sexp2) ...)
(define vulnerability->sexp (define vulnerability->sexp
(match-lambda (match-lambda
@ -271,40 +297,52 @@ records."
(('v id (packages ...)) (('v id (packages ...))
(vulnerability id packages)))) (vulnerability id packages))))
(define sexp-v1->vulnerability
(match-lambda
(('v id (packages ...))
(vulnerability id (map (cut cons #f <>) packages)))))
(define vendor-tuple?
(match-lambda
((vendor package _)
#t)
(otherwise
#f)))
(define (cve-configuration->package-list config) (define (cve-configuration->package-list config)
"Parse CONFIG, a config sexp, and return a list of the form (P SEXP) "Parse CONFIG, a config sexp, and return a list of the form (V P SEXP)
where P is a package name and SEXP expresses constraints on the matching where V is a CPE vendor, P is a package name and SEXP expresses constraints on
versions." the matching versions."
(let loop ((config config) (let loop ((config config)
(packages '())) (results '()))
(match config (match config
(('or configs ...) (('or configs ...)
(fold loop packages configs)) (fold loop results configs))
(('and config _ ...) ;XXX (('and config _ ...) ;XXX
(loop config packages)) (loop config results))
(((? string? package) '_) ;any version (((? string? vendor) (? string? package) '_) ;any version
(cons `(,package _) (cons `(,vendor ,package _) (remove vendor-tuple? results)))
(alist-delete package packages))) (((? string? vendor) (? string? package) sexp)
(((? string? package) sexp) (match (assoc-ref (assoc-ref results vendor) package)
(let ((previous (assoc-ref packages package))) ((previous)
(if previous (cons `(,vendor ,package (or ,sexp ,previous))
(cons `(,package (or ,sexp ,@previous)) (remove vendor-tuple? results)))
(alist-delete package packages)) (_
(cons `(,package ,sexp) packages))))))) (cons `(,vendor ,package ,sexp) results)))))))
(define (merge-package-lists lst) (define (merge-package-lists lst)
"Merge the list in LST, each of which has the form (p sexp), where P "Merge the list in LST, each of which has the form (V P SEXP), where V is a
is the name of a package and SEXP is an sexp that constrains matching CPE vendor, P is the name of a package and SEXP is an sexp that constrains
versions." matching versions."
(fold (lambda (plist result) ;XXX: quadratic (fold (lambda (plist result) ;XXX: quadratic
(fold (match-lambda* (fold (match-lambda*
(((package version) result) (((vendor package version) result)
(match (assoc-ref result package) (match (assoc-ref result vendor)
(#f (((? (cut string=? package <>)) previous)
(cons `(,package ,version) result)) (cons `(,vendor ,package (or ,version ,previous))
((previous) (remove vendor-tuple? result)))
(cons `(,package (or ,version ,previous)) (_
(alist-delete package result)))))) (cons `(,vendor ,package ,version) result)))))
result result
plist)) plist))
'() '()
@ -337,7 +375,7 @@ sexp to CACHE."
(json->vulnerabilities input)) (json->vulnerabilities input))
(write `(vulnerabilities (write `(vulnerabilities
1 ;format version 2 ;format version
,(map vulnerability->sexp vulns)) ,(map vulnerability->sexp vulns))
cache)))) cache))))
@ -371,8 +409,10 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
(sexp (read* port))) (sexp (read* port)))
(close-port port) (close-port port)
(match sexp (match sexp
(('vulnerabilities 1 vulns) (('vulnerabilities 2 vulns)
(map sexp->vulnerability vulns))))) (map sexp->vulnerability vulns))
(('vulnerabilities 1 vulns) ;old format, lacks vendor info
(map sexp-v1->vulnerability vulns)))))
(define* (current-vulnerabilities #:key (timeout 10)) (define* (current-vulnerabilities #:key (timeout 10))
"Return the current list of Common Vulnerabilities and Exposures (CVE) as "Return the current list of Common Vulnerabilities and Exposures (CVE) as
@ -404,7 +444,7 @@ vulnerabilities affecting the given package version."
(($ <vulnerability> id packages) (($ <vulnerability> id packages)
(fold (lambda (package table) (fold (lambda (package table)
(match package (match package
((name . versions) ((vendor name . versions)
(vhash-cons name (cons vuln versions) (vhash-cons name (cons vuln versions)
table)))) table))))
table table
@ -412,20 +452,18 @@ vulnerabilities affecting the given package version."
vlist-null vlist-null
vulnerabilities)) vulnerabilities))
(lambda* (package #:optional version) (lambda* (package #:optional version #:key (vendor #f) (hidden-vendors '()))
(vhash-fold* (if version (vhash-fold*
(lambda (pair result) (lambda (pair result)
(match pair (match pair
((vuln sexp) ((vuln sexp)
(if (version-matches? version sexp) (if (and (or (and (not vendor) (null? hidden-vendors))
(cons vuln result) (vulnerability-matches? vuln vendor hidden-vendors))
result)))) (or (not version) (version-matches? version sexp)))
(lambda (pair result) (cons vuln result)
(match pair result))))
((vuln . _) '()
(cons vuln result))))) package table)))
'()
package table)))
;;; cve.scm ends here ;;; cve.scm ends here

View file

@ -1595,8 +1595,14 @@ CVE vulnerabilities from '~a': ~a (~a)~%")
(package-name package))) (package-name package)))
(version (or (assoc-ref (package-properties package) (version (or (assoc-ref (package-properties package)
'cpe-version) 'cpe-version)
(package-version package)))) (package-version package)))
((force lookup) name version))))) (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. ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests.
(set! package-vulnerabilities package-vulnerabilities) (set! package-vulnerabilities package-vulnerabilities)

View file

@ -34,19 +34,19 @@
(vulnerability "CVE-2019-0001" (vulnerability "CVE-2019-0001"
;; Only the "a" CPE configurations are kept; the "o" ;; Only the "a" CPE configurations are kept; the "o"
;; configurations are discarded. ;; 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" (vulnerability "CVE-2019-0005"
'(("junos" (or "18.11" "18.1")))) '(("juniper" "junos" (or "18.1" "18.11"))))
;; CVE-2019-0005 has no "a" configurations. ;; CVE-2019-0005 has no "a" configurations.
(vulnerability "CVE-2019-14811" (vulnerability "CVE-2019-14811"
'(("ghostscript" (< "9.28")))) '(("artifex" "ghostscript" (< "9.28"))))
(vulnerability "CVE-2019-17365" (vulnerability "CVE-2019-17365"
'(("nix" (<= "2.3")))) '(("nixos" "nix" (<= "2.3"))))
(vulnerability "CVE-2019-1010180" (vulnerability "CVE-2019-1010180"
'(("gdb" _))) ;any version '(("gnu" "gdb" _))) ;any version
(vulnerability "CVE-2019-1010204" (vulnerability "CVE-2019-1010204"
'(("binutils" (and (>= "2.21") (<= "2.31.1"))) '(("gnu" "binutils" (and (>= "2.21") (<= "2.31.1")))
("binutils_gold" (and (>= "1.11") (<= "1.16"))))) ("gnu" "binutils_gold" (and (>= "1.11") (<= "1.16")))))
;; CVE-2019-18192 has no associated configurations. ;; CVE-2019-18192 has no associated configurations.
)) ))