guix/cve.scm

   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