mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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:
parent
f511be7bcc
commit
229674573c
3 changed files with 115 additions and 71 deletions
162
guix/cve.scm
162
guix/cve.scm
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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.
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue