;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (guix cve)
#:use-module (guix utils)
#:use-module (guix http-client)
- #:use-module (sxml ssax)
+ #:use-module (guix i18n)
+ #:use-module ((guix diagnostics) #:select (formatted-message))
+ #:use-module (json)
#: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 (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 vlist)
- #:export (vulnerability?
+ #:export (json->cve-items
+
+ cve-item?
+ cve-item-cve
+ cve-item-configurations
+ cve-item-published-date
+ cve-item-last-modified-date
+
+ cve?
+ cve-id
+ cve-data-type
+ cve-data-format
+ cve-references
+
+ cve-reference?
+ cve-reference-url
+ cve-reference-tags
+
+ vulnerability?
vulnerability-id
vulnerability-packages
- xml->vulnerabilities
+ json->vulnerabilities
current-vulnerabilities
vulnerabilities->lookup-proc))
;;;
;;; This modules provides the tools to fetch, parse, and digest part of the
;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST
-;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>.
+;;; at <https://nvd.nist.gov/vuln/data-feeds>.
;;;
;;; Code:
-(define-record-type <vulnerability>
- (vulnerability id packages)
- vulnerability?
- (id vulnerability-id)
- (packages vulnerability-packages))
+(define (string->date* str)
+ (string->date str "~Y-~m-~dT~H:~M~z"))
-(define %cve-feed-uri
- (string->uri
- "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-Modified.xml.gz"))
+(define-json-mapping <cve-item> cve-item cve-item?
+ json->cve-item
+ (cve cve-item-cve "cve" json->cve) ;<cve>
+ (configurations cve-item-configurations ;list of sexps
+ "configurations" configuration-data->cve-configurations)
+ (published-date cve-item-published-date
+ "publishedDate" string->date*)
+ (last-modified-date cve-item-last-modified-date
+ "lastModifiedDate" string->date*))
-(define %ttl
- ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
- ;; updated "approximately every two hours."
- (* 3600 3))
-
-(define (call-with-cve-port proc)
- "Pass PROC an input port from which to read the CVE stream."
- (let ((port (http-fetch/cached %cve-feed-uri #:ttl %ttl)))
- (dynamic-wind
- (const #t)
- (lambda ()
- (call-with-decompressed-port 'gzip port
- proc))
- (lambda ()
- (close-port port)))))
+(define-json-mapping <cve> cve cve?
+ json->cve
+ (id cve-id "CVE_data_meta" ;string
+ (cut assoc-ref <> "ID"))
+ (data-type cve-data-type ;'CVE
+ "data_type" string->symbol)
+ (data-format cve-data-format ;'MITRE
+ "data_format" string->symbol)
+ (references cve-references ;list of <cve-reference>
+ "references" reference-data->cve-references))
+
+(define-json-mapping <cve-reference> cve-reference cve-reference?
+ json->cve-reference
+ (url cve-reference-url) ;string
+ (tags cve-reference-tags ;list of strings
+ "tags" vector->list))
+
+(define (reference-data->cve-references alist)
+ (map json->cve-reference
+ (vector->list (assoc-ref alist "reference_data"))))
(define %cpe-package-rx
- ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION".
- (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)"))
+ ;; 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:([^:]+):([^:]+):([^:]+):([^:]+):"))
(define (cpe->package-name cpe)
"Converts the Common Platform Enumeration (CPE) string CPE to a package
-name, in a very naive way. Return #f if CPE does not look like an application
-CPE string."
- (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
+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."
+ (cond ((regexp-exec %cpe-package-rx cpe)
+ =>
(lambda (matches)
- (cons (match:substring matches 2)
- (match:substring matches 3)))))
-
-(define %parse-vulnerability-feed
- ;; Parse the XML vulnerability feed from
- ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
- ;; vulnerability objects.
- (ssax:make-parser NEW-LEVEL-SEED
- (lambda (elem-gi attributes namespaces expected-content
- seed)
- (match elem-gi
- ((name-space . 'entry)
- (cons (assoc-ref attributes 'id) seed))
- ((name-space . 'vulnerable-software-list)
- (cons '() seed))
- ((name-space . 'product)
- (cons 'product seed))
- (x seed)))
-
- FINISH-ELEMENT
- (lambda (elem-gi attributes namespaces parent-seed
- seed)
- (match elem-gi
- ((name-space . 'entry)
- (match seed
- (((? string? id) . rest)
- ;; Some entries have no vulnerable-software-list.
- rest)
- ((products id . rest)
- (match (filter-map cpe->package-name products)
- (()
- ;; No application among PRODUCTS.
- rest)
- (packages
- (cons (vulnerability id (reverse packages))
- rest))))))
- (x
- seed)))
-
- CHAR-DATA-HANDLER
- (lambda (str _ seed)
- (match seed
- (('product software-list . rest)
- ;; Add STR to the vulnerable software list this
- ;; <product> tag is part of.
- (cons (cons str software-list) rest))
- (x x)))))
-
-(define (xml->vulnerabilities port)
- "Read from PORT an XML feed of vulnerabilities and return a list of
-vulnerability objects."
- (reverse (%parse-vulnerability-feed port '())))
+ (values (match:substring matches 2)
+ (match (match:substring matches 3)
+ ("*" '_)
+ (version
+ (string-append version
+ (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))))
+
+(define (cpe-match->cve-configuration alist)
+ "Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package
+and versions matched. Return #f if ALIST doesn't correspond to an application
+package."
+ (let ((cpe (assoc-ref alist "cpe23Uri"))
+ (starti (assoc-ref alist "versionStartIncluding"))
+ (starte (assoc-ref alist "versionStartExcluding"))
+ (endi (assoc-ref alist "versionEndIncluding"))
+ (ende (assoc-ref alist "versionEndExcluding")))
+ (let-values (((package version) (cpe->package-name 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)))))))
+
+(define (configuration-data->cve-configurations alist)
+ "Given ALIST, a JSON dictionary for the baroque \"configurations\"
+element found in CVEs, return an sexp such as (\"binutils\" (<
+\"2.31\")) that represents matching configurations."
+ (define string->operator
+ (match-lambda
+ ("OR" 'or)
+ ("AND" 'and)))
+
+ (define (node->configuration node)
+ (let ((operator (string->operator (assoc-ref node "operator"))))
+ (cond
+ ((assoc-ref node "cpe_match")
+ =>
+ (lambda (matches)
+ (let ((matches (vector->list matches)))
+ (match (filter-map cpe-match->cve-configuration
+ matches)
+ (() #f)
+ ((one) one)
+ (lst (cons operator lst))))))
+ ((assoc-ref node "children") ;typically for 'and'
+ =>
+ (lambda (children)
+ (match (filter-map node->configuration (vector->list children))
+ (() #f)
+ ((one) one)
+ (lst (cons operator lst)))))
+ (else
+ #f))))
+
+ (let ((nodes (vector->list (assoc-ref alist "nodes"))))
+ (filter-map node->configuration nodes)))
+
+(define (json->cve-items json)
+ "Parse JSON, an input port or a string, and return a list of <cve-item>
+records."
+ (let* ((alist (json->scm json))
+ (type (assoc-ref alist "CVE_data_type"))
+ (format (assoc-ref alist "CVE_data_format"))
+ (version (assoc-ref alist "CVE_data_version")))
+ (unless (equal? type "CVE")
+ (raise (condition (&message
+ (message "invalid CVE feed")))))
+ (unless (equal? format "MITRE")
+ (raise (formatted-message (G_ "unsupported CVE format: '~a'")
+ format)))
+ (unless (equal? version "4.0")
+ (raise (formatted-message (G_ "unsupported CVE data version: '~a'")
+ version)))
+
+ (map json->cve-item
+ (vector->list (assoc-ref alist "CVE_Items")))))
+
+(define (version-matches? version sexp)
+ "Return true if VERSION, a string, matches SEXP."
+ (match sexp
+ ('_
+ #t)
+ ((? string? expected)
+ (version-prefix? expected version))
+ (('or sexps ...)
+ (any (cut version-matches? version <>) sexps))
+ (('and sexps ...)
+ (every (cut version-matches? version <>) sexps))
+ (('< max)
+ (version>? max version))
+ (('<= max)
+ (version>=? max version))
+ (('> min)
+ (version>? version min))
+ (('>= min)
+ (version>=? version min))))
+
+\f
+;;;
+;;; High-level interface.
+;;;
+
+(define %now
+ (current-date))
+(define %current-year
+ (date-year %now))
+(define %past-year
+ (- %current-year 1))
+
+(define (yearly-feed-uri year)
+ "Return the URI for the CVE feed for YEAR."
+ (string->uri
+ (string-append "https://nvd.nist.gov/feeds/json/cve/1.1/nvdcve-1.1-"
+ (number->string year) ".json.gz")))
+
+(define %current-year-ttl
+ ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
+ ;; updated "approximately every two hours."
+ (* 60 30))
+
+(define %past-year-ttl
+ ;; Update the previous year's database more and more infrequently.
+ (* 3600 24 (date-month %now)))
+
+(define-record-type <vulnerability>
+ (vulnerability id packages)
+ vulnerability?
+ (id vulnerability-id) ;string
+ (packages vulnerability-packages)) ;((p1 sexp1) (p2 sexp2) ...)
+
+(define vulnerability->sexp
+ (match-lambda
+ (($ <vulnerability> id packages)
+ `(v ,id ,packages))))
+
+(define sexp->vulnerability
+ (match-lambda
+ (('v id (packages ...))
+ (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."
+ (let loop ((config config)
+ (packages '()))
+ (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)))))))
+
+(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."
+ (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))))))
+ result
+ plist))
+ '()
+ lst))
+
+(define (cve-item->vulnerability item)
+ "Return a <vulnerability> corresponding to ITEM, a <cve-item> record;
+return #f if ITEM does not list any configuration or if it does not list
+any \"a\" (application) configuration."
+ (let ((id (cve-id (cve-item-cve item))))
+ (match (cve-item-configurations item)
+ (() ;no configurations
+ #f)
+ ((configs ...)
+ (vulnerability id
+ (merge-package-lists
+ (map cve-configuration->package-list configs)))))))
+
+(define (json->vulnerabilities json)
+ "Parse JSON, an input port or a string, and return the list of
+vulnerabilities found therein."
+ (filter-map cve-item->vulnerability (json->cve-items json)))
+
+(define (write-cache input cache)
+ "Read vulnerabilities as gzipped JSON from INPUT, and write it as a compact
+sexp to CACHE."
+ (call-with-decompressed-port 'gzip input
+ (lambda (input)
+ (define vulns
+ (json->vulnerabilities input))
+
+ (write `(vulnerabilities
+ 1 ;format version
+ ,(map vulnerability->sexp vulns))
+ cache))))
+
+(define (fetch-vulnerabilities year ttl)
+ "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has
+the given TTL (fetch from the NIST web site when TTL has expired)."
+ (define (cache-miss uri)
+ (format (current-error-port) "fetching CVE database for ~a...~%" year))
+
+ (define (read* port)
+ ;; Disable read options to avoid populating the source property weak
+ ;; table, which speeds things up, saves memory, and works around
+ ;; <https://lists.gnu.org/archive/html/guile-devel/2017-09/msg00031.html>.
+ (let ((options (read-options)))
+ (dynamic-wind
+ (lambda ()
+ (read-disable 'positions))
+ (lambda ()
+ (read port))
+ (lambda ()
+ (read-options options)))))
+
+ ;; Note: We used to keep the original JSON files in cache but parsing it
+ ;; would take typically ~15s for a year of data. Thus, we instead store a
+ ;; summarized version thereof as an sexp, which can be parsed in 1s or so.
+ (let* ((port (http-fetch/cached (yearly-feed-uri year)
+ #:ttl ttl
+ #:write-cache write-cache
+ #:cache-miss cache-miss))
+ (sexp (read* port)))
+ (close-port port)
+ (match sexp
+ (('vulnerabilities 1 vulns)
+ (map sexp->vulnerability vulns)))))
(define (current-vulnerabilities)
"Return the current list of Common Vulnerabilities and Exposures (CVE) as
published by the US NIST."
- (call-with-cve-port
- (lambda (port)
- ;; XXX: The SSAX "error port" is used to send pointless warnings such as
- ;; "warning: Skipping PI". Turn that off.
- (parameterize ((current-ssax-error-port (%make-void-port "w")))
- (xml->vulnerabilities port)))))
+ (let ((past-years (unfold (cut > <> 3)
+ (lambda (n)
+ (- %current-year n))
+ 1+
+ 1))
+ (past-ttls (unfold (cut > <> 3)
+ (lambda (n)
+ (* n %past-year-ttl))
+ 1+
+ 1)))
+ (append-map fetch-vulnerabilities
+ (cons %current-year past-years)
+ (cons %current-year-ttl past-ttls))))
(define (vulnerabilities->lookup-proc vulnerabilities)
"Return a lookup procedure built from VULNERABILITIES that takes a package
name and optionally a version number. When the version is omitted, the lookup
-procedure returns a list of version/vulnerability pairs; otherwise, it returns
-a list of vulnerabilities affection the given package version."
+procedure returns a list of vulnerabilities; otherwise, it returns a list of
+vulnerabilities affecting the given package version."
(define table
;; Map package names to lists of version/vulnerability pairs.
(fold (lambda (vuln table)
(($ <vulnerability> id packages)
(fold (lambda (package table)
(match package
- ((name . version)
- (vhash-cons name (cons version vuln)
+ ((name . versions)
+ (vhash-cons name (cons vuln versions)
table))))
table
packages))))
(vhash-fold* (if version
(lambda (pair result)
(match pair
- ((v . vuln)
- (if (string=? v version)
+ ((vuln sexp)
+ (if (version-matches? version sexp)
(cons vuln result)
result))))
- cons)
+ (lambda (pair result)
+ (match pair
+ ((vuln . _)
+ (cons vuln result)))))
'()
package table)))
+
;;; cve.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff