~ruther/guix-local

5432734b00ae14c3a93af358fc7bbf80e3db5ee8 — Ludovic Courtès 10 years ago 0eef755
lint: Add "cve" checker.

Fixes <http://bugs.gnu.org/21289>.

* guix/scripts/lint.scm (package-name->cpe-name, package-vulnerabilities)
(check-vulnerabilities): New procedures.
* guix/scripts/lint.scm (%checkers): Add "cve" checker.
* tests/lint.scm ("cve", "cve: one vulnerability"): New tests.
* doc/guix.texi (Invoking guix lint): Mention it.
3 files changed, 58 insertions(+), 0 deletions(-)

M doc/guix.texi
M guix/scripts/lint.scm
M tests/lint.scm
M doc/guix.texi => doc/guix.texi +6 -0
@@ 4452,6 4452,12 @@ invalid.  Check that the source file name is meaningful, e.g. is not
just a version number or ``git-checkout'', and should not have a
@code{file-name} declared (@pxref{origin Reference}).

@item cve
Report known vulnerabilities found in the Common Vulnerabilities and
Exposures (CVE) database
@uref{https://nvd.nist.gov/download.cfm#CVE_FEED, published by the US
NIST}.

@item formatting
Warn about obvious source code formatting issues: trailing white space,
use of tabulations, etc.

M guix/scripts/lint.scm => guix/scripts/lint.scm +35 -0
@@ 32,6 32,7 @@
  #:use-module (guix scripts)
  #:use-module (guix gnu-maintenance)
  #:use-module (guix monads)
  #:use-module (guix cve)
  #:use-module (gnu packages)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)


@@ 61,6 62,7 @@
            check-source
            check-source-file-name
            check-license
            check-vulnerabilities
            check-formatting
            run-checkers



@@ 571,6 573,34 @@ descriptions maintained upstream."
     (emit-warning package (_ "invalid license field")
                   'license))))

(define (package-name->cpe-name name)
  "Do a basic conversion of NAME, a Guix package name, to the corresponding
Common Platform Enumeration (CPE) name."
  (match name
    ("icecat"   "firefox")                        ;or "firefox_esr"
    ;; TODO: Add more.
    (_          name)))

(define package-vulnerabilities
  (let ((lookup (delay (vulnerabilities->lookup-proc
                        (current-vulnerabilities)))))
    (lambda (package)
      "Return a list of vulnerabilities affecting PACKAGE."
      ((force lookup)
       (package-name->cpe-name (package-name package))
       (package-version package)))))

(define (check-vulnerabilities package)
  "Check for known vulnerabilities for PACKAGE."
  (match (package-vulnerabilities package)
    (()
     #t)
    ((vulnerabilities ...)
     (emit-warning package
                   (format #f (_ "probably vulnerable to ~a")
                           (string-join (map vulnerability-id vulnerabilities)
                                        ", "))))))


;;;
;;; Source code formatting.


@@ 709,6 739,11 @@ or a list thereof")
     (description "Validate package synopses")
     (check       check-synopsis-style))
   (lint-checker
     (name        'cve)
     (description "Check the Common Vulnerabilities and Exposures\
 (CVE) database")
     (check       check-vulnerabilities))
   (lint-checker
     (name        'formatting)
     (description "Look for formatting issues in the source")
     (check       check-formatting))))

M tests/lint.scm => tests/lint.scm +17 -0
@@ 512,6 512,23 @@ requests."
          (check-source pkg))))
    "not reachable: 404")))

(test-assert "cve"
  (mock ((guix scripts lint) package-vulnerabilities (const '()))
        (string-null?
         (with-warnings (check-vulnerabilities (dummy-package "x"))))))

(test-assert "cve: one 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-contains
         (with-warnings
           (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
         "vulnerable to CVE-2015-1234")))

(test-assert "formatting: lonely parentheses"
  (string-contains
   (with-warnings