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.
This commit is contained in:
Ludovic Courtès 2016-10-03 23:30:49 +02:00
parent 0f7cd95b81
commit 9bee2bd1b0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 42 additions and 19 deletions

View File

@ -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)
", ")))))))))
;;;

View File

@ -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)