nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cve: Use a more compact format for the list of package/versions. 

On a warm cache, "guix lint -c cve vorbis-tools" goes down
from 6.5s to 2.4s.

* guix/cve.scm (cpe->package-name): Change to return two values instead
of a pair.
(cpe->product-alist): New procedure.
(%parse-vulnerability-feed): Use it instead of 'filter-map'.
(fetch-vulnerabilities): Bump sexp format version to 1.
(vulnerabilities->lookup-proc): Adjust accordingly.  When #:version is
omitted, return a list of vulnerabilities instead of a list of
version/vulnerability pairs.
* tests/cve.scm (%expected-vulnerabilities)
("vulnerabilities->lookup-proc): Adjust accordingly.
master
Ludovic Courtès 2016-05-28 00:44:36 +02:00
parent 494dc2fc62
commit 870bf71eb0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 62 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
guix/cve.scm
View File

@ -24,6 +24,7 @@
#:use-module (web uri) #:use-module (web uri)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -48,8 +49,8 @@
(define-record-type <vulnerability> (define-record-type <vulnerability>
(vulnerability id packages) (vulnerability id packages)
vulnerability? vulnerability?
(id vulnerability-id) (id vulnerability-id) ;string
(packages vulnerability-packages)) (packages vulnerability-packages)) ;((p1 v1 v2 v3) (p2 v1) ...)
(define %now (define %now
(current-date)) (current-date))
@ -93,18 +94,45 @@
(define (cpe->package-name cpe) (define (cpe->package-name cpe)
"Converts the Common Platform Enumeration (CPE) string CPE to a package "Converts the Common Platform Enumeration (CPE) string CPE to a package
name, in a very naive way. Return #f if CPE does not look like an application name, in a very naive way. Return two values: the package name, and its
CPE string." version string. Return #f and #f if CPE does not look like an application CPE
(and=> (regexp-exec %cpe-package-rx (string-trim-both cpe)) string."
(cond ((regexp-exec %cpe-package-rx (string-trim-both cpe))
=>
(lambda (matches) (lambda (matches)
(cons (match:substring matches 2) (values (match:substring matches 2)
(string-append (match:substring matches 3) (string-append (match:substring matches 3)
(match (match:substring matches 4) (match (match:substring matches 4)
("" "") ("" "")
(patch-level (patch-level
;; Drop the colon from things like ;; Drop the colon from things like
;; "cpe:/a:openbsd:openssh:6.8:p1". ;; "cpe:/a:openbsd:openssh:6.8:p1".
(string-drop patch-level 1)))))))) (string-drop patch-level 1)))))))
(else
(values #f #f))))
(define (cpe->product-alist products)
"Given PRODUCTS, a list of CPE names, return the subset limited to the
applications listed in PRODUCTS, with names converted to package names:
(cpe->product-alist
'(\"cpe:/a:gnu:libtasn1:4.7\" \"cpe:/a:gnu:libtasn1:4.6\" \"cpe:/a:gnu:cpio:2.11\"))
=> ((\"libtasn1\" \"4.7\" \"4.6\") (\"cpio\" \"2.11\"))
"
(fold (lambda (product result)
(let-values (((name version) (cpe->package-name product)))
(if name
(match result
(((previous . versions) . tail)
;; Attempt to coalesce NAME and PREVIOUS.
(if (string=? name previous)
(alist-cons name (cons version versions) tail)
(alist-cons name (list version) result)))
(()
(alist-cons name (list version) result)))
result)))
'()
(sort products string<?)))
(define %parse-vulnerability-feed (define %parse-vulnerability-feed
;; Parse the XML vulnerability feed from ;; Parse the XML vulnerability feed from
@ -132,12 +160,12 @@ CPE string."
;; Some entries have no vulnerable-software-list. ;; Some entries have no vulnerable-software-list.
rest) rest)
((products id . rest) ((products id . rest)
(match (filter-map cpe->package-name products) (match (cpe->product-alist products)
(() (()
;; No application among PRODUCTS. ;; No application among PRODUCTS.
rest) rest)
(packages (packages
(cons (vulnerability id (reverse packages)) (cons (vulnerability id packages)
rest)))))) rest))))))
(x (x
seed))) seed)))
@ -190,7 +218,7 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
(with-atomic-file-output cache (with-atomic-file-output cache
(lambda (port) (lambda (port)
(write `(vulnerabilities (write `(vulnerabilities
0 ;format version 1 ;format version
,(map vulnerability->sexp vulns)) ,(map vulnerability->sexp vulns))
port))) port)))
vulns)) vulns))
@ -206,7 +234,7 @@ the given TTL (fetch from the NIST web site when TTL has expired)."
(if (old? cache) (if (old? cache)
(update-cache) (update-cache)
(match (call-with-input-file cache read) (match (call-with-input-file cache read)
(('vulnerabilities 0 vulns) (('vulnerabilities 1 vulns)
(map sexp->vulnerability vulns)) (map sexp->vulnerability vulns))
(x (x
(update-cache))))) (update-cache)))))
@ -233,8 +261,8 @@ published by the US NIST."
(define (vulnerabilities->lookup-proc vulnerabilities) (define (vulnerabilities->lookup-proc vulnerabilities)
"Return a lookup procedure built from VULNERABILITIES that takes a package "Return a lookup procedure built from VULNERABILITIES that takes a package
name and optionally a version number. When the version is omitted, the lookup name and optionally a version number. When the version is omitted, the lookup
procedure returns a list of version/vulnerability pairs; otherwise, it returns procedure returns a list of vulnerabilities; otherwise, it returns a list of
a list of vulnerabilities affection the given package version." vulnerabilities affecting the given package version."
(define table (define table
;; Map package names to lists of version/vulnerability pairs. ;; Map package names to lists of version/vulnerability pairs.
(fold (lambda (vuln table) (fold (lambda (vuln table)
@ -242,8 +270,8 @@ a list of vulnerabilities affection the given package version."
(($ <vulnerability> id packages) (($ <vulnerability> id packages)
(fold (lambda (package table) (fold (lambda (package table)
(match package (match package
((name . version) ((name . versions)
(vhash-cons name (cons version vuln) (vhash-cons name (cons vuln versions)
table)))) table))))
table table
packages)))) packages))))
@ -254,11 +282,14 @@ a list of vulnerabilities affection the given package version."
(vhash-fold* (if version (vhash-fold* (if version
(lambda (pair result) (lambda (pair result)
(match pair (match pair
((v . vuln) ((vuln . versions)
(if (string=? v version) (if (member version versions)
(cons vuln result) (cons vuln result)
result)))) result))))
cons) (lambda (pair result)
(match pair
((vuln . _)
(cons vuln result)))))
'() '()
package table))) package table)))

17
tests/cve.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -32,12 +32,10 @@
(list (list
;; CVE-2003-0001 has no "/a" in its product list so it is omitted. ;; CVE-2003-0001 has no "/a" in its product list so it is omitted.
;; CVE-2004-0230 lists "tcp" as an application, but lacks a version number. ;; CVE-2004-0230 lists "tcp" as an application, but lacks a version number.
(vulnerability "CVE-2008-2335" '(("phpvid" . "1.1") ("phpvid" . "1.2"))) (vulnerability "CVE-2008-2335" '(("phpvid" "1.2" "1.1")))
(vulnerability "CVE-2008-3522" '(("enterprise_virtualization" . "3.5") (vulnerability "CVE-2008-3522" '(("enterprise_virtualization" "3.5")
("jasper" . "1.900.1"))) ("jasper" "1.900.1")))
(vulnerability "CVE-2009-3301" '(("openoffice.org" . "2.1.0") (vulnerability "CVE-2009-3301" '(("openoffice.org" "2.3.0" "2.2.1" "2.1.0")))
("openoffice.org" . "2.3.0")
("openoffice.org" . "2.2.1")))
;; CVE-2015-8330 has no software list. ;; CVE-2015-8330 has no software list.
)) ))
@ -48,9 +46,8 @@
%expected-vulnerabilities %expected-vulnerabilities
(call-with-input-file %sample xml->vulnerabilities)) (call-with-input-file %sample xml->vulnerabilities))
(test-equal "" (test-equal "vulnerabilities->lookup-proc"
(list `(("1.1" . ,(first %expected-vulnerabilities)) (list (list (first %expected-vulnerabilities))
("1.2" . ,(first %expected-vulnerabilities)))
'() '()
'() '()
(list (second %expected-vulnerabilities)) (list (second %expected-vulnerabilities))