bug#42299: ‘guix lint’ should suggest CPE name

[Ludovic Courtès]

Hello!

On IRC earlier today we were looking at
<https://repology.org/repository/gnuguix/problems> and wondering about
the CPE suggestions (which are nice!).

I tried the attached hack, which produces a few useless and sometimes
erroneous suggestions, by comparing the “references” of each CVE
(usually URLs of a security advisory or bug report) to the home page of
the package:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env  guix lint -c cpe
gnu/packages/admin.scm:1103:2: tcpdump@4.9.3: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1103:2: tcpdump@4.9.3: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1103:2: tcpdump@4.9.3: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1103:2: tcpdump@4.9.3: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1103:2: tcpdump@4.9.3: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:2866:2: pam-krb5@4.8: suggested CPE name: 'pam-krb5'
gnu/packages/admin.scm:1075:2: libpcap@1.9.1: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1075:2: libpcap@1.9.1: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1075:2: libpcap@1.9.1: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1075:2: libpcap@1.9.1: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1075:2: libpcap@1.9.1: suggested CPE name: 'libpcap'
gnu/packages/admin.scm:1367:2: sudo@1.9.1: suggested CPE name: 
'element_software_management_node'
gnu/packages/admin.scm:1367:2: sudo@1.9.1: suggested CPE name: 'sudo'
gnu/packages/admin.scm:1367:2: sudo@1.9.1: suggested CPE name: 'sudo'
gnu/packages/admin.scm:1367:2: sudo@1.9.1: suggested CPE name: 'sudo'
gnu/packages/admin.scm:614:2: shadow@4.8.1: suggested CPE name: 'shadow'
gnu/packages/aspell.scm:99:2: aspell-dict-ar@1.2-0: suggested CPE name: 'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-mi@0.50-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-pl@0.51-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-ru@0.99f7-1: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-sv@0.51-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-fr@0.50-3: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-pt-br@20131030-12-0: suggested CPE 
name: 'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-el@0.08-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-hi@0.02-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-de@20161207-7-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-be@0.01: suggested CPE name: 'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-es@1.11-2: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-grc@0.02-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-fi@0.7-0: suggested CPE name: 'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-da@1.6.36-11-0: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:99:2: aspell-dict-nl@0.50-2: suggested CPE name: 
'aspell'
gnu/packages/aspell.scm:41:2: aspell@0.60.8: suggested CPE name: 'aspell'
[…]
--8<---------------cut here---------------end--------------->8---

The conclusion is that, to make good suggestions, we need to parse the
CPE dictionary as well:

  https://nvd.nist.gov/Products/CPE

This one is still XML (not JSON) and we’d have to merge duplicates, as
in this example:

--8<---------------cut here---------------start------------->8---
  <cpe-item name="cpe:/a:gnu:cpio:-">
    <title xml:lang="en-US">GNU cpio</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:-:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:1.0">
    <title xml:lang="en-US">GNU cpio 1.0</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:1.0:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:1.1">
    <title xml:lang="en-US">GNU cpio 1.1</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:1.1:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:1.2">
    <title xml:lang="en-US">GNU cpio 1.2</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:1.2:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:1.3">
    <title xml:lang="en-US">GNU cpio 1.3</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:1.3:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:2.4-2">
    <title xml:lang="en-US">GNU cpio 2.4.2</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:2.4-2:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:2.5">
    <title xml:lang="en-US">GNU cpio 2.5</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:2.5:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:2.5.90">
    <title xml:lang="en-US">GNU cpio 2.5.90</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:2.5.90:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:2.6">
    <title xml:lang="en-US">GNU cpio 2.6</title>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:2.6:*:*:*:*:*:*:*"/>
  </cpe-item>
  <cpe-item name="cpe:/a:gnu:cpio:2.7">
    <title xml:lang="en-US">GNU cpio 2.7</title>
    <references>
      <reference href="https://ftp.gnu.org/gnu/cpio/";>Change Log</reference>
    </references>
    <cpe-23:cpe23-item name="cpe:2.3:a:gnu:cpio:2.7:*:*:*:*:*:*:*"/>
  </cpe-item>
 --8<---------------cut here---------------end--------------->8---

The references are not always useful, as above, but sometimes there’s a
“Product” reference that is the package home page.

Anyway, would be nice to add that to (guix cve) instead of succumbing to
the convenience of SaaSS!

Ludo’.

diff --git a/guix/cve.scm b/guix/cve.scm
index 7dd9005f09..52a19e0523 100644
--- a/guix/cve.scm
+++ b/guix/cve.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès 
<ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +54,7 @@
             vulnerability?
             vulnerability-id
             vulnerability-packages
+            vulnerability-references
 
             json->vulnerabilities
             current-vulnerabilities
@@ -255,20 +256,23 @@ records."
   (* 3600 24 (date-month %now)))
 
 (define-record-type <vulnerability>
-  (vulnerability id packages)
+  (vulnerability id packages references)
   vulnerability?
   (id         vulnerability-id)             ;string
-  (packages   vulnerability-packages))      ;((p1 sexp1) (p2 sexp2) ...)
+  (packages   vulnerability-packages)       ;((p1 sexp1) (p2 sexp2) ...)
+  (references vulnerability-references))    ;list of URLs
 
 (define vulnerability->sexp
   (match-lambda
-    (($ <vulnerability> id packages)
-     `(v ,id ,packages))))
+    (($ <vulnerability> id packages references)
+     `(v ,id ,packages ,references))))
 
 (define sexp->vulnerability
   (match-lambda
-    (('v id (packages ...))
-     (vulnerability id packages))))
+    (('v id (packages ...) (references ...))      ;format version 2
+     (vulnerability id packages references))
+    (('v id (packages ...))                       ;format version 1
+     (vulnerability id packages '()))))
 
 (define (cve-configuration->package-list config)
   "Parse CONFIG, a config sexp, and return a list of the form (P SEXP)
@@ -313,20 +317,23 @@ versions."
   "Return a <vulnerability> corresponding to ITEM, a <cve-item> record;
 return #f if ITEM does not list any configuration or if it does not list
 any \"a\" (application) configuration."
-  (let ((id (cve-id (cve-item-cve item))))
+  (let ((id         (cve-id (cve-item-cve item)))
+        (references (cve-references (cve-item-cve item))))
     (match (cve-item-configurations item)
       (()                                         ;no configurations
        #f)
       ((configs ...)
        (vulnerability id
                       (merge-package-lists
-                       (map cve-configuration->package-list configs)))))))
+                       (map cve-configuration->package-list configs))
+                      (filter-map cve-reference-url references))))))
 
 (define (json->vulnerabilities json)
   "Parse JSON, an input port or a string, and return the list of
 vulnerabilities found therein."
   (filter-map cve-item->vulnerability (json->cve-items json)))
 
+(use-modules (ice-9 pretty-print))
 (define (write-cache input cache)
   "Read vulnerabilities as gzipped JSON from INPUT, and write it as a compact
 sexp to CACHE."
@@ -335,8 +342,8 @@ sexp to CACHE."
       (define vulns
         (json->vulnerabilities input))
 
-      (write `(vulnerabilities
-               1                                  ;format version
+      (pretty-print `(vulnerabilities
+               2                                  ;format version
                ,(map vulnerability->sexp vulns))
              cache))))
 
@@ -369,7 +376,7 @@ the given TTL (fetch from the NIST web site when TTL has 
expired)."
          (sexp (read* port)))
     (close-port port)
     (match sexp
-      (('vulnerabilities 1 vulns)
+      (('vulnerabilities (or 2 1) vulns)
        (map sexp->vulnerability vulns)))))
 
 (define (current-vulnerabilities)
diff --git a/guix/lint.scm b/guix/lint.scm
index 445c06f8f4..6b65df34a3 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1108,6 +1108,23 @@ vulnerability records for PACKAGE by calling 
PACKAGE-VULNERABILITIES."
                (list (string-join (map vulnerability-id unpatched)
                                   ", "))))))))))
 
+(define* (check-cpe-name package
+                         #:optional (vulnerabilities
+                                     (current-vulnerabilities*)))
+  (define home-page
+    (package-home-page package))
+
+  (filter-map (lambda (vuln)
+                (and (any (cut string-prefix? home-page <>)
+                          (vulnerability-references vuln))
+                     (make-warning
+                      package
+                      (G_ "suggested CPE name: '~a'")
+                      (match (vulnerability-packages vuln)
+                        (((p _) _ ...)
+                         (list p))))))
+              vulnerabilities))
+
 (define (check-for-updates package)
   "Check if there is an update available for PACKAGE."
   (match (with-networking-fail-safe
@@ -1426,6 +1443,10 @@ or a list thereof")
      (description "Check the Common Vulnerabilities and Exposures\
  (CVE) database")
      (check       check-vulnerabilities))
+   (lint-checker
+     (name        'cpe)
+     (description "Check the Common Platform Enumeration names")
+     (check       check-cpe-name))
    (lint-checker
      (name        'refresh)
      (description "Check the package for new upstream releases")