guix/cve.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015, 2016 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 (sxml ssax)
  23   #:use-module (web uri)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (srfi srfi-9)
  26   #:use-module (srfi srfi-19)
  27   #:use-module (ice-9 match)
  28   #:use-module (ice-9 regex)
  29   #:use-module (ice-9 vlist)
  30   #:export (vulnerability?
  31             vulnerability-id
  32             vulnerability-packages
  33
  34             xml->vulnerabilities
  35             current-vulnerabilities
  36             vulnerabilities->lookup-proc))
  37
  38 ;;; Commentary:
  39 ;;;
  40 ;;; This modules provides the tools to fetch, parse, and digest part of the
  41 ;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST
  42 ;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>.
  43 ;;;
  44 ;;; Code:
  45
  46 (define-record-type <vulnerability>
  47   (vulnerability id packages)
  48   vulnerability?
  49   (id         vulnerability-id)
  50   (packages   vulnerability-packages))
  51
  52 (define %now
  53   (current-date))
  54 (define %current-year
  55   (date-year %now))
  56 (define %past-year
  57   (- %current-year 1))
  58
  59 (define (yearly-feed-uri year)
  60   "Return the URI for the CVE feed for YEAR."
  61   (string->uri
  62    (string-append "https://static.nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-"
  63                   (number->string year) ".xml.gz")))
  64
  65 (define %current-year-ttl
  66   ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
  67   ;; updated "approximately every two hours."
  68   (* 3600 3))
  69
  70 (define %past-year-ttl
  71   ;; Update the previous year's database more and more infrequently.
  72   (* 3600 24 2 (date-month %now)))
  73
  74 (define (call-with-cve-port uri ttl proc)
  75   "Pass PROC an input port from which to read the CVE stream."
  76   (let ((port (http-fetch/cached uri #:ttl ttl)))
  77     (dynamic-wind
  78       (const #t)
  79       (lambda ()
  80         (call-with-decompressed-port 'gzip port
  81           (lambda (port)
  82             (setvbuf port _IOFBF 65536)
  83             (proc port))))
  84       (lambda ()
  85         (close-port port)))))
  86
  87 (define %cpe-package-rx
  88   ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes
  89   ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
  90   (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)"))
  91
  92 (define (cpe->package-name cpe)
  93   "Converts the Common Platform Enumeration (CPE) string CPE to a package
  94 name, in a very naive way.  Return #f if CPE does not look like an application
  95 CPE string."
  96   (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
  97          (lambda (matches)
  98            (cons (match:substring matches 2)
  99                  (string-append (match:substring matches 3)
 100                                 (match (match:substring matches 4)
 101                                   ("" "")
 102                                   (patch-level
 103                                    ;; Drop the colon from things like
 104                                    ;; "cpe:/a:openbsd:openssh:6.8:p1".
 105                                    (string-drop patch-level 1))))))))
 106
 107 (define %parse-vulnerability-feed
 108   ;; Parse the XML vulnerability feed from
 109   ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
 110   ;; vulnerability objects.
 111   (ssax:make-parser NEW-LEVEL-SEED
 112                     (lambda (elem-gi attributes namespaces expected-content
 113                                      seed)
 114                       (match elem-gi
 115                         ((name-space . 'entry)
 116                          (cons (assoc-ref attributes 'id) seed))
 117                         ((name-space . 'vulnerable-software-list)
 118                          (cons '() seed))
 119                         ((name-space . 'product)
 120                          (cons 'product seed))
 121                         (x seed)))
 122
 123                     FINISH-ELEMENT
 124                     (lambda (elem-gi attributes namespaces parent-seed
 125                                      seed)
 126                       (match elem-gi
 127                         ((name-space . 'entry)
 128                          (match seed
 129                            (((? string? id) . rest)
 130                             ;; Some entries have no vulnerable-software-list.
 131                             rest)
 132                            ((products id . rest)
 133                             (match (filter-map cpe->package-name products)
 134                               (()
 135                                ;; No application among PRODUCTS.
 136                                rest)
 137                               (packages
 138                                (cons (vulnerability id (reverse packages))
 139                                      rest))))))
 140                         (x
 141                          seed)))
 142
 143                     CHAR-DATA-HANDLER
 144                     (lambda (str _ seed)
 145                       (match seed
 146                         (('product software-list . rest)
 147                          ;; Add STR to the vulnerable software list this
 148                          ;; <product> tag is part of.
 149                          (cons (cons str software-list) rest))
 150                         (x x)))))
 151
 152 (define (xml->vulnerabilities port)
 153   "Read from PORT an XML feed of vulnerabilities and return a list of
 154 vulnerability objects."
 155   (reverse (%parse-vulnerability-feed port '())))
 156
 157 (define (current-vulnerabilities)
 158   "Return the current list of Common Vulnerabilities and Exposures (CVE) as
 159 published by the US NIST."
 160   (define (read-vulnerabilities uri ttl)
 161     (call-with-cve-port uri ttl
 162       (lambda (port)
 163         ;; XXX: The SSAX "error port" is used to send pointless warnings such as
 164         ;; "warning: Skipping PI".  Turn that off.
 165         (parameterize ((current-ssax-error-port (%make-void-port "w")))
 166           (xml->vulnerabilities port)))))
 167
 168   (append-map read-vulnerabilities
 169               (list (yearly-feed-uri %past-year)
 170                     (yearly-feed-uri %current-year))
 171               (list %past-year-ttl
 172                     %current-year-ttl)))
 173
 174 (define (vulnerabilities->lookup-proc vulnerabilities)
 175   "Return a lookup procedure built from VULNERABILITIES that takes a package
 176 name and optionally a version number.  When the version is omitted, the lookup
 177 procedure returns a list of version/vulnerability pairs; otherwise, it returns
 178 a list of vulnerabilities affection the given package version."
 179   (define table
 180     ;; Map package names to lists of version/vulnerability pairs.
 181     (fold (lambda (vuln table)
 182             (match vuln
 183               (($ <vulnerability> id packages)
 184                (fold (lambda (package table)
 185                        (match package
 186                          ((name . version)
 187                           (vhash-cons name (cons version vuln)
 188                                       table))))
 189                      table
 190                      packages))))
 191           vlist-null
 192           vulnerabilities))
 193
 194   (lambda* (package #:optional version)
 195     (vhash-fold* (if version
 196                      (lambda (pair result)
 197                        (match pair
 198                          ((v . vuln)
 199                           (if (string=? v version)
 200                               (cons vuln result)
 201                               result))))
 202                      cons)
 203                  '()
 204                  package table)))
 205
 206
 207 ;;; Local Variables:
 208 ;;; eval: (put 'call-with-cve-port 'scheme-indent-function 2)
 209 ;;; End:
 210
 211 ;;; cve.scm ends here