packages: Add 'package-patched-vulnerabilities'.
* guix/packages.scm (patch-file-name): New procedure.
(%vulnerability-regexp): New variable.
(package-patched-vulnerabilities): New procedure.
* guix/scripts/lint.scm (patch-file-name): Remove.
(check-vulnerabilities): Adjust to use
'package-patched-vulnerabilities'.
* tests/packages.scm ("package-patched-vulnerabilities"): New test.
master
Ludovic Courtès
parent
efcb4441f1
commit
c423ae8918
|
|
@ -35,6 +35,7 @@
|
|||
#:use-module (guix sets)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (srfi srfi-11)
|
||||
|
|
@ -106,6 +107,7 @@
|
|||
package-cross-derivation
|
||||
package-output
|
||||
package-grafts
|
||||
package-patched-vulnerabilities
|
||||
package/inherit
|
||||
|
||||
transitive-input-references
|
||||
|
|
@ -394,6 +396,32 @@ DELIMITER (a string), you can customize what will appear between the name and
|
|||
the version. By default, DELIMITER is \"@\"."
|
||||
(string-append (package-name package) delimiter (package-version package)))
|
||||
|
||||
(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 %vulnerability-regexp
|
||||
;; Regexp matching a CVE identifier in patch file names.
|
||||
(make-regexp "CVE-[0-9]{4}-[0-9]+"))
|
||||
|
||||
(define (package-patched-vulnerabilities package)
|
||||
"Return the list of patched vulnerabilities of PACKAGE as a list of CVE
|
||||
identifiers. The result is inferred from the file names of patches."
|
||||
(define (patch-vulnerabilities patch)
|
||||
(map (cut match:substring <> 0)
|
||||
(list-matches %vulnerability-regexp patch)))
|
||||
|
||||
(let ((patches (filter-map patch-file-name
|
||||
(or (and=> (package-source package)
|
||||
origin-patches)
|
||||
'()))))
|
||||
(append-map patch-vulnerabilities patches)))
|
||||
|
||||
(define (%standard-patch-inputs)
|
||||
(let* ((canonical (module-ref (resolve-interface '(gnu packages base))
|
||||
'canonical-package))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
|
||||
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
|
||||
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
|
||||
|
|
@ -809,15 +809,6 @@ descriptions maintained upstream."
|
|||
(emit-warning package (G_ "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 (call-with-networking-fail-safe message error-value proc)
|
||||
"Call PROC catching any network-related errors. Upon a networking error,
|
||||
display a message including MESSAGE and return ERROR-VALUE."
|
||||
|
|
@ -878,20 +869,14 @@ the NIST server non-fatal."
|
|||
(()
|
||||
#t)
|
||||
((vulnerabilities ...)
|
||||
(let* ((patches (filter-map patch-file-name
|
||||
(or (and=> (package-source package)
|
||||
origin-patches)
|
||||
'())))
|
||||
(let* ((patched (package-patched-vulnerabilities package))
|
||||
(known-safe (or (assq-ref (package-properties package)
|
||||
'lint-hidden-cve)
|
||||
'()))
|
||||
(unpatched (remove (lambda (vuln)
|
||||
(let ((id (vulnerability-id vuln)))
|
||||
(or
|
||||
(find (cute string-contains
|
||||
<> id)
|
||||
patches)
|
||||
(member id known-safe))))
|
||||
(or (member id patched)
|
||||
(member id known-safe))))
|
||||
vulnerabilities)))
|
||||
(unless (null? unpatched)
|
||||
(emit-warning package
|
||||
|
|
|
|||
|
|
@ -959,6 +959,21 @@
|
|||
((("x" dep))
|
||||
(eq? dep findutils)))))))))
|
||||
|
||||
(test-equal "package-patched-vulnerabilities"
|
||||
'(("CVE-2015-1234")
|
||||
("CVE-2016-1234" "CVE-2018-4567")
|
||||
())
|
||||
(let ((p1 (dummy-package "pi"
|
||||
(source (dummy-origin
|
||||
(patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
|
||||
(p2 (dummy-package "pi"
|
||||
(source (dummy-origin
|
||||
(patches (list
|
||||
"/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
|
||||
(p3 (dummy-package "pi" (source (dummy-origin)))))
|
||||
(map package-patched-vulnerabilities
|
||||
(list p1 p2 p3))))
|
||||
|
||||
(test-eq "fold-packages" hello
|
||||
(fold-packages (lambda (p r)
|
||||
(if (string=? (package-name p) "hello")
|
||||
|
|
|
|||
Loading…
Reference in New Issue