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 %cve-feed-uri
  53   (string->uri
  54    "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-Modified.xml.gz"))
  55
  56 (define %ttl
  57   ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
  58   ;; updated "approximately every two hours."
  59   (* 3600 3))
  60
  61 (define (call-with-cve-port proc)
  62   "Pass PROC an input port from which to read the CVE stream."
  63   (let ((port (http-fetch/cached %cve-feed-uri #:ttl %ttl)))
  64     (dynamic-wind
  65       (const #t)
  66       (lambda ()
  67         (call-with-decompressed-port 'gzip port
  68           proc))
  69       (lambda ()
  70         (close-port port)))))
  71
  72 (define %cpe-package-rx
  73   ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes
  74   ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
  75   (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)"))
  76
  77 (define (cpe->package-name cpe)
  78   "Converts the Common Platform Enumeration (CPE) string CPE to a package
  79 name, in a very naive way.  Return #f if CPE does not look like an application
  80 CPE string."
  81   (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
  82          (lambda (matches)
  83            (cons (match:substring matches 2)
  84                  (string-append (match:substring matches 3)
  85                                 (match (match:substring matches 4)
  86                                   ("" "")
  87                                   (patch-level
  88                                    ;; Drop the colon from things like
  89                                    ;; "cpe:/a:openbsd:openssh:6.8:p1".
  90                                    (string-drop patch-level 1))))))))
  91
  92 (define %parse-vulnerability-feed
  93   ;; Parse the XML vulnerability feed from
  94   ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
  95   ;; vulnerability objects.
  96   (ssax:make-parser NEW-LEVEL-SEED
  97                     (lambda (elem-gi attributes namespaces expected-content
  98                                      seed)
  99                       (match elem-gi
 100                         ((name-space . 'entry)
 101                          (cons (assoc-ref attributes 'id) seed))
 102                         ((name-space . 'vulnerable-software-list)
 103                          (cons '() seed))
 104                         ((name-space . 'product)
 105                          (cons 'product seed))
 106                         (x seed)))
 107
 108                     FINISH-ELEMENT
 109                     (lambda (elem-gi attributes namespaces parent-seed
 110                                      seed)
 111                       (match elem-gi
 112                         ((name-space . 'entry)
 113                          (match seed
 114                            (((? string? id) . rest)
 115                             ;; Some entries have no vulnerable-software-list.
 116                             rest)
 117                            ((products id . rest)
 118                             (match (filter-map cpe->package-name products)
 119                               (()
 120                                ;; No application among PRODUCTS.
 121                                rest)
 122                               (packages
 123                                (cons (vulnerability id (reverse packages))
 124                                      rest))))))
 125                         (x
 126                          seed)))
 127
 128                     CHAR-DATA-HANDLER
 129                     (lambda (str _ seed)
 130                       (match seed
 131                         (('product software-list . rest)
 132                          ;; Add STR to the vulnerable software list this
 133                          ;; <product> tag is part of.
 134                          (cons (cons str software-list) rest))
 135                         (x x)))))
 136
 137 (define (xml->vulnerabilities port)
 138   "Read from PORT an XML feed of vulnerabilities and return a list of
 139 vulnerability objects."
 140   (reverse (%parse-vulnerability-feed port '())))
 141
 142 (define (current-vulnerabilities)
 143   "Return the current list of Common Vulnerabilities and Exposures (CVE) as
 144 published by the US NIST."
 145   (call-with-cve-port
 146    (lambda (port)
 147      ;; XXX: The SSAX "error port" is used to send pointless warnings such as
 148      ;; "warning: Skipping PI".  Turn that off.
 149      (parameterize ((current-ssax-error-port (%make-void-port "w")))
 150        (xml->vulnerabilities port)))))
 151
 152 (define (vulnerabilities->lookup-proc vulnerabilities)
 153   "Return a lookup procedure built from VULNERABILITIES that takes a package
 154 name and optionally a version number.  When the version is omitted, the lookup
 155 procedure returns a list of version/vulnerability pairs; otherwise, it returns
 156 a list of vulnerabilities affection the given package version."
 157   (define table
 158     ;; Map package names to lists of version/vulnerability pairs.
 159     (fold (lambda (vuln table)
 160             (match vuln
 161               (($ <vulnerability> id packages)
 162                (fold (lambda (package table)
 163                        (match package
 164                          ((name . version)
 165                           (vhash-cons name (cons version vuln)
 166                                       table))))
 167                      table
 168                      packages))))
 169           vlist-null
 170           vulnerabilities))
 171
 172   (lambda* (package #:optional version)
 173     (vhash-fold* (if version
 174                      (lambda (pair result)
 175                        (match pair
 176                          ((v . vuln)
 177                           (if (string=? v version)
 178                               (cons vuln result)
 179                               result))))
 180                      cons)
 181                  '()
 182                  package table)))
 183
 184 ;;; cve.scm ends here