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) | |
5cdd21c7 | 22 | #:use-module ((guix build utils) #:select (mkdir-p)) |
0eef7551 LC |
23 | #:use-module (sxml ssax) |
24 | #:use-module (web uri) | |
25 | #:use-module (srfi srfi-1) | |
26 | #:use-module (srfi srfi-9) | |
27 | #:use-module (srfi srfi-19) | |
28 | #:use-module (ice-9 match) | |
29 | #:use-module (ice-9 regex) | |
30 | #:use-module (ice-9 vlist) | |
31 | #:export (vulnerability? | |
32 | vulnerability-id | |
33 | vulnerability-packages | |
34 | ||
35 | xml->vulnerabilities | |
36 | current-vulnerabilities | |
37 | vulnerabilities->lookup-proc)) | |
38 | ||
39 | ;;; Commentary: | |
40 | ;;; | |
41 | ;;; This modules provides the tools to fetch, parse, and digest part of the | |
42 | ;;; Common Vulnerabilities and Exposures (CVE) feeds provided by the US NIST | |
43 | ;;; at <https://nvd.nist.gov/download.cfm#CVE_FEED>. | |
44 | ;;; | |
45 | ;;; Code: | |
46 | ||
47 | (define-record-type <vulnerability> | |
48 | (vulnerability id packages) | |
49 | vulnerability? | |
50 | (id vulnerability-id) | |
51 | (packages vulnerability-packages)) | |
52 | ||
6a25e595 LC |
53 | (define %now |
54 | (current-date)) | |
55 | (define %current-year | |
56 | (date-year %now)) | |
57 | (define %past-year | |
58 | (- %current-year 1)) | |
59 | ||
60 | (define (yearly-feed-uri year) | |
61 | "Return the URI for the CVE feed for YEAR." | |
0eef7551 | 62 | (string->uri |
6a25e595 LC |
63 | (string-append "https://static.nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-" |
64 | (number->string year) ".xml.gz"))) | |
0eef7551 | 65 | |
6a25e595 | 66 | (define %current-year-ttl |
0eef7551 LC |
67 | ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are |
68 | ;; updated "approximately every two hours." | |
69 | (* 3600 3)) | |
70 | ||
6a25e595 LC |
71 | (define %past-year-ttl |
72 | ;; Update the previous year's database more and more infrequently. | |
73 | (* 3600 24 2 (date-month %now))) | |
74 | ||
75 | (define (call-with-cve-port uri ttl proc) | |
0eef7551 | 76 | "Pass PROC an input port from which to read the CVE stream." |
86cf1303 | 77 | (let ((port (http-fetch uri))) |
0eef7551 LC |
78 | (dynamic-wind |
79 | (const #t) | |
80 | (lambda () | |
81 | (call-with-decompressed-port 'gzip port | |
6a25e595 LC |
82 | (lambda (port) |
83 | (setvbuf port _IOFBF 65536) | |
84 | (proc port)))) | |
0eef7551 LC |
85 | (lambda () |
86 | (close-port port))))) | |
87 | ||
88 | (define %cpe-package-rx | |
cf557afa LC |
89 | ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes |
90 | ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL". | |
91 | (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)")) | |
0eef7551 LC |
92 | |
93 | (define (cpe->package-name cpe) | |
94 | "Converts the Common Platform Enumeration (CPE) string CPE to a package | |
95 | name, in a very naive way. Return #f if CPE does not look like an application | |
96 | CPE string." | |
97 | (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe)) | |
98 | (lambda (matches) | |
99 | (cons (match:substring matches 2) | |
cf557afa LC |
100 | (string-append (match:substring matches 3) |
101 | (match (match:substring matches 4) | |
102 | ("" "") | |
103 | (patch-level | |
104 | ;; Drop the colon from things like | |
105 | ;; "cpe:/a:openbsd:openssh:6.8:p1". | |
106 | (string-drop patch-level 1)))))))) | |
0eef7551 LC |
107 | |
108 | (define %parse-vulnerability-feed | |
109 | ;; Parse the XML vulnerability feed from | |
110 | ;; <https://nvd.nist.gov/download.cfm#CVE_FEED> and return a list of | |
111 | ;; vulnerability objects. | |
112 | (ssax:make-parser NEW-LEVEL-SEED | |
113 | (lambda (elem-gi attributes namespaces expected-content | |
114 | seed) | |
115 | (match elem-gi | |
116 | ((name-space . 'entry) | |
117 | (cons (assoc-ref attributes 'id) seed)) | |
118 | ((name-space . 'vulnerable-software-list) | |
119 | (cons '() seed)) | |
120 | ((name-space . 'product) | |
121 | (cons 'product seed)) | |
122 | (x seed))) | |
123 | ||
124 | FINISH-ELEMENT | |
125 | (lambda (elem-gi attributes namespaces parent-seed | |
126 | seed) | |
127 | (match elem-gi | |
128 | ((name-space . 'entry) | |
129 | (match seed | |
130 | (((? string? id) . rest) | |
131 | ;; Some entries have no vulnerable-software-list. | |
132 | rest) | |
133 | ((products id . rest) | |
134 | (match (filter-map cpe->package-name products) | |
135 | (() | |
136 | ;; No application among PRODUCTS. | |
137 | rest) | |
138 | (packages | |
139 | (cons (vulnerability id (reverse packages)) | |
140 | rest)))))) | |
141 | (x | |
142 | seed))) | |
143 | ||
144 | CHAR-DATA-HANDLER | |
145 | (lambda (str _ seed) | |
146 | (match seed | |
147 | (('product software-list . rest) | |
148 | ;; Add STR to the vulnerable software list this | |
149 | ;; <product> tag is part of. | |
150 | (cons (cons str software-list) rest)) | |
151 | (x x))))) | |
152 | ||
153 | (define (xml->vulnerabilities port) | |
154 | "Read from PORT an XML feed of vulnerabilities and return a list of | |
155 | vulnerability objects." | |
156 | (reverse (%parse-vulnerability-feed port '()))) | |
157 | ||
5cdd21c7 LC |
158 | (define vulnerability->sexp |
159 | (match-lambda | |
160 | (($ <vulnerability> id packages) | |
161 | `(v ,id ,packages)))) | |
162 | ||
163 | (define sexp->vulnerability | |
164 | (match-lambda | |
165 | (('v id (packages ...)) | |
166 | (vulnerability id packages)))) | |
167 | ||
168 | (define (fetch-vulnerabilities year ttl) | |
169 | "Return the list of <vulnerability> for YEAR, assuming the on-disk cache has | |
170 | the given TTL (fetch from the NIST web site when TTL has expired)." | |
171 | ;; Note: We used to keep the original XML files in cache but parsing it | |
172 | ;; would take typically ~15s for a year of data. Thus, we instead store a | |
173 | ;; summarized version thereof as an sexp, which can be parsed in 1s or so. | |
174 | (define cache | |
175 | (string-append (cache-directory) "/cve/" (number->string year))) | |
176 | ||
177 | (define (do-fetch) | |
178 | (call-with-cve-port (yearly-feed-uri year) ttl | |
6a25e595 LC |
179 | (lambda (port) |
180 | ;; XXX: The SSAX "error port" is used to send pointless warnings such as | |
181 | ;; "warning: Skipping PI". Turn that off. | |
182 | (parameterize ((current-ssax-error-port (%make-void-port "w"))) | |
183 | (xml->vulnerabilities port))))) | |
184 | ||
5cdd21c7 LC |
185 | (define (update-cache) |
186 | (mkdir-p (dirname cache)) | |
187 | (let ((vulns (do-fetch))) | |
188 | (with-atomic-file-output cache | |
189 | (lambda (port) | |
190 | (write `(vulnerabilities | |
191 | 0 ;format version | |
192 | ,(map vulnerability->sexp vulns)) | |
193 | port))) | |
194 | vulns)) | |
195 | ||
196 | (define (old? file) | |
197 | ;; Return true if PORT has passed TTL. | |
198 | (let* ((s (stat file)) | |
199 | (now (current-time time-utc))) | |
200 | (< (+ (stat:mtime s) ttl) (time-second now)))) | |
201 | ||
202 | (catch 'system-error | |
203 | (lambda () | |
204 | (if (old? cache) | |
205 | (update-cache) | |
206 | (match (call-with-input-file cache read) | |
207 | (('vulnerabilities 0 vulns) | |
208 | (map sexp->vulnerability vulns)) | |
209 | (x | |
210 | (update-cache))))) | |
211 | (lambda args | |
212 | (update-cache)))) | |
213 | ||
214 | (define (current-vulnerabilities) | |
215 | "Return the current list of Common Vulnerabilities and Exposures (CVE) as | |
216 | published by the US NIST." | |
217 | (append-map fetch-vulnerabilities | |
218 | (list %past-year %current-year) | |
219 | (list %past-year-ttl %current-year-ttl))) | |
0eef7551 LC |
220 | |
221 | (define (vulnerabilities->lookup-proc vulnerabilities) | |
222 | "Return a lookup procedure built from VULNERABILITIES that takes a package | |
223 | name and optionally a version number. When the version is omitted, the lookup | |
224 | procedure returns a list of version/vulnerability pairs; otherwise, it returns | |
225 | a list of vulnerabilities affection the given package version." | |
226 | (define table | |
227 | ;; Map package names to lists of version/vulnerability pairs. | |
228 | (fold (lambda (vuln table) | |
229 | (match vuln | |
230 | (($ <vulnerability> id packages) | |
231 | (fold (lambda (package table) | |
232 | (match package | |
233 | ((name . version) | |
234 | (vhash-cons name (cons version vuln) | |
235 | table)))) | |
236 | table | |
237 | packages)))) | |
238 | vlist-null | |
239 | vulnerabilities)) | |
240 | ||
241 | (lambda* (package #:optional version) | |
242 | (vhash-fold* (if version | |
243 | (lambda (pair result) | |
244 | (match pair | |
245 | ((v . vuln) | |
246 | (if (string=? v version) | |
247 | (cons vuln result) | |
248 | result)))) | |
249 | cons) | |
250 | '() | |
251 | package table))) | |
252 | ||
6a25e595 LC |
253 | |
254 | ;;; Local Variables: | |
255 | ;;; eval: (put 'call-with-cve-port 'scheme-indent-function 2) | |
256 | ;;; End: | |
257 | ||
0eef7551 | 258 | ;;; cve.scm ends here |