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