Commit | Line | Data |
---|---|---|
0eef7551 | 1 | ;;; GNU Guix --- Functional package management for GNU |
d51bfe24 | 2 | ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 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) | |
74afaa37 | 22 | #:use-module (guix i18n) |
d51bfe24 | 23 | #:use-module ((guix diagnostics) #:select (formatted-message)) |
74afaa37 | 24 | #:use-module (json) |
0eef7551 LC |
25 | #:use-module (web uri) |
26 | #:use-module (srfi srfi-1) | |
27 | #:use-module (srfi srfi-9) | |
870bf71e | 28 | #:use-module (srfi srfi-11) |
0eef7551 | 29 | #:use-module (srfi srfi-19) |
3af7a7a8 | 30 | #:use-module (srfi srfi-26) |
74afaa37 LC |
31 | #:use-module (srfi srfi-34) |
32 | #:use-module (srfi srfi-35) | |
0eef7551 LC |
33 | #:use-module (ice-9 match) |
34 | #:use-module (ice-9 regex) | |
35 | #:use-module (ice-9 vlist) | |
74afaa37 LC |
36 | #:export (json->cve-items |
37 | ||
38 | cve-item? | |
39 | cve-item-cve | |
40 | cve-item-configurations | |
41 | cve-item-published-date | |
42 | cve-item-last-modified-date | |
43 | ||
44 | cve? | |
45 | cve-id | |
46 | cve-data-type | |
47 | cve-data-format | |
a055604e | 48 | cve-references |
74afaa37 LC |
49 | |
50 | cve-reference? | |
51 | cve-reference-url | |
52 | cve-reference-tags | |
53 | ||
54 | vulnerability? | |
0eef7551 LC |
55 | vulnerability-id |
56 | vulnerability-packages | |
57 | ||
74afaa37 | 58 | json->vulnerabilities |
0eef7551 LC |
59 | current-vulnerabilities |
60 | vulnerabilities->lookup-proc)) | |
61 | ||
62 | ;;; Commentary: | |
63 | ;;; | |
64 | ;;; This modules provides the tools to fetch, parse, and digest part of the | |
65 | ;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST | |
74afaa37 | 66 | ;;; at <https://nvd.nist.gov/vuln/data-feeds>. |
0eef7551 LC |
67 | ;;; |
68 | ;;; Code: | |
69 | ||
74afaa37 LC |
70 | (define (string->date* str) |
71 | (string->date str "~Y-~m-~dT~H:~M~z")) | |
72 | ||
73 | (define-json-mapping <cve-item> cve-item cve-item? | |
74 | json->cve-item | |
75 | (cve cve-item-cve "cve" json->cve) ;<cve> | |
76 | (configurations cve-item-configurations ;list of sexps | |
77 | "configurations" configuration-data->cve-configurations) | |
78 | (published-date cve-item-published-date | |
79 | "publishedDate" string->date*) | |
80 | (last-modified-date cve-item-last-modified-date | |
81 | "lastModifiedDate" string->date*)) | |
82 | ||
83 | (define-json-mapping <cve> cve cve? | |
84 | json->cve | |
85 | (id cve-id "CVE_data_meta" ;string | |
86 | (cut assoc-ref <> "ID")) | |
87 | (data-type cve-data-type ;'CVE | |
88 | "data_type" string->symbol) | |
89 | (data-format cve-data-format ;'MITRE | |
90 | "data_format" string->symbol) | |
a055604e | 91 | (references cve-references ;list of <cve-reference> |
74afaa37 LC |
92 | "references" reference-data->cve-references)) |
93 | ||
94 | (define-json-mapping <cve-reference> cve-reference cve-reference? | |
95 | json->cve-reference | |
96 | (url cve-reference-url) ;string | |
97 | (tags cve-reference-tags ;list of strings | |
98 | "tags" vector->list)) | |
99 | ||
100 | (define (reference-data->cve-references alist) | |
101 | (map json->cve-reference | |
102 | (vector->list (assoc-ref alist "reference_data")))) | |
103 | ||
104 | (define %cpe-package-rx | |
105 | ;; For applications: "cpe:2.3:a:VENDOR:PACKAGE:VERSION", or sometimes | |
106 | ;; "cpe:2.3:a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". | |
107 | (make-regexp "^cpe:2\\.3:a:([^:]+):([^:]+):([^:]+):([^:]+):")) | |
108 | ||
109 | (define (cpe->package-name cpe) | |
110 | "Converts the Common Platform Enumeration (CPE) string CPE to a package | |
111 | name, in a very naive way. Return two values: the package name, and its | |
112 | version string. Return #f and #f if CPE does not look like an application CPE | |
113 | string." | |
114 | (cond ((regexp-exec %cpe-package-rx cpe) | |
115 | => | |
116 | (lambda (matches) | |
117 | (values (match:substring matches 2) | |
118 | (match (match:substring matches 3) | |
119 | ("*" '_) | |
120 | (version | |
121 | (string-append version | |
122 | (match (match:substring matches 4) | |
123 | ("" "") | |
124 | (patch-level | |
125 | ;; Drop the colon from things like | |
126 | ;; "cpe:2.3:a:openbsd:openssh:6.8:p1". | |
127 | (string-drop patch-level 1))))))))) | |
128 | (else | |
129 | (values #f #f)))) | |
130 | ||
131 | (define (cpe-match->cve-configuration alist) | |
132 | "Convert ALIST, a \"cpe_match\" alist, into an sexp representing the package | |
133 | and versions matched. Return #f if ALIST doesn't correspond to an application | |
134 | package." | |
135 | (let ((cpe (assoc-ref alist "cpe23Uri")) | |
136 | (starti (assoc-ref alist "versionStartIncluding")) | |
137 | (starte (assoc-ref alist "versionStartExcluding")) | |
138 | (endi (assoc-ref alist "versionEndIncluding")) | |
139 | (ende (assoc-ref alist "versionEndExcluding"))) | |
140 | (let-values (((package version) (cpe->package-name cpe))) | |
141 | (and package | |
142 | `(,package | |
143 | ,(cond ((and (or starti starte) (or endi ende)) | |
144 | `(and ,(if starti `(>= ,starti) `(> ,starte)) | |
145 | ,(if endi `(<= ,endi) `(< ,ende)))) | |
146 | (starti `(>= ,starti)) | |
147 | (starte `(> ,starte)) | |
148 | (endi `(<= ,endi)) | |
149 | (ende `(< ,ende)) | |
150 | (else version))))))) | |
151 | ||
152 | (define (configuration-data->cve-configurations alist) | |
153 | "Given ALIST, a JSON dictionary for the baroque \"configurations\" | |
154 | element found in CVEs, return an sexp such as (\"binutils\" (< | |
155 | \"2.31\")) that represents matching configurations." | |
156 | (define string->operator | |
157 | (match-lambda | |
158 | ("OR" 'or) | |
159 | ("AND" 'and))) | |
160 | ||
161 | (define (node->configuration node) | |
162 | (let ((operator (string->operator (assoc-ref node "operator")))) | |
163 | (cond | |
164 | ((assoc-ref node "cpe_match") | |
165 | => | |
166 | (lambda (matches) | |
167 | (let ((matches (vector->list matches))) | |
168 | (match (filter-map cpe-match->cve-configuration | |
169 | matches) | |
170 | (() #f) | |
171 | ((one) one) | |
172 | (lst (cons operator lst)))))) | |
173 | ((assoc-ref node "children") ;typically for 'and' | |
174 | => | |
175 | (lambda (children) | |
176 | (match (filter-map node->configuration (vector->list children)) | |
177 | (() #f) | |
178 | ((one) one) | |
179 | (lst (cons operator lst))))) | |
180 | (else | |
181 | #f)))) | |
182 | ||
183 | (let ((nodes (vector->list (assoc-ref alist "nodes")))) | |
184 | (filter-map node->configuration nodes))) | |
185 | ||
186 | (define (json->cve-items json) | |
187 | "Parse JSON, an input port or a string, and return a list of <cve-item> | |
188 | records." | |
189 | (let* ((alist (json->scm json)) | |
190 | (type (assoc-ref alist "CVE_data_type")) | |
191 | (format (assoc-ref alist "CVE_data_format")) | |
192 | (version (assoc-ref alist "CVE_data_version"))) | |
193 | (unless (equal? type "CVE") | |
194 | (raise (condition (&message | |
195 | (message "invalid CVE feed"))))) | |
196 | (unless (equal? format "MITRE") | |
d51bfe24 LC |
197 | (raise (formatted-message (G_ "unsupported CVE format: '~a'") |
198 | format))) | |
74afaa37 | 199 | (unless (equal? version "4.0") |
d51bfe24 LC |
200 | (raise (formatted-message (G_ "unsupported CVE data version: '~a'") |
201 | version))) | |
74afaa37 LC |
202 | |
203 | (map json->cve-item | |
204 | (vector->list (assoc-ref alist "CVE_Items"))))) | |
205 | ||
206 | (define (version-matches? version sexp) | |
207 | "Return true if VERSION, a string, matches SEXP." | |
208 | (match sexp | |
209 | ('_ | |
210 | #t) | |
211 | ((? string? expected) | |
212 | (version-prefix? expected version)) | |
213 | (('or sexps ...) | |
214 | (any (cut version-matches? version <>) sexps)) | |
215 | (('and sexps ...) | |
216 | (every (cut version-matches? version <>) sexps)) | |
217 | (('< max) | |
218 | (version>? max version)) | |
219 | (('<= max) | |
220 | (version>=? max version)) | |
221 | (('> min) | |
222 | (version>? version min)) | |
223 | (('>= min) | |
224 | (version>=? version min)))) | |
225 | ||
226 | \f | |
227 | ;;; | |
228 | ;;; High-level interface. | |
229 | ;;; | |
0eef7551 | 230 | |
6a25e595 LC |
231 | (define %now |
232 | (current-date)) | |
233 | (define %current-year | |
234 | (date-year %now)) | |
235 | (define %past-year | |
236 | (- %current-year 1)) | |
237 | ||
238 | (define (yearly-feed-uri year) | |
239 | "Return the URI for the CVE feed for YEAR." | |
0eef7551 | 240 | (string->uri |
74afaa37 LC |
241 | (string-append "https://nvd.nist.gov/feeds/json/cve/1.1/nvdcve-1.1-" |
242 | (number->string year) ".json.gz"))) | |
0eef7551 | 243 | |
6a25e595 | 244 | (define %current-year-ttl |
0eef7551 LC |
245 | ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are |
246 | ;; updated "approximately every two hours." | |
7482b981 | 247 | (* 60 30)) |
0eef7551 | 248 | |
6a25e595 LC |
249 | (define %past-year-ttl |
250 | ;; Update the previous year's database more and more infrequently. | |
7482b981 | 251 | (* 3600 24 (date-month %now))) |
0eef7551 | 252 | |
74afaa37 LC |
253 | (define-record-type <vulnerability> |
254 | (vulnerability id packages) | |
255 | vulnerability? | |
256 | (id vulnerability-id) ;string | |
257 | (packages vulnerability-packages)) ;((p1 sexp1) (p2 sexp2) ...) | |
0eef7551 | 258 | |
5cdd21c7 LC |
259 | (define vulnerability->sexp |
260 | (match-lambda | |
261 | (($ <vulnerability> id packages) | |
262 | `(v ,id ,packages)))) | |
263 | ||
264 | (define sexp->vulnerability | |
265 | (match-lambda | |
266 | (('v id (packages ...)) | |
267 | (vulnerability id packages)))) | |
268 | ||
74afaa37 LC |
269 | (define (cve-configuration->package-list config) |
270 | "Parse CONFIG, a config sexp, and return a list of the form (P SEXP) | |
271 | where P is a package name and SEXP expresses constraints on the matching | |
272 | versions." | |
273 | (let loop ((config config) | |
274 | (packages '())) | |
275 | (match config | |
276 | (('or configs ...) | |
277 | (fold loop packages configs)) | |
278 | (('and config _ ...) ;XXX | |
279 | (loop config packages)) | |
280 | (((? string? package) '_) ;any version | |
281 | (cons `(,package _) | |
282 | (alist-delete package packages))) | |
283 | (((? string? package) sexp) | |
284 | (let ((previous (assoc-ref packages package))) | |
285 | (if previous | |
286 | (cons `(,package (or ,sexp ,@previous)) | |
287 | (alist-delete package packages)) | |
288 | (cons `(,package ,sexp) packages))))))) | |
289 | ||
290 | (define (merge-package-lists lst) | |
291 | "Merge the list in LST, each of which has the form (p sexp), where P | |
292 | is the name of a package and SEXP is an sexp that constrains matching | |
293 | versions." | |
294 | (fold (lambda (plist result) ;XXX: quadratic | |
295 | (fold (match-lambda* | |
296 | (((package version) result) | |
297 | (match (assoc-ref result package) | |
298 | (#f | |
299 | (cons `(,package ,version) result)) | |
300 | ((previous) | |
301 | (cons `(,package (or ,version ,previous)) | |
302 | (alist-delete package result)))))) | |
303 | result | |
304 | plist)) | |
305 | '() | |
306 | lst)) | |
307 | ||
308 | (define (cve-item->vulnerability item) | |
309 | "Return a <vulnerability> corresponding to ITEM, a <cve-item> record; | |
310 | return #f if ITEM does not list any configuration or if it does not list | |
311 | any \"a\" (application) configuration." | |
312 | (let ((id (cve-id (cve-item-cve item)))) | |
313 | (match (cve-item-configurations item) | |
314 | (() ;no configurations | |
315 | #f) | |
316 | ((configs ...) | |
317 | (vulnerability id | |
318 | (merge-package-lists | |
319 | (map cve-configuration->package-list configs))))))) | |
320 | ||
321 | (define (json->vulnerabilities json) | |
322 | "Parse JSON, an input port or a string, and return the list of | |
323 | vulnerabilities found therein." | |
324 | (filter-map cve-item->vulnerability (json->cve-items json))) | |
325 | ||
7482b981 | 326 | (define (write-cache input cache) |
74afaa37 | 327 | "Read vulnerabilities as gzipped JSON from INPUT, and write it as a compact |
7482b981 LC |
328 | sexp to CACHE." |
329 | (call-with-decompressed-port 'gzip input | |
330 | (lambda (input) | |
7482b981 | 331 | (define vulns |
74afaa37 | 332 | (json->vulnerabilities input)) |
6a25e595 | 333 | |
7482b981 LC |
334 | (write `(vulnerabilities |
335 | 1 ;format version | |
336 | ,(map vulnerability->sexp vulns)) | |
337 | cache)))) | |
5cdd21c7 | 338 | |
7482b981 LC |
339 | (define (fetch-vulnerabilities year ttl) |
340 | "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has | |
341 | the given TTL (fetch from the NIST web site when TTL has expired)." | |
342 | (define (cache-miss uri) | |
343 | (format (current-error-port) "fetching CVE database for ~a...~%" year)) | |
5cdd21c7 | 344 | |
f1b65d0d LC |
345 | (define (read* port) |
346 | ;; Disable read options to avoid populating the source property weak | |
347 | ;; table, which speeds things up, saves memory, and works around | |
348 | ;; <https://lists.gnu.org/archive/html/guile-devel/2017-09/msg00031.html>. | |
349 | (let ((options (read-options))) | |
350 | (dynamic-wind | |
351 | (lambda () | |
352 | (read-disable 'positions)) | |
353 | (lambda () | |
354 | (read port)) | |
355 | (lambda () | |
356 | (read-options options))))) | |
357 | ||
74afaa37 | 358 | ;; Note: We used to keep the original JSON files in cache but parsing it |
7482b981 LC |
359 | ;; would take typically ~15s for a year of data. Thus, we instead store a |
360 | ;; summarized version thereof as an sexp, which can be parsed in 1s or so. | |
361 | (let* ((port (http-fetch/cached (yearly-feed-uri year) | |
362 | #:ttl ttl | |
363 | #:write-cache write-cache | |
364 | #:cache-miss cache-miss)) | |
365 | (sexp (read* port))) | |
366 | (close-port port) | |
367 | (match sexp | |
368 | (('vulnerabilities 1 vulns) | |
369 | (map sexp->vulnerability vulns))))) | |
5cdd21c7 LC |
370 | |
371 | (define (current-vulnerabilities) | |
372 | "Return the current list of Common Vulnerabilities and Exposures (CVE) as | |
373 | published by the US NIST." | |
3af7a7a8 LC |
374 | (let ((past-years (unfold (cut > <> 3) |
375 | (lambda (n) | |
376 | (- %current-year n)) | |
377 | 1+ | |
378 | 1)) | |
379 | (past-ttls (unfold (cut > <> 3) | |
380 | (lambda (n) | |
381 | (* n %past-year-ttl)) | |
382 | 1+ | |
383 | 1))) | |
384 | (append-map fetch-vulnerabilities | |
385 | (cons %current-year past-years) | |
386 | (cons %current-year-ttl past-ttls)))) | |
0eef7551 LC |
387 | |
388 | (define (vulnerabilities->lookup-proc vulnerabilities) | |
389 | "Return a lookup procedure built from VULNERABILITIES that takes a package | |
390 | name and optionally a version number. When the version is omitted, the lookup | |
870bf71e LC |
391 | procedure returns a list of vulnerabilities; otherwise, it returns a list of |
392 | vulnerabilities affecting the given package version." | |
0eef7551 LC |
393 | (define table |
394 | ;; Map package names to lists of version/vulnerability pairs. | |
395 | (fold (lambda (vuln table) | |
396 | (match vuln | |
397 | (($ <vulnerability> id packages) | |
398 | (fold (lambda (package table) | |
399 | (match package | |
870bf71e LC |
400 | ((name . versions) |
401 | (vhash-cons name (cons vuln versions) | |
0eef7551 LC |
402 | table)))) |
403 | table | |
404 | packages)))) | |
405 | vlist-null | |
406 | vulnerabilities)) | |
407 | ||
408 | (lambda* (package #:optional version) | |
409 | (vhash-fold* (if version | |
410 | (lambda (pair result) | |
411 | (match pair | |
74afaa37 LC |
412 | ((vuln sexp) |
413 | (if (version-matches? version sexp) | |
0eef7551 LC |
414 | (cons vuln result) |
415 | result)))) | |
870bf71e LC |
416 | (lambda (pair result) |
417 | (match pair | |
418 | ((vuln . _) | |
419 | (cons vuln result))))) | |
0eef7551 LC |
420 | '() |
421 | package table))) | |
422 | ||
6a25e595 | 423 | |
0eef7551 | 424 | ;;; cve.scm ends here |