From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:37881) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fI8p0-0005TA-En for guix-patches@gnu.org; Mon, 14 May 2018 04:27:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fI8oy-0003Wx-SB for guix-patches@gnu.org; Mon, 14 May 2018 04:27:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:53531) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fI8oy-0003Wq-Ny for guix-patches@gnu.org; Mon, 14 May 2018 04:27:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fI8oy-0007cF-IN for guix-patches@gnu.org; Mon, 14 May 2018 04:27:04 -0400 Subject: [bug#31442] [PATCH 2/5] packages: Add 'package-patched-vulnerabilities'. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Mon, 14 May 2018 10:25:47 +0200 Message-Id: <20180514082550.1131-2-ludo@gnu.org> In-Reply-To: <20180514082550.1131-1-ludo@gnu.org> References: <20180514082550.1131-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 31442@debbugs.gnu.org * 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. --- guix/packages.scm | 28 ++++++++++++++++++++++++++++ guix/scripts/lint.scm | 23 ++++------------------- tests/packages.scm | 15 +++++++++++++++ 3 files changed, 47 insertions(+), 19 deletions(-) diff --git a/guix/packages.scm b/guix/packages.scm index e0ab72086..f536597ae 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 cd802985d..e477bf0dd 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 ;;; Copyright © 2014, 2015 Eric Bavier -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2016 Danny Milosavljevic ;;; Copyright © 2016 Hartmut Goebel @@ -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 9e19c3992..642a3efa5 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -941,6 +941,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") -- 2.17.0