[jackhill/guix/guix.git] / guix / cve.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix cve)
  #:use-module (guix utils)
  #:use-module (guix http-client)
  #:use-module (sxml ssax)
  #:use-module (web uri)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-19)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 vlist)
  #:export (vulnerability?
            vulnerability-id
            vulnerability-packages

            xml->vulnerabilities
            current-vulnerabilities
            vulnerabilities->lookup-proc))

;;; Commentary:
;;;
;;; This modules provides the tools to fetch, parse, and digest part of the
;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST
;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>.
;;;
;;; Code:

(define-record-type <vulnerability>
  (vulnerability id packages)
  vulnerability?
  (id         vulnerability-id)
  (packages   vulnerability-packages))

(define %cve-feed-uri
  (string->uri
   "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-Modified.xml.gz"))

(define %ttl
  ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
  ;; updated "approximately every two hours."
  (* 3600 3))

(define (call-with-cve-port proc)
  "Pass PROC an input port from which to read the CVE stream."
  (let ((port (http-fetch/cached %cve-feed-uri #:ttl %ttl)))
    (dynamic-wind
      (const #t)
      (lambda ()
        (call-with-decompressed-port 'gzip port
          proc))
      (lambda ()
        (close-port port)))))

(define %cpe-package-rx
  ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION".
  (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)"))

(define (cpe->package-name cpe)
  "Converts the Common Platform Enumeration (CPE) string CPE to a package
name, in a very naive way.  Return #f if CPE does not look like an application
CPE string."
  (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
         (lambda (matches)
           (cons (match:substring matches 2)
                 (match:substring matches 3)))))

(define %parse-vulnerability-feed
  ;; Parse the XML vulnerability feed from
  ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
  ;; vulnerability objects.
  (ssax:make-parser NEW-LEVEL-SEED
                    (lambda (elem-gi attributes namespaces expected-content
                                     seed)
                      (match elem-gi
                        ((name-space . 'entry)
                         (cons (assoc-ref attributes 'id) seed))
                        ((name-space . 'vulnerable-software-list)
                         (cons '() seed))
                        ((name-space . 'product)
                         (cons 'product seed))
                        (x seed)))

                    FINISH-ELEMENT
                    (lambda (elem-gi attributes namespaces parent-seed
                                     seed)
                      (match elem-gi
                        ((name-space . 'entry)
                         (match seed
                           (((? string? id) . rest)
                            ;; Some entries have no vulnerable-software-list.
                            rest)
                           ((products id . rest)
                            (match (filter-map cpe->package-name products)
                              (()
                               ;; No application among PRODUCTS.
                               rest)
                              (packages
                               (cons (vulnerability id (reverse packages))
                                     rest))))))
                        (x
                         seed)))

                    CHAR-DATA-HANDLER
                    (lambda (str _ seed)
                      (match seed
                        (('product software-list . rest)
                         ;; Add STR to the vulnerable software list this
                         ;; <product> tag is part of.
                         (cons (cons str software-list) rest))
                        (x x)))))

(define (xml->vulnerabilities port)
  "Read from PORT an XML feed of vulnerabilities and return a list of
vulnerability objects."
  (reverse (%parse-vulnerability-feed port '())))

(define (current-vulnerabilities)
  "Return the current list of Common Vulnerabilities and Exposures (CVE) as
published by the US NIST."
  (call-with-cve-port
   (lambda (port)
     ;; XXX: The SSAX "error port" is used to send pointless warnings such as
     ;; "warning: Skipping PI".  Turn that off.
     (parameterize ((current-ssax-error-port (%make-void-port "w")))
       (xml->vulnerabilities port)))))

(define (vulnerabilities->lookup-proc vulnerabilities)
  "Return a lookup procedure built from VULNERABILITIES that takes a package
name and optionally a version number.  When the version is omitted, the lookup
procedure returns a list of version/vulnerability pairs; otherwise, it returns
a list of vulnerabilities affection the given package version."
  (define table
    ;; Map package names to lists of version/vulnerability pairs.
    (fold (lambda (vuln table)
            (match vuln
              (($ <vulnerability> id packages)
               (fold (lambda (package table)
                       (match package
                         ((name . version)
                          (vhash-cons name (cons version vuln)
                                      table))))
                     table
                     packages))))
          vlist-null
          vulnerabilities))

  (lambda* (package #:optional version)
    (vhash-fold* (if version
                     (lambda (pair result)
                       (match pair
                         ((v . vuln)
                          (if (string=? v version)
                              (cons vuln result)
                              result))))
                     cons)
                 '()
                 package table)))

;;; cve.scm ends here
Commit	Line	Data
0eef7551 LC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2015 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".
74	(make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)"))
75
76	(define (cpe->package-name cpe)
77	"Converts the Common Platform Enumeration (CPE) string CPE to a package
78	name, in a very naive way. Return #f if CPE does not look like an application
79	CPE string."
80	(and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
81	(lambda (matches)
82	(cons (match:substring matches 2)
83	(match:substring matches 3)))))
84
85	(define %parse-vulnerability-feed
86	;; Parse the XML vulnerability feed from
87	;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of
88	;; vulnerability objects.
89	(ssax:make-parser NEW-LEVEL-SEED
90	(lambda (elem-gi attributes namespaces expected-content
91	seed)
92	(match elem-gi
93	((name-space . 'entry)
94	(cons (assoc-ref attributes 'id) seed))
95	((name-space . 'vulnerable-software-list)
96	(cons '() seed))
97	((name-space . 'product)
98	(cons 'product seed))
99	(x seed)))
100
101	FINISH-ELEMENT
102	(lambda (elem-gi attributes namespaces parent-seed
103	seed)
104	(match elem-gi
105	((name-space . 'entry)
106	(match seed
107	(((? string? id) . rest)
108	;; Some entries have no vulnerable-software-list.
109	rest)
110	((products id . rest)
111	(match (filter-map cpe->package-name products)
112	(()
113	;; No application among PRODUCTS.
114	rest)
115	(packages
116	(cons (vulnerability id (reverse packages))
117	rest))))))
118	(x
119	seed)))
120
121	CHAR-DATA-HANDLER
122	(lambda (str _ seed)
123	(match seed
124	(('product software-list . rest)
125	;; Add STR to the vulnerable software list this
126	;; <product> tag is part of.
127	(cons (cons str software-list) rest))
128	(x x)))))
129
130	(define (xml->vulnerabilities port)
131	"Read from PORT an XML feed of vulnerabilities and return a list of
132	vulnerability objects."
133	(reverse (%parse-vulnerability-feed port '())))
134
135	(define (current-vulnerabilities)
136	"Return the current list of Common Vulnerabilities and Exposures (CVE) as
137	published by the US NIST."
138	(call-with-cve-port
139	(lambda (port)
140	;; XXX: The SSAX "error port" is used to send pointless warnings such as
141	;; "warning: Skipping PI". Turn that off.
142	(parameterize ((current-ssax-error-port (%make-void-port "w")))
143	(xml->vulnerabilities port)))))
144
145	(define (vulnerabilities->lookup-proc vulnerabilities)
146	"Return a lookup procedure built from VULNERABILITIES that takes a package
147	name and optionally a version number. When the version is omitted, the lookup
148	procedure returns a list of version/vulnerability pairs; otherwise, it returns
149	a list of vulnerabilities affection the given package version."
150	(define table
151	;; Map package names to lists of version/vulnerability pairs.
152	(fold (lambda (vuln table)
153	(match vuln
154	(($ <vulnerability> id packages)
155	(fold (lambda (package table)
156	(match package
157	((name . version)
158	(vhash-cons name (cons version vuln)
159	table))))
160	table
161	packages))))
162	vlist-null
163	vulnerabilities))
164
165	(lambda* (package #:optional version)
166	(vhash-fold* (if version
167	(lambda (pair result)
168	(match pair
169	((v . vuln)
170	(if (string=? v version)
171	(cons vuln result)
172	result))))
173	cons)
174	'()
175	package table)))
176
177	;;; cve.scm ends here