summary refs log tree commit diff
path: root/guix/cve.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/cve.scm')
-rw-r--r--guix/cve.scm66
1 files changed, 50 insertions, 16 deletions
diff --git a/guix/cve.scm b/guix/cve.scm
index a7b0bde6dc..8e76f42f0d 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -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.
 ;;;
@@ -49,29 +49,45 @@
   (id         vulnerability-id)
   (packages   vulnerability-packages))
 
-(define %cve-feed-uri
+(define %now
+  (current-date))
+(define %current-year
+  (date-year %now))
+(define %past-year
+  (- %current-year 1))
+
+(define (yearly-feed-uri year)
+  "Return the URI for the CVE feed for YEAR."
   (string->uri
-   "https://nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-Modified.xml.gz"))
+   (string-append "https://static.nvd.nist.gov/feeds/xml/cve/nvdcve-2.0-"
+                  (number->string year) ".xml.gz")))
 
-(define %ttl
+(define %current-year-ttl
   ;; According to <https://nvd.nist.gov/download.cfm#CVE_FEED>, feeds are
   ;; updated "approximately every two hours."
   (* 3600 3))
 
-(define (call-with-cve-port proc)
+(define %past-year-ttl
+  ;; Update the previous year's database more and more infrequently.
+  (* 3600 24 2 (date-month %now)))
+
+(define (call-with-cve-port uri ttl proc)
   "Pass PROC an input port from which to read the CVE stream."
-  (let ((port (http-fetch/cached %cve-feed-uri #:ttl %ttl)))
+  (let ((port (http-fetch/cached uri #:ttl ttl)))
     (dynamic-wind
       (const #t)
       (lambda ()
         (call-with-decompressed-port 'gzip port
-          proc))
+          (lambda (port)
+            (setvbuf port _IOFBF 65536)
+            (proc port))))
       (lambda ()
         (close-port port)))))
 
 (define %cpe-package-rx
-  ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION".
-  (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)"))
+  ;; For applications: "cpe:/a:VENDOR:PACKAGE:VERSION", or sometimes
+  ;; "cpe/a:VENDOR:PACKAGE:VERSION:PATCH-LEVEL".
+  (make-regexp "^cpe:/a:([^:]+):([^:]+):([^:]+)((:.+)?)"))
 
 (define (cpe->package-name cpe)
   "Converts the Common Platform Enumeration (CPE) string CPE to a package
@@ -80,7 +96,13 @@ CPE string."
   (and=> (regexp-exec %cpe-package-rx (string-trim-both cpe))
          (lambda (matches)
            (cons (match:substring matches 2)
-                 (match:substring matches 3)))))
+                 (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))))))))
 
 (define %parse-vulnerability-feed
   ;; Parse the XML vulnerability feed from
@@ -135,12 +157,19 @@ vulnerability objects."
 (define (current-vulnerabilities)
   "Return the current list of Common Vulnerabilities and Exposures (CVE) as
 published by the US NIST."
-  (call-with-cve-port
-   (lambda (port)
-     ;; XXX: The SSAX "error port" is used to send pointless warnings such as
-     ;; "warning: Skipping PI".  Turn that off.
-     (parameterize ((current-ssax-error-port (%make-void-port "w")))
-       (xml->vulnerabilities port)))))
+  (define (read-vulnerabilities uri ttl)
+    (call-with-cve-port uri ttl
+      (lambda (port)
+        ;; XXX: The SSAX "error port" is used to send pointless warnings such as
+        ;; "warning: Skipping PI".  Turn that off.
+        (parameterize ((current-ssax-error-port (%make-void-port "w")))
+          (xml->vulnerabilities port)))))
+
+  (append-map read-vulnerabilities
+              (list (yearly-feed-uri %past-year)
+                    (yearly-feed-uri %current-year))
+              (list %past-year-ttl
+                    %current-year-ttl)))
 
 (define (vulnerabilities->lookup-proc vulnerabilities)
   "Return a lookup procedure built from VULNERABILITIES that takes a package
@@ -174,4 +203,9 @@ a list of vulnerabilities affection the given package version."
                  '()
                  package table)))
 
+
+;;; Local Variables:
+;;; eval: (put 'call-with-cve-port 'scheme-indent-function 2)
+;;; End:
+
 ;;; cve.scm ends here