[bug#46182] [PATCH] lint: Add 'check-git-protocol' checker.

[Leo Famulari <leo@famulari.name>]

We could also make it warn about use of the HTTP protocol (as opposed to
HTTPS). Your thoughts?

* guix/lint.scm (check-git-protocol): New procedure.
(%local-checkers): Add 'git-protocol' checker.
* doc/guix.texi (Invoking guix lint): Document it.
---
 doc/guix.texi |  6 +++++-
 guix/lint.scm | 25 ++++++++++++++++++++++++-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ff9e8da2e0..d17e2f2e96 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -28,7 +28,7 @@ Copyright @copyright{} 2014, 2015, 2016 Alex Kost@*
 Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
 Copyright @copyright{} 2014 Pierre-Antoine Rault@*
 Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
-Copyright @copyright{} 2015, 2016, 2017, 2019, 2020 Leo Famulari@*
+Copyright @copyright{} 2015, 2016, 2017, 2019, 2020, 2021 Leo Famulari@*
 Copyright @copyright{} 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
 Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
@@ -11736,6 +11736,10 @@ Parse the @code{source} URL to determine if a tarball from GitHub is
 autogenerated or if it is a release tarball.  Unfortunately GitHub's
 autogenerated tarballs are sometimes regenerated.
 
+@item git-protocol
+Check if the package's source code is fetched using the insecure @code{git://}
+protocol.
+
 @item derivation
 Check that the derivation of the given packages can be successfully
 computed for all the supported systems (@pxref{Derivations}).
diff --git a/guix/lint.scm b/guix/lint.scm
index 311bc94cc3..5a609b0454 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,7 +52,7 @@
   #:use-module (guix gnu-maintenance)
   #:use-module (guix cve)
   #:use-module ((guix swh) #:hide (origin?))
-  #:autoload   (guix git-download) (git-reference?
+  #:autoload   (guix git-download) (git-reference? git-fetch
                                     git-reference-url git-reference-commit)
   #:use-module (guix import stackage)
   #:use-module (ice-9 match)
@@ -84,6 +85,7 @@
             check-source
             check-source-file-name
             check-source-unstable-tarball
+            check-git-protocol
             check-mirror-url
             check-github-url
             check-license
@@ -918,6 +920,23 @@ descriptions maintained upstream."
                     (origin-uris origin))
         '())))
 
+(define (check-git-protocol package)
+  "Emit a warning if PACKAGE's source URI protocol is 'git://'."
+  (define (check-source-uri-scheme uri)
+    (if (eqv? (uri-scheme uri) 'git)
+        (list
+         (make-warning package
+                       (G_ "the source URI should not use the git:// protocol")
+                       #:field 'source))
+        '()))
+
+  (let ((origin (package-source package)))
+    (if (and (origin? origin)
+             (eqv? (origin-method origin) git-fetch))
+        (check-source-uri-scheme
+          (string->uri (git-reference-url (origin-uri origin))))
+        '())))
+
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
   (define (check-mirror-uri uri)                  ;XXX: could be optimized
@@ -1476,6 +1495,10 @@ or a list thereof")
      (name        'source-unstable-tarball)
      (description "Check for autogenerated tarballs")
      (check       check-source-unstable-tarball))
+   (lint-checker
+     (name        'git-protocol)
+     (description "Check for use of the git:// protocol")
+     (check       check-git-protocol))
    (lint-checker
      (name            'derivation)
      (description     "Report failure to compile a package to a derivation")
-- 
2.30.0