ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: Add 'package-patched-vulnerabilities'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2018-05-13 18:46:13 +02:00
parent efcb4441f1
commit c423ae8918
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 47 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
guix/packages.scm
View file

@ -35,6 +35,7 @@ (define-module (guix packages)
#: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 @@ (define-module (guix packages)
package-cross-derivation
package-output
package-grafts
package-patched-vulnerabilities
package/inherit
transitive-input-references
@ -394,6 +396,32 @@ (define* (package-full-name package #:optional (delimiter "@"))
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))

21
guix/scripts/lint.scm
View file

@ -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 @@ (define (check-license package)
(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,19 +869,13 @@ (define (check-vulnerabilities package)
(()
#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)
(or (member id patched)
(member id known-safe))))
vulnerabilities)))
(unless (null? unpatched)

15
tests/packages.scm
View file

@ -959,6 +959,21 @@ (define read-at
((("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")