~ruther/guix-local

4e70fe4d0efbb29d47e3d83d36d6c15f92baebb0 — Ludovic Courtès 10 years ago f6c9fb1
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.
2 files changed, 40 insertions(+), 4 deletions(-)

M guix/scripts/lint.scm
M tests/lint.scm
M guix/scripts/lint.scm => guix/scripts/lint.scm +23 -4
@@ 573,6 573,15 @@ descriptions maintained upstream."
     (emit-warning package (_ "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 (package-name->cpe-name name)
  "Do a basic conversion of NAME, a Guix package name, to the corresponding
Common Platform Enumeration (CPE) name."


@@ 596,10 605,20 @@ Common Platform Enumeration (CPE) name."
    (()
     #t)
    ((vulnerabilities ...)
     (emit-warning package
                   (format #f (_ "probably vulnerable to ~a")
                           (string-join (map vulnerability-id 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
                       (format #f (_ "probably vulnerable to ~a")
                               (string-join (map vulnerability-id unpatched)
                                            ", "))))))))


;;;

M tests/lint.scm => tests/lint.scm +17 -0
@@ 529,6 529,23 @@ requests."
           (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
         "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"
  (string-contains
   (with-warnings