aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/packages.scm28
-rw-r--r--guix/scripts/lint.scm23
-rw-r--r--tests/packages.scm15
3 files changed, 47 insertions, 19 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index a6f9936d63..c762fa7c39 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index cd802985dc..e477bf0ddc 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -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
diff --git a/tests/packages.scm b/tests/packages.scm
index f1e7d3119b..65ccb14889 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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")