02/03: lint: Do not report already-patched vulnerabilities.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 4e70fe4d0efbb29d47e3d83d36d6c15f92baebb0
Author: Ludovic Courtès <address@hidden>
Date:   Sat Nov 28 16:15:31 2015 +0100

    lint: Do not report already-patched vulnerabilities.
    
    * guix/scripts/lint.scm (patch-file-name): New procedure.
    (check-vulnerabilities): Use it to filter out patched vulnerabilities.
    * tests/lint.scm ("cve: one patched vulnerability"): New test.
---
 guix/scripts/lint.scm |   27 +++++++++++++++++++++++----
 tests/lint.scm        |   17 +++++++++++++++++
 2 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1da4790..338c7e8 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -573,6 +573,15 @@ descriptions maintained upstream."
      (emit-warning package (_ "invalid license field")
                    'license))))
 
+(define (patch-file-name patch)
+  "Return the basename of PATCH's file name, or #f if the file name could not
+be determined."
+  (match patch
+    ((? string?)
+     (basename patch))
+    ((? origin?)
+     (and=> (origin-actual-file-name patch) basename))))
+
 (define (package-name->cpe-name name)
   "Do a basic conversion of NAME, a Guix package name, to the corresponding
 Common Platform Enumeration (CPE) name."
@@ -596,10 +605,20 @@ Common Platform Enumeration (CPE) name."
     (()
      #t)
     ((vulnerabilities ...)
-     (emit-warning package
-                   (format #f (_ "probably vulnerable to ~a")
-                           (string-join (map vulnerability-id vulnerabilities)
-                                        ", "))))))
+     (let* ((patches   (filter-map patch-file-name
+                                   (or (and=> (package-source package)
+                                              origin-patches)
+                                       '())))
+            (unpatched (remove (lambda (vuln)
+                                 (find (cute string-contains
+                                         <> (vulnerability-id vuln))
+                                       patches))
+                               vulnerabilities)))
+       (unless (null? unpatched)
+         (emit-warning package
+                       (format #f (_ "probably vulnerable to ~a")
+                               (string-join (map vulnerability-id unpatched)
+                                            ", "))))))))
 
 
 ;;;
diff --git a/tests/lint.scm b/tests/lint.scm
index 50316ad..df82593 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -529,6 +529,23 @@ requests."
            (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
          "vulnerable to CVE-2015-1234")))
 
+(test-assert "cve: one patched 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-null?
+         (with-warnings
+           (check-vulnerabilities
+            (dummy-package "pi"
+                           (version "3.14")
+                           (source
+                            (dummy-origin
+                             (patches
+                              (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
+
 (test-assert "formatting: lonely parentheses"
   (string-contains
    (with-warnings