03/04: lint: Add "cve" checker.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 5432734b00ae14c3a93af358fc7bbf80e3db5ee8
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 26 22:59:06 2015 +0100

    lint: Add "cve" checker.
    
    Fixes <http://bugs.gnu.org/21289>.
    
    * guix/scripts/lint.scm (package-name->cpe-name, package-vulnerabilities)
    (check-vulnerabilities): New procedures.
    * guix/scripts/lint.scm (%checkers): Add "cve" checker.
    * tests/lint.scm ("cve", "cve: one vulnerability"): New tests.
    * doc/guix.texi (Invoking guix lint): Mention it.
---
 doc/guix.texi         |    6 ++++++
 guix/scripts/lint.scm |   35 +++++++++++++++++++++++++++++++++++
 tests/lint.scm        |   17 +++++++++++++++++
 3 files changed, 58 insertions(+), 0 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 058b359..8ecb7cc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4452,6 +4452,12 @@ invalid.  Check that the source file name is meaningful, 
e.g. is not
 just a version number or ``git-checkout'', and should not have a
 @code{file-name} declared (@pxref{origin Reference}).
 
address@hidden cve
+Report known vulnerabilities found in the Common Vulnerabilities and
+Exposures (CVE) database
address@hidden://nvd.nist.gov/download.cfm#CVE_FEED, published by the US
+NIST}.
+
 @item formatting
 Warn about obvious source code formatting issues: trailing white space,
 use of tabulations, etc.
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 034f0f9..1da4790 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -32,6 +32,7 @@
   #:use-module (guix scripts)
   #:use-module (guix gnu-maintenance)
   #:use-module (guix monads)
+  #:use-module (guix cve)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -61,6 +62,7 @@
             check-source
             check-source-file-name
             check-license
+            check-vulnerabilities
             check-formatting
             run-checkers
 
@@ -571,6 +573,34 @@ descriptions maintained upstream."
      (emit-warning package (_ "invalid license field")
                    'license))))
 
+(define (package-name->cpe-name name)
+  "Do a basic conversion of NAME, a Guix package name, to the corresponding
+Common Platform Enumeration (CPE) name."
+  (match name
+    ("icecat"   "firefox")                        ;or "firefox_esr"
+    ;; TODO: Add more.
+    (_          name)))
+
+(define package-vulnerabilities
+  (let ((lookup (delay (vulnerabilities->lookup-proc
+                        (current-vulnerabilities)))))
+    (lambda (package)
+      "Return a list of vulnerabilities affecting PACKAGE."
+      ((force lookup)
+       (package-name->cpe-name (package-name package))
+       (package-version package)))))
+
+(define (check-vulnerabilities package)
+  "Check for known vulnerabilities for PACKAGE."
+  (match (package-vulnerabilities package)
+    (()
+     #t)
+    ((vulnerabilities ...)
+     (emit-warning package
+                   (format #f (_ "probably vulnerable to ~a")
+                           (string-join (map vulnerability-id vulnerabilities)
+                                        ", "))))))
+
 
 ;;;
 ;;; Source code formatting.
@@ -709,6 +739,11 @@ or a list thereof")
      (description "Validate package synopses")
      (check       check-synopsis-style))
    (lint-checker
+     (name        'cve)
+     (description "Check the Common Vulnerabilities and Exposures\
+ (CVE) database")
+     (check       check-vulnerabilities))
+   (lint-checker
      (name        'formatting)
      (description "Look for formatting issues in the source")
      (check       check-formatting))))
diff --git a/tests/lint.scm b/tests/lint.scm
index 3f14956..50316ad 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -512,6 +512,23 @@ requests."
           (check-source pkg))))
     "not reachable: 404")))
 
+(test-assert "cve"
+  (mock ((guix scripts lint) package-vulnerabilities (const '()))
+        (string-null?
+         (with-warnings (check-vulnerabilities (dummy-package "x"))))))
+
+(test-assert "cve: one vulnerability"
+  (mock ((guix scripts lint) package-vulnerabilities
+         (lambda (package)
+           (list (make-struct (@@ (guix cve) <vulnerability>) 0
+                              "CVE-2015-1234"
+                              (list (cons (package-name package)
+                                          (package-version package)))))))
+        (string-contains
+         (with-warnings
+           (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
+         "vulnerable to CVE-2015-1234")))
+
 (test-assert "formatting: lonely parentheses"
   (string-contains
    (with-warnings