[bug#42225] [PATCH 4/5] Add 'guix git-authenticate'.

[Ludovic Courtès]

* guix/scripts/git-authenticate.scm: New file.
* tests/guix-git-authenticate.sh: New files.
* Makefile.am (MODULES): Add the former.
(SH_TESTS): Add the latter.
* doc/guix.texi (Channels)[Specifying Channel Authorizations]: Mention
'guix git-authenticate'.
(Invoking guix git-authenticate): New node.
* po/guix/POTFILES.in: Add 'guix/scripts/git-authenticate.scm'.
---
 Makefile.am                       |   2 +
 doc/guix.texi                     |  83 +++++++++++++-
 guix/scripts/git-authenticate.scm | 176 ++++++++++++++++++++++++++++++
 po/guix/POTFILES.in               |   1 +
 tests/guix-git-authenticate.sh    |  56 ++++++++++
 5 files changed, 315 insertions(+), 3 deletions(-)
 create mode 100644 guix/scripts/git-authenticate.scm
 create mode 100644 tests/guix-git-authenticate.sh

diff --git a/Makefile.am b/Makefile.am
index e125e07e99..2058f9d1ea 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -281,6 +281,7 @@ MODULES =                                   \
   guix/scripts/publish.scm                     \
   guix/scripts/edit.scm                                \
   guix/scripts/size.scm                                \
+  guix/scripts/git-authenticate.scm            \
   guix/scripts/graph.scm                       \
   guix/scripts/weather.scm                     \
   guix/scripts/container.scm                   \
@@ -463,6 +464,7 @@ SH_TESTS =                                  \
   tests/guix-build-branch.sh                   \
   tests/guix-download.sh                       \
   tests/guix-gc.sh                             \
+  tests/guix-git-authenticate.sh               \
   tests/guix-hash.sh                           \
   tests/guix-pack.sh                           \
   tests/guix-pack-localstatedir.sh             \
diff --git a/doc/guix.texi b/doc/guix.texi
index ce17c2de8e..77e2971acd 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3981,6 +3981,7 @@ Before that, some security considerations.
 
 @subsection Channel Authentication
 
+@anchor{channel-authentication}
 @cindex authentication, of channel code
 The @command{guix pull} and @command{guix time-machine} commands
 @dfn{authenticate} the code retrieved from channels: they make sure each
@@ -4200,6 +4201,7 @@ add a meta-data file @file{.guix-channel} that contains:
 @cindex channel authorizations
 @subsection Specifying Channel Authorizations
 
+@anchor{channel-authorizations}
 As we saw above, Guix ensures the source code it pulls from channels
 comes from authorized developers.  As a channel author, you need to
 specify the list of authorized developers in the
@@ -4259,6 +4261,18 @@ pair---i.e., the commit that introduced 
@file{.guix-authorizations}, and
 the fingerprint of the OpenPGP used to sign it.
 @end enumerate
 
+Before pushing to your public Git repository, you can run @command{guix
+git-authenticate} to verify that you did sign all the commits you are
+about to push with an authorized key:
+
+@example
+guix git-authenticate @var{commit} @var{signer}
+@end example
+
+@noindent
+where @var{commit} and @var{signer} are your channel introduction.
+@xref{Invoking guix git-authenticate}, for details.
+
 Publishing a signed channel requires discipline: any mistake, such as an
 unsigned commit or a commit signed by an unauthorized key, will prevent
 users from pulling from your channel---well, that's the whole point of
@@ -4862,9 +4876,10 @@ pack} command allows you to create @dfn{application 
bundles} that can be
 easily distributed to users who do not run Guix.
 
 @menu
-* Invoking guix environment::  Setting up development environments.
-* Invoking guix pack::         Creating software bundles.
-* The GCC toolchain::          Working with languages supported by GCC.
+* Invoking guix environment::   Setting up development environments.
+* Invoking guix pack::          Creating software bundles.
+* The GCC toolchain::           Working with languages supported by GCC.
+* Invoking guix git-authenticate:: Authenticating Git repositories.
 @end menu
 
 @node Invoking guix environment
@@ -5602,6 +5617,68 @@ The package @code{gfortran-toolchain} provides a 
complete GCC toolchain
 for Fortran development.  For other languages, please use
 @samp{guix search gcc toolchain} (@pxref{guix-search,, Invoking guix package}).
 
+
+@node Invoking guix git-authenticate
+@section Invoking @command{guix git-authenticate}
+
+The @command{guix git-authenticate} command authenticates a Git checkout
+following the same rule as for channels (@pxref{channel-authentication,
+channel authentication}).  That is, starting from a given commit, it
+ensures that all subsequent commits are signed by an OpenPGP key whose
+fingerprint appears in the @file{.guix-authorizations} file of its
+parent commit(s).
+
+You will find this command useful if you maintain a channel.  But in
+fact, this authentication mechanism is useful in a broader context, so
+you might want to use it for Git repositories that have nothing to do
+with Guix.
+
+The general syntax is:
+
+@example
+guix git-authenticate @var{commit} @var{signer} [@var{options}@dots{}]
+@end example
+
+By default, this command authenticates the Git checkout in the current
+directory; it outputs nothing and exits with exit code zero on success
+and non-zero on failure.  @var{commit} above denotes the first commit
+where authentication takes place, and @var{signer} is the OpenPGP
+fingerprint of public key used to sign @var{commit}.  Together, they
+form a ``channel introduction'' (@pxref{channel-authentication, channel
+introduction}).  The options below allow you to fine-tune the process.
+
+@table @code
+@item --repository=@var{directory}
+@itemx -r @var{directory}
+Open the Git repository in @var{directory} instead of the current
+directory.
+
+@item --keyring=@var{reference}
+@itemx -k @var{reference}
+Load OpenPGP keyring from @var{reference}, the reference of a branch
+such as @code{origin/keyring} or @code{my-keyring}.  The branch must
+contain OpenPGP public keys in @file{.key} files, either in binary form
+or ``ASCII-armored''.  By default the keyring is loaded from the branch
+named @code{keyring}.
+
+@item --stats
+Display commit signing statistics upon completion.
+
+@item --cache-key=@var{key}
+Previously-authenticated commits are cached in a file under
+@file{~/.cache/guix/authentication}.  This option forces the cache to be
+stored in file @var{key} in that directory.
+
+@item --historical-authorizations=@var{file}
+By default, any commit whose parent commit(s) lack the
+@file{.guix-authorizations} file is considered inauthentic.  In
+contrast, this option considers the authorizations in @var{file} for any
+commit that lacks @file{.guix-authorizations}.  The format of @var{file}
+is the same as that of @file{.guix-authorizations}
+(@pxref{channel-authorizations, @file{.guix-authorizations} format}).
+@end table
+
+
 @c *********************************************************************
 @node Programming Interface
 @chapter Programming Interface
diff --git a/guix/scripts/git-authenticate.scm 
b/guix/scripts/git-authenticate.scm
new file mode 100644
index 0000000000..e3ba767675
--- /dev/null
+++ b/guix/scripts/git-authenticate.scm
@@ -0,0 +1,176 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts git-authenticate)
+  #:use-module (git)
+  #:use-module (guix ui)
+  #:use-module (guix scripts)
+  #:use-module (guix git-authenticate)
+  #:autoload   (guix openpgp) (openpgp-format-fingerprint
+                               openpgp-public-key-fingerprint)
+  #:use-module ((guix channels) #:select (openpgp-fingerprint))
+  #:use-module ((guix git) #:select (with-git-error-handling))
+  #:use-module (guix progress)
+  #:use-module (guix base64)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:export (guix-git-authenticate))
+
+;;; Commentary:
+;;;
+;;; Authenticate a Git checkout by reading '.guix-authorizations' files and
+;;; following the "authorizations invariant" also used by (guix channels).
+;;;
+;;; Code:
+
+(define %options
+  ;; Specifications of the command-line options.
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix git-authenticate")))
+
+        (option '(#\r "repository") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'directory arg result)))
+        (option '(#\e "end") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'end-commit (string->oid arg) result)))
+        (option '(#\k "keyring") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'keyring-reference arg result)))
+        (option '("cache-key") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'cache-key arg result)))
+        (option '("historical-authorizations") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'historical-authorizations arg
+                              result)))
+        (option '("stats") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'show-stats? #t result)))))
+
+(define %default-options
+  '((directory . ".")
+    (keyring-reference . "keyring")))
+
+(define (show-stats stats)
+  "Display STATS, an alist containing commit signing stats as returned by
+'authenticate-repository'."
+  (format #t (G_ "Signing statistics:~%"))
+  (for-each (match-lambda
+              ((signer . count)
+               (format #t "  ~a ~10d~%"
+                       (openpgp-format-fingerprint
+                        (openpgp-public-key-fingerprint signer))
+                       count)))
+            (sort stats
+                  (match-lambda*
+                    (((_ . count1) (_ . count2))
+                     (> count1 count2))))))
+
+(define (show-help)
+  (display (G_ "Usage: guix git-authenticate COMMIT SIGNER [OPTIONS...]
+Authenticate the given Git checkout using COMMIT/SIGNER as its 
introduction.\n"))
+  (display (G_ "
+  -r, --repository=DIRECTORY
+                         open the Git repository at DIRECTORY"))
+  (display (G_ "
+  -k, --keyring=REFERENCE
+                         load keyring from REFERENCE, a Git branch"))
+  (display (G_ "
+      --stats            display commit signing statistics upon completion"))
+  (display (G_ "
+      --cache-key=KEY    cache authenticated commits under KEY"))
+  (display (G_ "
+      --historical-authorizations=FILE
+                         read historical authorizations from FILE"))
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-git-authenticate . args)
+  (define options
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
+
+  (define (command-line-arguments lst)
+    (reverse (filter-map (match-lambda
+                           (('argument . arg) arg)
+                           (_ #f))
+                         lst)))
+
+  (define commit-short-id
+    (compose (cut string-take <> 7) oid->string commit-id))
+
+  (define (make-reporter start-commit end-commit commits)
+    (format (current-error-port)
+            (G_ "Authenticating commits ~a to ~a (~h new \
+commits)...~%")
+            (commit-short-id start-commit)
+            (commit-short-id end-commit)
+            (length commits))
+
+    (if (isatty? (current-error-port))
+        (progress-reporter/bar (length commits))
+        progress-reporter/silent))
+
+  (with-error-handling
+    (with-git-error-handling
+     (match (command-line-arguments options)
+       ((commit signer)
+        (let* ((directory   (assoc-ref options 'directory))
+               (show-stats? (assoc-ref options 'show-stats?))
+               (keyring     (assoc-ref options 'keyring-reference))
+               (repository  (repository-open directory))
+               (end         (match (assoc-ref options 'end-commit)
+                              (#f  (reference-target
+                                    (repository-head repository)))
+                              (oid oid)))
+               (history     (match (assoc-ref options 
'historical-authorizations)
+                              (#f '())
+                              (file (call-with-input-file file
+                                      read-authorizations))))
+               (cache-key   (or (assoc-ref options 'cache-key)
+                                (repository-cache-key repository))))
+          (define stats
+            (authenticate-repository repository (string->oid commit)
+                                     (openpgp-fingerprint signer)
+                                     #:end end
+                                     #:keyring-reference keyring
+                                     #:historical-authorizations history
+                                     #:cache-key cache-key
+                                     #:make-reporter make-reporter))
+
+          (when (and show-stats? (not (null? stats)))
+            (show-stats stats))))))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 62b3cbf4e4..bd2aacd164 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -53,6 +53,7 @@ guix/scripts/upgrade.scm
 guix/scripts/search.scm
 guix/scripts/show.scm
 guix/scripts/gc.scm
+guix/scripts/git-authenticate.scm
 guix/scripts/hash.scm
 guix/scripts/import.scm
 guix/scripts/import/cran.scm
diff --git a/tests/guix-git-authenticate.sh b/tests/guix-git-authenticate.sh
new file mode 100644
index 0000000000..a149584421
--- /dev/null
+++ b/tests/guix-git-authenticate.sh
@@ -0,0 +1,56 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix git-authenticate' command-line utility.
+#
+
+# Skip if we're not in a Git checkout.
+[ -d "$abs_top_srcdir/.git" ] || exit 77
+
+# Skip if there's no 'keyring' branch.
+guile -c '(use-modules (git))
+  (member "refs/heads/keyring" (branch-list (repository-open ".")))' || \
+    exit 77
+
+# Keep in sync with '%default-channels' in (guix channels)!
+intro_commit="9edb3f66fd807b096b48283debdcddccfea34bad"
+intro_signer="BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA"
+
+cache_key="test-$$"
+
+guix git-authenticate "$intro_commit" "$intro_signer"  \
+     --cache-key="$cache_key" --stats                  \
+     --end=9549f0283a78fe36f2d4ff2a04ef8ad6b0c02604
+
+rm "$XDG_CACHE_HOME/guix/authentication/$cache_key"
+
+# Commit and signer of the 'v1.0.0' tag.
+v1_0_0_commit="6298c3ffd9654d3231a6f25390b056483e8f407c"
+v1_0_0_signer="3CE4 6455 8A84 FDC6 9DB4  0CFB 090B 1199 3D9A EBB5" # civodul
+v1_0_1_commit="d68de958b60426798ed62797ff7c96c327a672ac"
+
+# This should fail because these commits lack '.guix-authorizations'.
+if guix git-authenticate "$v1_0_0_commit" "$v1_0_0_signer" \
+       --cache-key="$cache_key" --end="$v1_0_1_commit";
+then false; else true; fi
+
+# This should work thanks to '--historical-authorizations'.
+guix git-authenticate "$v1_0_0_commit" "$v1_0_0_signer"        \
+     --cache-key="$cache_key" --end="$v1_0_1_commit" --stats   \
+     
--historical-authorizations="$abs_top_srcdir/etc/historical-authorizations"
-- 
2.26.2