Commit | Line | Data |
---|---|---|
0eef7551 | 1 | ;;; GNU Guix --- Functional package management for GNU |
8a928aa7 | 2 | ;;; Copyright © 2015, 2016, 2017, 2018 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) | |
870bf71e | 26 | #:use-module (srfi srfi-11) |
0eef7551 | 27 | #:use-module (srfi srfi-19) |
3af7a7a8 | 28 | #:use-module (srfi srfi-26) |
0eef7551 LC |
29 | #:use-module (ice-9 match) |
30 | #:use-module (ice-9 regex) | |
31 | #:use-module (ice-9 vlist) | |
32 | #:export (vulnerability? | |
33 | vulnerability-id | |
34 | vulnerability-packages | |
35 | ||
36 | xml->vulnerabilities | |
37 | current-vulnerabilities | |
38 | vulnerabilities->lookup-proc)) | |
39 | ||
40 | ;;; Commentary: | |
41 | ;;; | |
42 | ;;; This modules provides the tools to fetch, parse, and digest part of the | |
43 | ;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST | |
44 | ;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>. | |
45 | ;;; | |
46 | ;;; Code: | |
47 | ||
48 | (define-record-type <vulnerability> | |
49 | (vulnerability id packages) | |
50 | vulnerability? | |
870bf71e LC |
51 | (id vulnerability-id) ;string |
52 | (packages vulnerability-packages)) ;((p1 v1 v2 v3) (p2 v1) ...) | |
0eef7551 | 53 | |
6a25e595 LC |
54 | (define %now |
55 | (current-date)) | |
56 | (define %current-year | |
57 | (date-year %now)) | |
58 | (define %past-year | |
59 | (- %current-year 1)) | |
60 | ||
61 | (define (yearly-feed-uri year) | |
62 | "Return the URI for the CVE feed for YEAR." | |
0eef7551 | 63 | (string->uri |
8a928aa7 | 64 | (string-append "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-" |
6a25e595 | 65 | (number->string year) ".xml.gz"))) |
0eef7551 | 66 | |
6a25e595 | 67 | (define %current-year-ttl |
0eef7551 LC |
68 | ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are |
69 | ;; updated "approximately every two hours." | |
7482b981 | 70 | (* 60 30)) |
0eef7551 | 71 | |
6a25e595 LC |
72 | (define %past-year-ttl |
73 | ;; Update the previous year's database more and more infrequently. | |
7482b981 | 74 | (* 3600 24 (date-month %now))) |
0eef7551 LC |
75 | |
76 | (define %cpe-package-rx | |
cf557afa LC |
77 | ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes |
78 | ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". | |
79 | (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)")) | |
0eef7551 LC |
80 | |
81 | (define (cpe->package-name cpe) | |
82 | "Converts the Common Platform Enumeration (CPE) string CPE to a package | |
870bf71e LC |
83 | name, in a very naive way. Return two values: the package name, and its |
84 | version string. Return #f and #f if CPE does not look like an application CPE | |
85 | string." | |
86 | (cond ((regexp-exec %cpe-package-rx (string-trim-both cpe)) | |
87 | => | |
0eef7551 | 88 | (lambda (matches) |
870bf71e LC |
89 | (values (match:substring matches 2) |
90 | (string-append (match:substring matches 3) | |
91 | (match (match:substring matches 4) | |
92 | ("" "") | |
93 | (patch-level | |
94 | ;; Drop the colon from things like | |
95 | ;; "cpe:/a:openbsd:openssh:6.8:p1". | |
96 | (string-drop patch-level 1))))))) | |
97 | (else | |
98 | (values #f #f)))) | |
99 | ||
100 | (define (cpe->product-alist products) | |
101 | "Given PRODUCTS, a list of CPE names, return the subset limited to the | |
102 | applications listed in PRODUCTS, with names converted to package names: | |
103 | ||
104 | (cpe->product-alist | |
105 | '(\"cpe:/a:gnu:libtasn1:4.7\" \"cpe:/a:gnu:libtasn1:4.6\" \"cpe:/a:gnu:cpio:2.11\")) | |
106 | => ((\"libtasn1\" \"4.7\" \"4.6\") (\"cpio\" \"2.11\")) | |
107 | " | |
108 | (fold (lambda (product result) | |
109 | (let-values (((name version) (cpe->package-name product))) | |
110 | (if name | |
111 | (match result | |
112 | (((previous . versions) . tail) | |
113 | ;; Attempt to coalesce NAME and PREVIOUS. | |
114 | (if (string=? name previous) | |
115 | (alist-cons name (cons version versions) tail) | |
116 | (alist-cons name (list version) result))) | |
117 | (() | |
118 | (alist-cons name (list version) result))) | |
119 | result))) | |
120 | '() | |
121 | (sort products string<?))) | |
0eef7551 LC |
122 | |
123 | (define %parse-vulnerability-feed | |
124 | ;; Parse the XML vulnerability feed from | |
125 | ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of | |
126 | ;; vulnerability objects. | |
127 | (ssax:make-parser NEW-LEVEL-SEED | |
128 | (lambda (elem-gi attributes namespaces expected-content | |
129 | seed) | |
130 | (match elem-gi | |
131 | ((name-space . 'entry) | |
132 | (cons (assoc-ref attributes 'id) seed)) | |
133 | ((name-space . 'vulnerable-software-list) | |
134 | (cons '() seed)) | |
135 | ((name-space . 'product) | |
136 | (cons 'product seed)) | |
137 | (x seed))) | |
138 | ||
139 | FINISH-ELEMENT | |
140 | (lambda (elem-gi attributes namespaces parent-seed | |
141 | seed) | |
142 | (match elem-gi | |
143 | ((name-space . 'entry) | |
144 | (match seed | |
145 | (((? string? id) . rest) | |
146 | ;; Some entries have no vulnerable-software-list. | |
147 | rest) | |
148 | ((products id . rest) | |
870bf71e | 149 | (match (cpe->product-alist products) |
0eef7551 LC |
150 | (() |
151 | ;; No application among PRODUCTS. | |
152 | rest) | |
153 | (packages | |
870bf71e | 154 | (cons (vulnerability id packages) |
0eef7551 LC |
155 | rest)))))) |
156 | (x | |
157 | seed))) | |
158 | ||
159 | CHAR-DATA-HANDLER | |
160 | (lambda (str _ seed) | |
161 | (match seed | |
162 | (('product software-list . rest) | |
163 | ;; Add STR to the vulnerable software list this | |
164 | ;; <product> tag is part of. | |
165 | (cons (cons str software-list) rest)) | |
166 | (x x))))) | |
167 | ||
168 | (define (xml->vulnerabilities port) | |
169 | "Read from PORT an XML feed of vulnerabilities and return a list of | |
170 | vulnerability objects." | |
171 | (reverse (%parse-vulnerability-feed port '()))) | |
172 | ||
5cdd21c7 LC |
173 | (define vulnerability->sexp |
174 | (match-lambda | |
175 | (($ <vulnerability> id packages) | |
176 | `(v ,id ,packages)))) | |
177 | ||
178 | (define sexp->vulnerability | |
179 | (match-lambda | |
180 | (('v id (packages ...)) | |
181 | (vulnerability id packages)))) | |
182 | ||
7482b981 LC |
183 | (define (write-cache input cache) |
184 | "Read vulnerabilities as gzipped XML from INPUT, and write it as a compact | |
185 | sexp to CACHE." | |
186 | (call-with-decompressed-port 'gzip input | |
187 | (lambda (input) | |
188 | ;; XXX: The SSAX "error port" is used to send pointless warnings such as | |
189 | ;; "warning: Skipping PI". Turn that off. | |
190 | (define vulns | |
6a25e595 | 191 | (parameterize ((current-ssax-error-port (%make-void-port "w"))) |
7482b981 | 192 | (xml->vulnerabilities input))) |
6a25e595 | 193 | |
7482b981 LC |
194 | (write `(vulnerabilities |
195 | 1 ;format version | |
196 | ,(map vulnerability->sexp vulns)) | |
197 | cache)))) | |
5cdd21c7 | 198 | |
7482b981 LC |
199 | (define (fetch-vulnerabilities year ttl) |
200 | "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has | |
201 | the given TTL (fetch from the NIST web site when TTL has expired)." | |
202 | (define (cache-miss uri) | |
203 | (format (current-error-port) "fetching CVE database for ~a...~%" year)) | |
5cdd21c7 | 204 | |
f1b65d0d LC |
205 | (define (read* port) |
206 | ;; Disable read options to avoid populating the source property weak | |
207 | ;; table, which speeds things up, saves memory, and works around | |
208 | ;; <https://lists.gnu.org/archive/html/guile-devel/2017-09/msg00031.html>. | |
209 | (let ((options (read-options))) | |
210 | (dynamic-wind | |
211 | (lambda () | |
212 | (read-disable 'positions)) | |
213 | (lambda () | |
214 | (read port)) | |
215 | (lambda () | |
216 | (read-options options))))) | |
217 | ||
7482b981 LC |
218 | ;; Note: We used to keep the original XML files in cache but parsing it |
219 | ;; would take typically ~15s for a year of data. Thus, we instead store a | |
220 | ;; summarized version thereof as an sexp, which can be parsed in 1s or so. | |
221 | (let* ((port (http-fetch/cached (yearly-feed-uri year) | |
222 | #:ttl ttl | |
223 | #:write-cache write-cache | |
224 | #:cache-miss cache-miss)) | |
225 | (sexp (read* port))) | |
226 | (close-port port) | |
227 | (match sexp | |
228 | (('vulnerabilities 1 vulns) | |
229 | (map sexp->vulnerability vulns))))) | |
5cdd21c7 LC |
230 | |
231 | (define (current-vulnerabilities) | |
232 | "Return the current list of Common Vulnerabilities and Exposures (CVE) as | |
233 | published by the US NIST." | |
3af7a7a8 LC |
234 | (let ((past-years (unfold (cut > <> 3) |
235 | (lambda (n) | |
236 | (- %current-year n)) | |
237 | 1+ | |
238 | 1)) | |
239 | (past-ttls (unfold (cut > <> 3) | |
240 | (lambda (n) | |
241 | (* n %past-year-ttl)) | |
242 | 1+ | |
243 | 1))) | |
244 | (append-map fetch-vulnerabilities | |
245 | (cons %current-year past-years) | |
246 | (cons %current-year-ttl past-ttls)))) | |
0eef7551 LC |
247 | |
248 | (define (vulnerabilities->lookup-proc vulnerabilities) | |
249 | "Return a lookup procedure built from VULNERABILITIES that takes a package | |
250 | name and optionally a version number. When the version is omitted, the lookup | |
870bf71e LC |
251 | procedure returns a list of vulnerabilities; otherwise, it returns a list of |
252 | vulnerabilities affecting the given package version." | |
0eef7551 LC |
253 | (define table |
254 | ;; Map package names to lists of version/vulnerability pairs. | |
255 | (fold (lambda (vuln table) | |
256 | (match vuln | |
257 | (($ <vulnerability> id packages) | |
258 | (fold (lambda (package table) | |
259 | (match package | |
870bf71e LC |
260 | ((name . versions) |
261 | (vhash-cons name (cons vuln versions) | |
0eef7551 LC |
262 | table)))) |
263 | table | |
264 | packages)))) | |
265 | vlist-null | |
266 | vulnerabilities)) | |
267 | ||
268 | (lambda* (package #:optional version) | |
269 | (vhash-fold* (if version | |
270 | (lambda (pair result) | |
271 | (match pair | |
870bf71e LC |
272 | ((vuln . versions) |
273 | (if (member version versions) | |
0eef7551 LC |
274 | (cons vuln result) |
275 | result)))) | |
870bf71e LC |
276 | (lambda (pair result) |
277 | (match pair | |
278 | ((vuln . _) | |
279 | (cons vuln result))))) | |
0eef7551 LC |
280 | '() |
281 | package table))) | |
282 | ||
6a25e595 | 283 | |
0eef7551 | 284 | ;;; cve.scm ends here |