Add (guix git-authenticate).

* build-aux/git-authenticate.scm (commit-signing-key)
(read-authorizations, commit-authorized-keys, authenticate-commit)
(load-keyring-from-blob, load-keyring-from-reference)
(authenticate-commits, authenticated-commit-cache-file)
(previously-authenticated-commits, cache-authenticated-commit): Remove.
* build-aux/git-authenticate.scm (git-authenticate): Pass
 #:default-authorizations to 'authenticate-commits'.
* guix/git-authenticate.scm: New file, with code taken from
'build-aux/git-authenticate.scm'.  Remove references to
'%historical-authorized-signing-keys' and add #:default-authorizations
parameter instead.
* Makefile.am (MODULES): Add it.
(authenticate): Depend on guix/git-authenticate.go.

3 files changed, 253 insertions, 197 deletions

diff --git a/Makefile.am b/Makefile.am
index 5b64386b53..db30004b1b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -104,6 +104,7 @@ MODULES =					\
   guix/lint.scm				\
   guix/glob.scm					\
   guix/git.scm					\
+  guix/git-authenticate.scm			\
   guix/graph.scm				\
   guix/cache.scm				\
   guix/cve.scm					\
@@ -632,7 +633,7 @@ commit_v1_0_1 = d68de958b60426798ed62797ff7c96c327a672ac
 
 # Authenticate the current Git checkout by checking signatures on every commit
 # starting from $(commit_v1_0_1).
-authenticate: guix/openpgp.go guix/git.go
+authenticate: guix/openpgp.go guix/git-authenticate.go guix/git.go
 	$(AM_V_at)echo "Authenticating Git checkout..." ;	\
 	"$(top_builddir)/pre-inst-env" $(GUILE)			\
 	  --no-auto-compile -e git-authenticate			\
diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm
index 8e679fd5e5..5e1fdaaa24 100644
--- a/build-aux/git-authenticate.scm
+++ b/build-aux/git-authenticate.scm
@@ -22,21 +22,16 @@
 ;;;
 
 (use-modules (git)
-             (guix git)
-             (guix openpgp)
              (guix base16)
-             ((guix utils)
-              #:select (cache-directory with-atomic-file-output))
-             ((guix build utils) #:select (mkdir-p))
+             (guix git)
+             (guix git-authenticate)
              (guix i18n)
+             ((guix openpgp)
+              #:select (openpgp-public-key-fingerprint
+                        openpgp-format-fingerprint))
              (guix progress)
              (srfi srfi-1)
-             (srfi srfi-11)
              (srfi srfi-26)
-             (srfi srfi-34)
-             (srfi srfi-35)
-             (rnrs bytevectors)
-             (rnrs io ports)
              (ice-9 match)
              (ice-9 format)
              (ice-9 pretty-print))
@@ -231,197 +226,11 @@
   ;; Commits lacking a signature.
   '())
 
-(define (commit-signing-key repo commit-id keyring)
-  "Return the OpenPGP key that signed COMMIT-ID (an OID).  Raise an exception
-if the commit is unsigned, has an invalid signature, or if its signing key is
-not in KEYRING."
-  (let-values (((signature signed-data)
-                (catch 'git-error
-                  (lambda ()
-                    (commit-extract-signature repo commit-id))
-                  (lambda _
-                    (values #f #f)))))
-    (unless signature
-      (raise (condition
-              (&message
-               (message (format #f (G_ "commit ~a lacks a signature")
-                                commit-id))))))
-
-    (let ((signature (string->openpgp-packet signature)))
-      (with-fluids ((%default-port-encoding "UTF-8"))
-        (let-values (((status data)
-                      (verify-openpgp-signature signature keyring
-                                                (open-input-string signed-data))))
-          (match status
-            ('bad-signature
-             ;; There's a signature but it's invalid.
-             (raise (condition
-                     (&message
-                      (message (format #f (G_ "signature verification failed \
-for commit ~a")
-                                       (oid->string commit-id)))))))
-            ('missing-key
-             (raise (condition
-                     (&message
-                      (message (format #f (G_ "could not authenticate \
-commit ~a: key ~a is missing")
-                                       (oid->string commit-id)
-                                       data))))))
-            ('good-signature data)))))))
-
-(define (read-authorizations port)
-  "Read authorizations in the '.guix-authorizations' format from PORT, and
-return a list of authorized fingerprints."
-  (match (read port)
-    (('authorizations ('version 0)
-                      (((? string? fingerprints) _ ...) ...)
-                      _ ...)
-     (map (lambda (fingerprint)
-            (base16-string->bytevector
-             (string-downcase (string-filter char-set:graphic fingerprint))))
-          fingerprints))))
-
-(define* (commit-authorized-keys repository commit
-                                 #:optional (default-authorizations '()))
-  "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on
-authorizations listed in its parent commits.  If one of the parent commits
-does not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
-  (define (commit-authorizations commit)
-    (catch 'git-error
-      (lambda ()
-        (let* ((tree  (commit-tree commit))
-               (entry (tree-entry-bypath tree ".guix-authorizations"))
-               (blob  (blob-lookup repository (tree-entry-id entry))))
-          (read-authorizations
-           (open-bytevector-input-port (blob-content blob)))))
-      (lambda (key error)
-        (if (= (git-error-code error) GIT_ENOTFOUND)
-            default-authorizations
-            (throw key error)))))
-
-  (apply lset-intersection bytevector=?
-         (map commit-authorizations (commit-parents commit))))
-
-(define (authenticate-commit repository commit keyring)
-  "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint.
-Raise an error when authentication fails."
-  (define id
-    (commit-id commit))
-
-  (define signing-key
-    (commit-signing-key repository id keyring))
-
-  (unless (member (openpgp-public-key-fingerprint signing-key)
-                  (commit-authorized-keys repository commit
-                                          %historical-authorized-signing-keys))
-    (raise (condition
-            (&message
-             (message (format #f (G_ "commit ~a not signed by an authorized \
-key: ~a")
-                              (oid->string id)
-                              (openpgp-format-fingerprint
-                               (openpgp-public-key-fingerprint
-                                signing-key))))))))
-
-  signing-key)
-
-(define (load-keyring-from-blob repository oid keyring)
-  "Augment KEYRING with the keyring available in the blob at OID, which may or
-may not be ASCII-armored."
-  (let* ((blob (blob-lookup repository oid))
-         (port (open-bytevector-input-port (blob-content blob))))
-    (get-openpgp-keyring (if (port-ascii-armored? port)
-                             (open-bytevector-input-port (read-radix-64 port))
-                             port)
-                         keyring)))
-
-(define (load-keyring-from-reference repository reference)
-  "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return
-an OpenPGP keyring."
-  (let* ((reference (branch-lookup repository
-                                   (string-append "origin/" reference)
-                                   BRANCH-REMOTE))
-         (target    (reference-target reference))
-         (commit    (commit-lookup repository target))
-         (tree      (commit-tree commit)))
-    (fold (lambda (name keyring)
-            (if (string-suffix? ".key" name)
-                (let ((entry (tree-entry-bypath tree name)))
-                  (load-keyring-from-blob repository
-                                          (tree-entry-id entry)
-                                          keyring))
-                keyring))
-          %empty-keyring
-          (tree-list tree))))
-
-(define* (authenticate-commits repository commits
-                               #:key
-                               (keyring-reference "keyring")
-                               (report-progress (const #t)))
-  "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for
-each of them.  Return an alist showing the number of occurrences of each key.
-The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY."
-  (define keyring
-    (load-keyring-from-reference repository keyring-reference))
-
-  (fold (lambda (commit stats)
-          (report-progress)
-          (let ((signer (authenticate-commit repository commit keyring)))
-            (match (assq signer stats)
-              (#f          (cons `(,signer . 1) stats))
-              ((_ . count) (cons `(,signer . ,(+ count 1))
-                                 (alist-delete signer stats))))))
-        '()
-        commits))
-
 (define commit-short-id
   (compose (cut string-take <> 7) oid->string commit-id))
 
 
 ;;;
-;;; Caching.
-;;;
-
-(define (authenticated-commit-cache-file)
-  "Return the name of the file that contains the cache of
-previously-authenticated commits."
-  (string-append (cache-directory) "/authentication/channels/guix"))
-
-(define (previously-authenticated-commits)
-  "Return the previously-authenticated commits as a list of commit IDs (hex
-strings)."
-  (catch 'system-error
-    (lambda ()
-      (call-with-input-file (authenticated-commit-cache-file)
-        read))
-    (lambda args
-      (if (= ENOENT (system-error-errno args))
-          '()
-          (apply throw args)))))
-
-(define (cache-authenticated-commit commit-id)
-  "Record in ~/.cache COMMIT-ID and its closure as authenticated (only
-COMMIT-ID is written to cache, though)."
-  (define %max-cache-length
-    ;; Maximum number of commits in cache.
-    200)
-
-  (let ((lst  (delete-duplicates
-               (cons commit-id (previously-authenticated-commits))))
-        (file (authenticated-commit-cache-file)))
-    (mkdir-p (dirname file))
-    (with-atomic-file-output file
-      (lambda (port)
-        (let ((lst (if (> (length lst) %max-cache-length)
-                       (take lst %max-cache-length) ;truncate
-                       lst)))
-          (chmod port #o600)
-          (display ";; List of previously-authenticated commits.\n\n"
-                   port)
-          (pretty-print lst port))))))
-
-
-;;;
 ;;; Entry point.
 ;;;
 
@@ -462,6 +271,8 @@ COMMIT-ID is written to cache, though)."
        (let ((stats (call-with-progress-reporter reporter
                       (lambda (report)
                         (authenticate-commits repository commits
+                                              #:default-authorizations
+                                              %historical-authorized-signing-keys
                                               #:report-progress report)))))
          (cache-authenticated-commit (oid->string (commit-id end-commit)))
 
diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
new file mode 100644
index 0000000000..4df56fab59
--- /dev/null
+++ b/guix/git-authenticate.scm
@@ -0,0 +1,244 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019, 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 git-authenticate)
+  #:use-module (git)
+  #:use-module (guix base16)
+  #:use-module (guix i18n)
+  #:use-module (guix openpgp)
+  #:use-module ((guix utils)
+                #:select (cache-directory with-atomic-file-output))
+  #:use-module ((guix build utils)
+                #:select (mkdir-p))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (ice-9 match)
+  #:autoload   (ice-9 pretty-print) (pretty-print)
+  #:export (read-authorizations
+            commit-signing-key
+            commit-authorized-keys
+            authenticate-commit
+            authenticate-commits
+            load-keyring-from-reference
+            previously-authenticated-commits
+            cache-authenticated-commit))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to authenticate a range of Git commits.  A
+;;; commit is considered "authentic" if and only if it is signed by an
+;;; authorized party.  Parties authorized to sign a commit are listed in the
+;;; '.guix-authorizations' file of the parent commit.
+;;;
+;;; Code:
+
+(define (commit-signing-key repo commit-id keyring)
+  "Return the OpenPGP key that signed COMMIT-ID (an OID).  Raise an exception
+if the commit is unsigned, has an invalid signature, or if its signing key is
+not in KEYRING."
+  (let-values (((signature signed-data)
+                (catch 'git-error
+                  (lambda ()
+                    (commit-extract-signature repo commit-id))
+                  (lambda _
+                    (values #f #f)))))
+    (unless signature
+      (raise (condition
+              (&message
+               (message (format #f (G_ "commit ~a lacks a signature")
+                                commit-id))))))
+
+    (let ((signature (string->openpgp-packet signature)))
+      (with-fluids ((%default-port-encoding "UTF-8"))
+        (let-values (((status data)
+                      (verify-openpgp-signature signature keyring
+                                                (open-input-string signed-data))))
+          (match status
+            ('bad-signature
+             ;; There's a signature but it's invalid.
+             (raise (condition
+                     (&message
+                      (message (format #f (G_ "signature verification failed \
+for commit ~a")
+                                       (oid->string commit-id)))))))
+            ('missing-key
+             (raise (condition
+                     (&message
+                      (message (format #f (G_ "could not authenticate \
+commit ~a: key ~a is missing")
+                                       (oid->string commit-id)
+                                       data))))))
+            ('good-signature data)))))))
+
+(define (read-authorizations port)
+  "Read authorizations in the '.guix-authorizations' format from PORT, and
+return a list of authorized fingerprints."
+  (match (read port)
+    (('authorizations ('version 0)
+                      (((? string? fingerprints) _ ...) ...)
+                      _ ...)
+     (map (lambda (fingerprint)
+            (base16-string->bytevector
+             (string-downcase (string-filter char-set:graphic fingerprint))))
+          fingerprints))))
+
+(define* (commit-authorized-keys repository commit
+                                 #:optional (default-authorizations '()))
+  "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on
+authorizations listed in its parent commits.  If one of the parent commits
+does not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
+  (define (commit-authorizations commit)
+    (catch 'git-error
+      (lambda ()
+        (let* ((tree  (commit-tree commit))
+               (entry (tree-entry-bypath tree ".guix-authorizations"))
+               (blob  (blob-lookup repository (tree-entry-id entry))))
+          (read-authorizations
+           (open-bytevector-input-port (blob-content blob)))))
+      (lambda (key error)
+        (if (= (git-error-code error) GIT_ENOTFOUND)
+            default-authorizations
+            (throw key error)))))
+
+  (apply lset-intersection bytevector=?
+         (map commit-authorizations (commit-parents commit))))
+
+(define* (authenticate-commit repository commit keyring
+                              #:key (default-authorizations '()))
+  "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint.
+Raise an error when authentication fails.  If one of the parent commits does
+not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
+  (define id
+    (commit-id commit))
+
+  (define signing-key
+    (commit-signing-key repository id keyring))
+
+  (unless (member (openpgp-public-key-fingerprint signing-key)
+                  (commit-authorized-keys repository commit
+                                          default-authorizations))
+    (raise (condition
+            (&message
+             (message (format #f (G_ "commit ~a not signed by an authorized \
+key: ~a")
+                              (oid->string id)
+                              (openpgp-format-fingerprint
+                               (openpgp-public-key-fingerprint
+                                signing-key))))))))
+
+  signing-key)
+
+(define (load-keyring-from-blob repository oid keyring)
+  "Augment KEYRING with the keyring available in the blob at OID, which may or
+may not be ASCII-armored."
+  (let* ((blob (blob-lookup repository oid))
+         (port (open-bytevector-input-port (blob-content blob))))
+    (get-openpgp-keyring (if (port-ascii-armored? port)
+                             (open-bytevector-input-port (read-radix-64 port))
+                             port)
+                         keyring)))
+
+(define (load-keyring-from-reference repository reference)
+  "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return
+an OpenPGP keyring."
+  (let* ((reference (branch-lookup repository
+                                   (string-append "origin/" reference)
+                                   BRANCH-REMOTE))
+         (target    (reference-target reference))
+         (commit    (commit-lookup repository target))
+         (tree      (commit-tree commit)))
+    (fold (lambda (name keyring)
+            (if (string-suffix? ".key" name)
+                (let ((entry (tree-entry-bypath tree name)))
+                  (load-keyring-from-blob repository
+                                          (tree-entry-id entry)
+                                          keyring))
+                keyring))
+          %empty-keyring
+          (tree-list tree))))
+
+(define* (authenticate-commits repository commits
+                               #:key
+                               (default-authorizations '())
+                               (keyring-reference "keyring")
+                               (report-progress (const #t)))
+  "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for
+each of them.  Return an alist showing the number of occurrences of each key.
+The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY."
+  (define keyring
+    (load-keyring-from-reference repository keyring-reference))
+
+  (fold (lambda (commit stats)
+          (report-progress)
+          (let ((signer (authenticate-commit repository commit keyring
+                                             #:default-authorizations
+                                             default-authorizations)))
+            (match (assq signer stats)
+              (#f          (cons `(,signer . 1) stats))
+              ((_ . count) (cons `(,signer . ,(+ count 1))
+                                 (alist-delete signer stats))))))
+        '()
+        commits))
+
+
+;;;
+;;; Caching.
+;;;
+
+(define (authenticated-commit-cache-file)
+  "Return the name of the file that contains the cache of
+previously-authenticated commits."
+  (string-append (cache-directory) "/authentication/channels/guix"))
+
+(define (previously-authenticated-commits)
+  "Return the previously-authenticated commits as a list of commit IDs (hex
+strings)."
+  (catch 'system-error
+    (lambda ()
+      (call-with-input-file (authenticated-commit-cache-file)
+        read))
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          '()
+          (apply throw args)))))
+
+(define (cache-authenticated-commit commit-id)
+  "Record in ~/.cache COMMIT-ID and its closure as authenticated (only
+COMMIT-ID is written to cache, though)."
+  (define %max-cache-length
+    ;; Maximum number of commits in cache.
+    200)
+
+  (let ((lst  (delete-duplicates
+               (cons commit-id (previously-authenticated-commits))))
+        (file (authenticated-commit-cache-file)))
+    (mkdir-p (dirname file))
+    (with-atomic-file-output file
+      (lambda (port)
+        (let ((lst (if (> (length lst) %max-cache-length)
+                       (take lst %max-cache-length) ;truncate
+                       lst)))
+          (chmod port #o600)
+          (display ";; List of previously-authenticated commits.\n\n"
+                   port)
+          (pretty-print lst port))))))