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:
parent
0f7cd95b81
commit
9bee2bd1b0
|
@ -683,25 +683,25 @@ from ~s: ~a (~s)~%")
|
||||||
|
|
||||||
(define (check-vulnerabilities package)
|
(define (check-vulnerabilities package)
|
||||||
"Check for known vulnerabilities for PACKAGE."
|
"Check for known vulnerabilities for PACKAGE."
|
||||||
(match (package-vulnerabilities package)
|
(let ((package (or (package-replacement package) package)))
|
||||||
(()
|
(match (package-vulnerabilities package)
|
||||||
#t)
|
(()
|
||||||
((vulnerabilities ...)
|
#t)
|
||||||
(let* ((package (or (package-replacement package) package))
|
((vulnerabilities ...)
|
||||||
(patches (filter-map patch-file-name
|
(let* ((patches (filter-map patch-file-name
|
||||||
(or (and=> (package-source package)
|
(or (and=> (package-source package)
|
||||||
origin-patches)
|
origin-patches)
|
||||||
'())))
|
'())))
|
||||||
(unpatched (remove (lambda (vuln)
|
(unpatched (remove (lambda (vuln)
|
||||||
(find (cute string-contains
|
(find (cute string-contains
|
||||||
<> (vulnerability-id vuln))
|
<> (vulnerability-id vuln))
|
||||||
patches))
|
patches))
|
||||||
vulnerabilities)))
|
vulnerabilities)))
|
||||||
(unless (null? unpatched)
|
(unless (null? unpatched)
|
||||||
(emit-warning package
|
(emit-warning package
|
||||||
(format #f (_ "probably vulnerable to ~a")
|
(format #f (_ "probably vulnerable to ~a")
|
||||||
(string-join (map vulnerability-id unpatched)
|
(string-join (map vulnerability-id unpatched)
|
||||||
", "))))))))
|
", ")))))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -36,6 +36,7 @@
|
||||||
#:use-module (web server)
|
#:use-module (web server)
|
||||||
#:use-module (web server http)
|
#:use-module (web server http)
|
||||||
#:use-module (web response)
|
#:use-module (web response)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 threads)
|
#:use-module (ice-9 threads)
|
||||||
#:use-module (srfi srfi-9 gnu)
|
#:use-module (srfi srfi-9 gnu)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64))
|
||||||
|
@ -613,6 +614,28 @@ string) on HTTP requests."
|
||||||
(patches
|
(patches
|
||||||
(list "/a/b/pi-CVE-2015-1234.patch"))))))))))
|
(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"
|
(test-assert "cve: patched vulnerability in replacement"
|
||||||
(mock ((guix scripts lint) package-vulnerabilities
|
(mock ((guix scripts lint) package-vulnerabilities
|
||||||
(lambda (package)
|
(lambda (package)
|
||||||
|
|
Loading…
Reference in New Issue