| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; |
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU General Public License |
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | (define-module (guix cve) |
| 20 | #:use-module (guix utils) |
| 21 | #:use-module (guix http-client) |
| 22 | #:use-module (guix i18n) |
| 23 | #:use-module ((guix diagnostics) #:select (formatted-message)) |
| 24 | #:use-module (json) |
| 25 | #:use-module (web uri) |
| 26 | #:use-module (srfi srfi-1) |
| 27 | #:use-module (srfi srfi-9) |
| 28 | #:use-module (srfi srfi-11) |
| 29 | #:use-module (srfi srfi-19) |
| 30 | #:use-module (srfi srfi-26) |
| 31 | #:use-module (srfi srfi-34) |
| 32 | #:use-module (srfi srfi-35) |
| 33 | #:use-module (ice-9 match) |
| 34 | #:use-module (ice-9 regex) |
| 35 | #:use-module (ice-9 vlist) |
| 36 | #:export (json->cve-items |
| 37 | |
| 38 | cve-item? |
| 39 | cve-item-cve |
| 40 | cve-item-configurations |
| 41 | cve-item-published-date |
| 42 | cve-item-last-modified-date |
| 43 | |
| 44 | cve? |
| 45 | cve-id |
| 46 | cve-data-type |
| 47 | cve-data-format |
| 48 | cve-references |
| 49 | |
| 50 | cve-reference? |
| 51 | cve-reference-url |
| 52 | cve-reference-tags |
| 53 | |
| 54 | vulnerability? |
| 55 | vulnerability-id |
| 56 | vulnerability-packages |
| 57 | |
| 58 | json->vulnerabilities |
| 59 | current-vulnerabilities |
| 60 | vulnerabilities->lookup-proc)) |
| 61 | |
| 62 | ;;; Commentary: |
| 63 | ;;; |
| 64 | ;;; This modules provides the tools to fetch, parse, and digest part of the |
| 65 | ;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST |
| 66 | ;;; at <https://nvd.nist.gov/vuln/data-feeds>. |
| 67 | ;;; |
| 68 | ;;; Code: |
| 69 | |
| 70 | (define (string->date* str) |
| 71 | (string->date str "~Y-~m-~dT~H:~M~z")) |
| 72 | |
| 73 | (define-json-mapping <cve-item> cve-item cve-item? |
| 74 | json->cve-item |
| 75 | (cve cve-item-cve "cve" json->cve) ;<cve> |
| 76 | (configurations cve-item-configurations ;list of sexps |
| 77 | "configurations" configuration-data->cve-configurations) |
| 78 | (published-date cve-item-published-date |
| 79 | "publishedDate" string->date*) |
| 80 | (last-modified-date cve-item-last-modified-date |
| 81 | "lastModifiedDate" string->date*)) |
| 82 | |
| 83 | (define-json-mapping <cve> cve cve? |
| 84 | json->cve |
| 85 | (id cve-id "CVE_data_meta" ;string |
| 86 | (cut assoc-ref <> "ID")) |
| 87 | (data-type cve-data-type ;'CVE |
| 88 | "data_type" string->symbol) |
| 89 | (data-format cve-data-format ;'MITRE |
| 90 | "data_format" string->symbol) |
| 91 | (references cve-references ;list of <cve-reference> |
| 92 | "references" reference-data->cve-references)) |
| 93 | |
| 94 | (define-json-mapping <cve-reference> cve-reference cve-reference? |
| 95 | json->cve-reference |
| 96 | (url cve-reference-url) ;string |
| 97 | (tags cve-reference-tags ;list of strings |
| 98 | "tags" vector->list)) |
| 99 | |
| 100 | (define (reference-data->cve-references alist) |
| 101 | (map json->cve-reference |
| 102 | (vector->list (assoc-ref alist "reference_data")))) |
| 103 | |
| 104 | (define %cpe-package-rx |
| 105 | ;; For applications: "cpe:2.3:a:VENDOR:PACKAGE:VERSION", or sometimes |
| 106 | ;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". |
| 107 | (make-regexp "^cpe:2\\.3:a:([^:]+):([^:]+):([^:]+):([^:]+):")) |
| 108 | |
| 109 | (define (cpe->package-name cpe) |
| 110 | "Converts the Common Platform Enumeration (CPE) string CPE to a package |
| 111 | name, in a very naive way. Return two values: the package name, and its |
| 112 | version string. Return #f and #f if CPE does not look like an application CPE |
| 113 | string." |
| 114 | (cond ((regexp-exec %cpe-package-rx cpe) |
| 115 | => |
| 116 | (lambda (matches) |
| 117 | (values (match:substring matches 2) |
| 118 | (match (match:substring matches 3) |
| 119 | ("*" '_) |
| 120 | (version |
| 121 | (string-append version |
| 122 | (match (match:substring matches 4) |
| 123 | ("" "") |
| 124 | (patch-level |
| 125 | ;; Drop the colon from things like |
| 126 | ;; "cpe:2.3:a:openbsd:openssh:6.8:p1". |
| 127 | (string-drop patch-level 1))))))))) |
| 128 | (else |
| 129 | (values #f #f)))) |
| 130 | |
| 131 | (define (cpe-match->cve-configuration alist) |
| 132 | "Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package |
| 133 | and versions matched. Return #f if ALIST doesn't correspond to an application |
| 134 | package." |
| 135 | (let ((cpe (assoc-ref alist "cpe23Uri")) |
| 136 | (starti (assoc-ref alist "versionStartIncluding")) |
| 137 | (starte (assoc-ref alist "versionStartExcluding")) |
| 138 | (endi (assoc-ref alist "versionEndIncluding")) |
| 139 | (ende (assoc-ref alist "versionEndExcluding"))) |
| 140 | (let-values (((package version) (cpe->package-name cpe))) |
| 141 | (and package |
| 142 | `(,package |
| 143 | ,(cond ((and (or starti starte) (or endi ende)) |
| 144 | `(and ,(if starti `(>= ,starti) `(> ,starte)) |
| 145 | ,(if endi `(<= ,endi) `(< ,ende)))) |
| 146 | (starti `(>= ,starti)) |
| 147 | (starte `(> ,starte)) |
| 148 | (endi `(<= ,endi)) |
| 149 | (ende `(< ,ende)) |
| 150 | (else version))))))) |
| 151 | |
| 152 | (define (configuration-data->cve-configurations alist) |
| 153 | "Given ALIST, a JSON dictionary for the baroque \"configurations\" |
| 154 | element found in CVEs, return an sexp such as (\"binutils\" (< |
| 155 | \"2.31\")) that represents matching configurations." |
| 156 | (define string->operator |
| 157 | (match-lambda |
| 158 | ("OR" 'or) |
| 159 | ("AND" 'and))) |
| 160 | |
| 161 | (define (node->configuration node) |
| 162 | (let ((operator (string->operator (assoc-ref node "operator")))) |
| 163 | (cond |
| 164 | ((assoc-ref node "cpe_match") |
| 165 | => |
| 166 | (lambda (matches) |
| 167 | (let ((matches (vector->list matches))) |
| 168 | (match (filter-map cpe-match->cve-configuration |
| 169 | matches) |
| 170 | (() #f) |
| 171 | ((one) one) |
| 172 | (lst (cons operator lst)))))) |
| 173 | ((assoc-ref node "children") ;typically for 'and' |
| 174 | => |
| 175 | (lambda (children) |
| 176 | (match (filter-map node->configuration (vector->list children)) |
| 177 | (() #f) |
| 178 | ((one) one) |
| 179 | (lst (cons operator lst))))) |
| 180 | (else |
| 181 | #f)))) |
| 182 | |
| 183 | (let ((nodes (vector->list (assoc-ref alist "nodes")))) |
| 184 | (filter-map node->configuration nodes))) |
| 185 | |
| 186 | (define (json->cve-items json) |
| 187 | "Parse JSON, an input port or a string, and return a list of <cve-item> |
| 188 | records." |
| 189 | (let* ((alist (json->scm json)) |
| 190 | (type (assoc-ref alist "CVE_data_type")) |
| 191 | (format (assoc-ref alist "CVE_data_format")) |
| 192 | (version (assoc-ref alist "CVE_data_version"))) |
| 193 | (unless (equal? type "CVE") |
| 194 | (raise (condition (&message |
| 195 | (message "invalid CVE feed"))))) |
| 196 | (unless (equal? format "MITRE") |
| 197 | (raise (formatted-message (G_ "unsupported CVE format: '~a'") |
| 198 | format))) |
| 199 | (unless (equal? version "4.0") |
| 200 | (raise (formatted-message (G_ "unsupported CVE data version: '~a'") |
| 201 | version))) |
| 202 | |
| 203 | (map json->cve-item |
| 204 | (vector->list (assoc-ref alist "CVE_Items"))))) |
| 205 | |
| 206 | (define (version-matches? version sexp) |
| 207 | "Return true if VERSION, a string, matches SEXP." |
| 208 | (match sexp |
| 209 | ('_ |
| 210 | #t) |
| 211 | ((? string? expected) |
| 212 | (version-prefix? expected version)) |
| 213 | (('or sexps ...) |
| 214 | (any (cut version-matches? version <>) sexps)) |
| 215 | (('and sexps ...) |
| 216 | (every (cut version-matches? version <>) sexps)) |
| 217 | (('< max) |
| 218 | (version>? max version)) |
| 219 | (('<= max) |
| 220 | (version>=? max version)) |
| 221 | (('> min) |
| 222 | (version>? version min)) |
| 223 | (('>= min) |
| 224 | (version>=? version min)))) |
| 225 | |
| 226 | \f |
| 227 | ;;; |
| 228 | ;;; High-level interface. |
| 229 | ;;; |
| 230 | |
| 231 | (define %now |
| 232 | (current-date)) |
| 233 | (define %current-year |
| 234 | (date-year %now)) |
| 235 | (define %past-year |
| 236 | (- %current-year 1)) |
| 237 | |
| 238 | (define (yearly-feed-uri year) |
| 239 | "Return the URI for the CVE feed for YEAR." |
| 240 | (string->uri |
| 241 | (string-append "https://nvd.nist.gov/feeds/json/cve/1.1/nvdcve-1.1-" |
| 242 | (number->string year) ".json.gz"))) |
| 243 | |
| 244 | (define %current-year-ttl |
| 245 | ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are |
| 246 | ;; updated "approximately every two hours." |
| 247 | (* 60 30)) |
| 248 | |
| 249 | (define %past-year-ttl |
| 250 | ;; Update the previous year's database more and more infrequently. |
| 251 | (* 3600 24 (date-month %now))) |
| 252 | |
| 253 | (define-record-type <vulnerability> |
| 254 | (vulnerability id packages) |
| 255 | vulnerability? |
| 256 | (id vulnerability-id) ;string |
| 257 | (packages vulnerability-packages)) ;((p1 sexp1) (p2 sexp2) ...) |
| 258 | |
| 259 | (define vulnerability->sexp |
| 260 | (match-lambda |
| 261 | (($ <vulnerability> id packages) |
| 262 | `(v ,id ,packages)))) |
| 263 | |
| 264 | (define sexp->vulnerability |
| 265 | (match-lambda |
| 266 | (('v id (packages ...)) |
| 267 | (vulnerability id packages)))) |
| 268 | |
| 269 | (define (cve-configuration->package-list config) |
| 270 | "Parse CONFIG, a config sexp, and return a list of the form (P SEXP) |
| 271 | where P is a package name and SEXP expresses constraints on the matching |
| 272 | versions." |
| 273 | (let loop ((config config) |
| 274 | (packages '())) |
| 275 | (match config |
| 276 | (('or configs ...) |
| 277 | (fold loop packages configs)) |
| 278 | (('and config _ ...) ;XXX |
| 279 | (loop config packages)) |
| 280 | (((? string? package) '_) ;any version |
| 281 | (cons `(,package _) |
| 282 | (alist-delete package packages))) |
| 283 | (((? string? package) sexp) |
| 284 | (let ((previous (assoc-ref packages package))) |
| 285 | (if previous |
| 286 | (cons `(,package (or ,sexp ,@previous)) |
| 287 | (alist-delete package packages)) |
| 288 | (cons `(,package ,sexp) packages))))))) |
| 289 | |
| 290 | (define (merge-package-lists lst) |
| 291 | "Merge the list in LST, each of which has the form (p sexp), where P |
| 292 | is the name of a package and SEXP is an sexp that constrains matching |
| 293 | versions." |
| 294 | (fold (lambda (plist result) ;XXX: quadratic |
| 295 | (fold (match-lambda* |
| 296 | (((package version) result) |
| 297 | (match (assoc-ref result package) |
| 298 | (#f |
| 299 | (cons `(,package ,version) result)) |
| 300 | ((previous) |
| 301 | (cons `(,package (or ,version ,previous)) |
| 302 | (alist-delete package result)))))) |
| 303 | result |
| 304 | plist)) |
| 305 | '() |
| 306 | lst)) |
| 307 | |
| 308 | (define (cve-item->vulnerability item) |
| 309 | "Return a <vulnerability> corresponding to ITEM, a <cve-item> record; |
| 310 | return #f if ITEM does not list any configuration or if it does not list |
| 311 | any \"a\" (application) configuration." |
| 312 | (let ((id (cve-id (cve-item-cve item)))) |
| 313 | (match (cve-item-configurations item) |
| 314 | (() ;no configurations |
| 315 | #f) |
| 316 | ((configs ...) |
| 317 | (vulnerability id |
| 318 | (merge-package-lists |
| 319 | (map cve-configuration->package-list configs))))))) |
| 320 | |
| 321 | (define (json->vulnerabilities json) |
| 322 | "Parse JSON, an input port or a string, and return the list of |
| 323 | vulnerabilities found therein." |
| 324 | (filter-map cve-item->vulnerability (json->cve-items json))) |
| 325 | |
| 326 | (define (write-cache input cache) |
| 327 | "Read vulnerabilities as gzipped JSON from INPUT, and write it as a compact |
| 328 | sexp to CACHE." |
| 329 | (call-with-decompressed-port 'gzip input |
| 330 | (lambda (input) |
| 331 | (define vulns |
| 332 | (json->vulnerabilities input)) |
| 333 | |
| 334 | (write `(vulnerabilities |
| 335 | 1 ;format version |
| 336 | ,(map vulnerability->sexp vulns)) |
| 337 | cache)))) |
| 338 | |
| 339 | (define (fetch-vulnerabilities year ttl) |
| 340 | "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has |
| 341 | the given TTL (fetch from the NIST web site when TTL has expired)." |
| 342 | (define (cache-miss uri) |
| 343 | (format (current-error-port) "fetching CVE database for ~a...~%" year)) |
| 344 | |
| 345 | (define (read* port) |
| 346 | ;; Disable read options to avoid populating the source property weak |
| 347 | ;; table, which speeds things up, saves memory, and works around |
| 348 | ;; <https://lists.gnu.org/archive/html/guile-devel/2017-09/msg00031.html>. |
| 349 | (let ((options (read-options))) |
| 350 | (dynamic-wind |
| 351 | (lambda () |
| 352 | (read-disable 'positions)) |
| 353 | (lambda () |
| 354 | (read port)) |
| 355 | (lambda () |
| 356 | (read-options options))))) |
| 357 | |
| 358 | ;; Note: We used to keep the original JSON files in cache but parsing it |
| 359 | ;; would take typically ~15s for a year of data. Thus, we instead store a |
| 360 | ;; summarized version thereof as an sexp, which can be parsed in 1s or so. |
| 361 | (let* ((port (http-fetch/cached (yearly-feed-uri year) |
| 362 | #:ttl ttl |
| 363 | #:write-cache write-cache |
| 364 | #:cache-miss cache-miss)) |
| 365 | (sexp (read* port))) |
| 366 | (close-port port) |
| 367 | (match sexp |
| 368 | (('vulnerabilities 1 vulns) |
| 369 | (map sexp->vulnerability vulns))))) |
| 370 | |
| 371 | (define (current-vulnerabilities) |
| 372 | "Return the current list of Common Vulnerabilities and Exposures (CVE) as |
| 373 | published by the US NIST." |
| 374 | (let ((past-years (unfold (cut > <> 3) |
| 375 | (lambda (n) |
| 376 | (- %current-year n)) |
| 377 | 1+ |
| 378 | 1)) |
| 379 | (past-ttls (unfold (cut > <> 3) |
| 380 | (lambda (n) |
| 381 | (* n %past-year-ttl)) |
| 382 | 1+ |
| 383 | 1))) |
| 384 | (append-map fetch-vulnerabilities |
| 385 | (cons %current-year past-years) |
| 386 | (cons %current-year-ttl past-ttls)))) |
| 387 | |
| 388 | (define (vulnerabilities->lookup-proc vulnerabilities) |
| 389 | "Return a lookup procedure built from VULNERABILITIES that takes a package |
| 390 | name and optionally a version number. When the version is omitted, the lookup |
| 391 | procedure returns a list of vulnerabilities; otherwise, it returns a list of |
| 392 | vulnerabilities affecting the given package version." |
| 393 | (define table |
| 394 | ;; Map package names to lists of version/vulnerability pairs. |
| 395 | (fold (lambda (vuln table) |
| 396 | (match vuln |
| 397 | (($ <vulnerability> id packages) |
| 398 | (fold (lambda (package table) |
| 399 | (match package |
| 400 | ((name . versions) |
| 401 | (vhash-cons name (cons vuln versions) |
| 402 | table)))) |
| 403 | table |
| 404 | packages)))) |
| 405 | vlist-null |
| 406 | vulnerabilities)) |
| 407 | |
| 408 | (lambda* (package #:optional version) |
| 409 | (vhash-fold* (if version |
| 410 | (lambda (pair result) |
| 411 | (match pair |
| 412 | ((vuln sexp) |
| 413 | (if (version-matches? version sexp) |
| 414 | (cons vuln result) |
| 415 | result)))) |
| 416 | (lambda (pair result) |
| 417 | (match pair |
| 418 | ((vuln . _) |
| 419 | (cons vuln result))))) |
| 420 | '() |
| 421 | package table))) |
| 422 | |
| 423 | |
| 424 | ;;; cve.scm ends here |