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.
This commit is contained in:
Ludovic Courtès 2015-11-28 16:15:31 +01:00
parent f6c9fb1b38
commit 4e70fe4d0e
2 changed files with 40 additions and 4 deletions

View file

@ -573,6 +573,15 @@ (define (check-license package)
(emit-warning package (_ "invalid license field") (emit-warning package (_ "invalid license field")
'license)))) '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) (define (package-name->cpe-name name)
"Do a basic conversion of NAME, a Guix package name, to the corresponding "Do a basic conversion of NAME, a Guix package name, to the corresponding
Common Platform Enumeration (CPE) name." Common Platform Enumeration (CPE) name."
@ -596,10 +605,20 @@ (define (check-vulnerabilities package)
(() (()
#t) #t)
((vulnerabilities ...) ((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 (emit-warning package
(format #f (_ "probably vulnerable to ~a") (format #f (_ "probably vulnerable to ~a")
(string-join (map vulnerability-id vulnerabilities) (string-join (map vulnerability-id unpatched)
", ")))))) ", "))))))))
;;; ;;;

View file

@ -529,6 +529,23 @@ (define-syntax-rule (with-warnings body ...)
(check-vulnerabilities (dummy-package "pi" (version "3.14")))) (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
"vulnerable to CVE-2015-1234"))) "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" (test-assert "formatting: lonely parentheses"
(string-contains (string-contains
(with-warnings (with-warnings