01/01: lint: 'cve' checker reports the replacement's vulnerabilities.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 9bee2bd1b02c7ef91cc7232e8647bd07525d3382
Author: Ludovic Courtès <address@hidden>
Date:   Mon Oct 3 23:30:49 2016 +0200

    lint: 'cve' checker reports the replacement's vulnerabilities.
    
    Before, 'guix lint -c cve' would report the vulnerabilities of the
    original package while pretending they are the vulnerabilities of the
    replacement.
    
    * guix/scripts/lint.scm (check-vulnerabilities): Consider the package
    replacement before calling 'package-vulnerabilities'.
    * tests/lint.scm ("cve: vulnerability fixed in replacement version"):
    New test.
---
 guix/scripts/lint.scm |   38 +++++++++++++++++++-------------------
 tests/lint.scm        |   23 +++++++++++++++++++++++
 2 files changed, 42 insertions(+), 19 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index eac3214..b3ec6d6 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -683,25 +683,25 @@ from ~s: ~a (~s)~%")
 
 (define (check-vulnerabilities package)
   "Check for known vulnerabilities for PACKAGE."
-  (match (package-vulnerabilities package)
-    (()
-     #t)
-    ((vulnerabilities ...)
-     (let* ((package   (or (package-replacement package) package))
-            (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)
-                                            ", "))))))))
+  (let ((package (or (package-replacement package) package)))
+    (match (package-vulnerabilities package)
+      (()
+       #t)
+      ((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 df69d2b..d692b42 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -36,6 +36,7 @@
   #:use-module (web server)
   #:use-module (web server http)
   #:use-module (web response)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-64))
@@ -613,6 +614,28 @@ string) on HTTP requests."
                              (patches
                               (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
 
+(test-assert "cve: vulnerability fixed in replacement version"
+  (mock ((guix scripts lint) package-vulnerabilities
+         (lambda (package)
+           (match (package-version package)
+             ("0"
+              (list (make-struct (@@ (guix cve) <vulnerability>) 0
+                                 "CVE-2015-1234"
+                                 (list (cons (package-name package)
+                                             (package-version package))))))
+             ("1"
+              '()))))
+        (and (not (string-null?
+                   (with-warnings
+                     (check-vulnerabilities
+                      (dummy-package "foo" (version "0"))))))
+             (string-null?
+              (with-warnings
+                (check-vulnerabilities
+                 (dummy-package
+                  "foo" (version "0")
+                  (replacement (dummy-package "foo" (version "1"))))))))))
+
 (test-assert "cve: patched vulnerability in replacement"
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)