guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

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.
version-0.11.0
Ludovic Courtès 6 years ago
parent
494dc2fc62
commit
870bf71eb0
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
2 changed files with 62 additions and 34 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 79
      guix/cve.scm
  2. 17
      tests/cve.scm

79
guix/cve.scm
View File

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

17
tests/cve.scm
View File

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -32,12 +32,10 @@
(list
;; 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.
(vulnerability "CVE-2008-2335" '(("phpvid" . "1.1") ("phpvid" . "1.2")))
(vulnerability "CVE-2008-3522" '(("enterprise_virtualization" . "3.5")
("jasper" . "1.900.1")))
(vulnerability "CVE-2009-3301" '(("openoffice.org" . "2.1.0")
("openoffice.org" . "2.3.0")
("openoffice.org" . "2.2.1")))
(vulnerability "CVE-2008-2335" '(("phpvid" "1.2" "1.1")))
(vulnerability "CVE-2008-3522" '(("enterprise_virtualization" "3.5")
("jasper" "1.900.1")))
(vulnerability "CVE-2009-3301" '(("openoffice.org" "2.3.0" "2.2.1" "2.1.0")))
;; CVE-2015-8330 has no software list.
))
@ -48,9 +46,8 @@
%expected-vulnerabilities
(call-with-input-file %sample xml->vulnerabilities))
(test-equal ""
(list `(("1.1" . ,(first %expected-vulnerabilities))
("1.2" . ,(first %expected-vulnerabilities)))
(test-equal "vulnerabilities->lookup-proc"
(list (list (first %expected-vulnerabilities))
'()
'()
(list (second %expected-vulnerabilities))

Write Preview
Loading…
Cancel
Save