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