Commit | Line | Data |
---|---|---|
0eef7551 | 1 | ;;; GNU Guix --- Functional package management for GNU |
cf557afa | 2 | ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
0eef7551 LC |
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 | |
cf557afa LC |
73 | ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes |
74 | ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". | |
75 | (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)")) | |
0eef7551 LC |
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) | |
cf557afa LC |
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)))))))) | |
0eef7551 LC |
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 |