01/06: git-authenticate: Factorize 'authenticate-repository'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 838f2bdfa862c5017ee93156cf0d42a16d0290e2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jul 5 16:47:32 2020 +0200

    git-authenticate: Factorize 'authenticate-repository'.
    
    * guix/git-authenticate.scm (repository-cache-key)
    (verify-introductory-commit, authenticate-repository): New procedures.
    * guix/channels.scm (verify-introductory-commit): Remove.
    (authenticate-channel): Rewrite in terms of 'authenticate-repository'.
---
 guix/channels.scm         | 118 ++++++++++++----------------------------------
 guix/git-authenticate.scm | 101 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 131 insertions(+), 88 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 500c956..bbabf65 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -315,100 +315,44 @@ result is unspecified."
 (define commit-short-id
   (compose (cut string-take <> 7) oid->string commit-id))
 
-(define (verify-introductory-commit repository introduction keyring)
-  "Raise an exception if the first commit described in INTRODUCTION doesn't
-have the expected signer."
-  (define commit-id
-    (channel-introduction-first-signed-commit introduction))
-
-  (define actual-signer
-    (openpgp-public-key-fingerprint
-     (commit-signing-key repository (string->oid commit-id)
-                         keyring)))
-
-  (define expected-signer
-    (channel-introduction-first-commit-signer introduction))
-
-  (unless (bytevector=? expected-signer actual-signer)
-    (raise (condition
-            (&message
-             (message (format #f (G_ "initial commit ~a is signed by '~a' \
-instead of '~a'")
-                              commit-id
-                              (openpgp-format-fingerprint actual-signer)
-                              (openpgp-format-fingerprint 
expected-signer))))))))
-
 (define* (authenticate-channel channel checkout commit
                                #:key (keyring-reference-prefix "origin/"))
   "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a
 directory containing a CHANNEL checkout.  Raise an error if authentication
 fails."
+  (define intro
+    (channel-introduction channel))
+
+  (define cache-key
+    (string-append "channels/" (symbol->string (channel-name channel))))
+
+  (define keyring-reference
+    (channel-metadata-keyring-reference
+     (read-channel-metadata-from-source checkout)))
+
+  (define (make-reporter start-commit end-commit commits)
+    (format (current-error-port)
+            (G_ "Authenticating channel '~a', commits ~a to ~a (~h new \
+commits)...~%")
+            (channel-name channel)
+            (commit-short-id start-commit)
+            (commit-short-id end-commit)
+            (length commits))
+
+    (progress-reporter/bar (length commits)))
+
   ;; XXX: Too bad we need to re-open CHECKOUT.
   (with-repository checkout repository
-    (define start-commit
-      (commit-lookup repository
-                     (string->oid
-                      (channel-introduction-first-signed-commit
-                       (channel-introduction channel)))))
-
-    (define end-commit
-      (commit-lookup repository (string->oid commit)))
-
-    (define cache-key
-      (string-append "channels/" (symbol->string (channel-name channel))))
-
-    (define keyring-reference
-      (channel-metadata-keyring-reference
-       (read-channel-metadata-from-source checkout)))
-
-    (define keyring
-      (load-keyring-from-reference repository
-                                   (string-append keyring-reference-prefix
-                                                  keyring-reference)))
-
-    (define authenticated-commits
-      ;; Previously-authenticated commits that don't need to be checked again.
-      (filter-map (lambda (id)
-                    (false-if-exception
-                     (commit-lookup repository (string->oid id))))
-                  (previously-authenticated-commits cache-key)))
-
-    (define commits
-      ;; Commits to authenticate, excluding the closure of
-      ;; AUTHENTICATED-COMMITS.
-      (commit-difference end-commit start-commit
-                         authenticated-commits))
-
-    (define reporter
-      (progress-reporter/bar (length commits)))
-
-    ;; When COMMITS is empty, it's because END-COMMIT is in the closure of
-    ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to
-    ;; be authentic already.
-    (unless (null? commits)
-      (format (current-error-port)
-              (G_ "Authenticating channel '~a', \
-commits ~a to ~a (~h new commits)...~%")
-              (channel-name channel)
-              (commit-short-id start-commit)
-              (commit-short-id end-commit)
-              (length commits))
-
-      ;; If it's our first time, verify CHANNEL's introductory commit.
-      (when (null? authenticated-commits)
-        (verify-introductory-commit repository
-                                    (channel-introduction channel)
-                                    keyring))
-
-      (call-with-progress-reporter reporter
-        (lambda (report)
-          (authenticate-commits repository commits
-                                #:keyring keyring
-                                #:report-progress report)))
-
-      (cache-authenticated-commit cache-key
-                                  (oid->string
-                                   (commit-id end-commit))))))
+    (authenticate-repository repository
+                             (string->oid
+                              (channel-introduction-first-signed-commit intro))
+                             (channel-introduction-first-commit-signer intro)
+                             #:end (string->oid commit)
+                             #:keyring-reference
+                             (string-append keyring-reference-prefix
+                                            keyring-reference)
+                             #:make-reporter make-reporter
+                             #:cache-key cache-key)))
 
 (define* (latest-channel-instance store channel
                                   #:key (patches %patches)
diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
index 082c44e..99fd9c3 100644
--- a/guix/git-authenticate.scm
+++ b/guix/git-authenticate.scm
@@ -18,14 +18,18 @@
 
 (define-module (guix git-authenticate)
   #:use-module (git)
+  #:autoload   (gcrypt hash) (sha256)
   #:use-module (guix base16)
-  #:use-module ((guix git) #:select (false-if-git-not-found))
+  #:autoload   (guix base64) (base64-encode)
+  #:use-module ((guix git)
+                #:select (commit-difference false-if-git-not-found))
   #: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 (guix progress)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -44,6 +48,9 @@
             previously-authenticated-commits
             cache-authenticated-commit
 
+            repository-cache-key
+            authenticate-repository
+
             git-authentication-error?
             git-authentication-error-commit
             unsigned-commit-error?
@@ -339,3 +346,95 @@ authenticated (only COMMIT-ID is written to cache, 
though)."
           (display ";; List of previously-authenticated commits.\n\n"
                    port)
           (pretty-print lst port))))))
+
+
+;;;
+;;; High-level interface.
+;;;
+
+(define (repository-cache-key repository)
+  "Return a unique key to store the authenticate commit cache for REPOSITORY."
+  (string-append "checkouts/"
+                 (base64-encode
+                  (sha256 (string->utf8 (repository-directory repository))))))
+
+(define (verify-introductory-commit repository keyring commit expected-signer)
+  "Look up COMMIT in REPOSITORY, and raise an exception if it is not signed by
+EXPECTED-SIGNER."
+  (define actual-signer
+    (openpgp-public-key-fingerprint
+     (commit-signing-key repository (commit-id commit) keyring)))
+
+  (unless (bytevector=? expected-signer actual-signer)
+    (raise (condition
+            (&message
+             (message (format #f (G_ "initial commit ~a is signed by '~a' \
+instead of '~a'")
+                              (oid->string (commit-id commit))
+                              (openpgp-format-fingerprint actual-signer)
+                              (openpgp-format-fingerprint 
expected-signer))))))))
+
+(define* (authenticate-repository repository start signer
+                                  #:key
+                                  (keyring-reference "keyring")
+                                  (cache-key (repository-cache-key repository))
+                                  (end (reference-target
+                                        (repository-head repository)))
+                                  (historical-authorizations '())
+                                  (make-reporter
+                                   (const progress-reporter/silent)))
+  "Authenticate REPOSITORY up to commit END, an OID.  Authentication starts
+with commit START, an OID, which must be signed by SIGNER; an exception is
+raised if that is not the case.  Return an alist mapping OpenPGP public keys
+to the number of commits signed by that key that have been traversed.
+
+The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY, where
+KEYRING-REFERENCE is the name of a branch.  The list of authenticated commits
+is cached in the authentication cache under CACHE-KEY.
+
+HISTORICAL-AUTHORIZATIONS must be a list of OpenPGP fingerprints (bytevectors)
+denoting the authorized keys for commits whose parent lack the
+'.guix-authorizations' file."
+  (define start-commit
+    (commit-lookup repository start))
+  (define end-commit
+    (commit-lookup repository end))
+
+  (define keyring
+    (load-keyring-from-reference repository keyring-reference))
+
+  (define authenticated-commits
+    ;; Previously-authenticated commits that don't need to be checked again.
+    (filter-map (lambda (id)
+                  (false-if-git-not-found
+                   (commit-lookup repository (string->oid id))))
+                (previously-authenticated-commits cache-key)))
+
+  (define commits
+    ;; Commits to authenticate, excluding the closure of
+    ;; AUTHENTICATED-COMMITS.
+    (commit-difference end-commit start-commit
+                       authenticated-commits))
+
+  ;; When COMMITS is empty, it's because END-COMMIT is in the closure of
+  ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to
+  ;; be authentic already.
+  (if (null? commits)
+      '()
+      (let ((reporter (make-reporter start-commit end-commit commits)))
+        ;; If it's our first time, verify START-COMMIT's signature.
+        (when (null? authenticated-commits)
+          (verify-introductory-commit repository keyring
+                                      start-commit signer))
+
+        (let ((stats (call-with-progress-reporter reporter
+                       (lambda (report)
+                         (authenticate-commits repository commits
+                                               #:keyring keyring
+                                               #:default-authorizations
+                                               historical-authorizations
+                                               #:report-progress report)))))
+          (cache-authenticated-commit cache-key
+                                      (oid->string (commit-id end-commit)))
+
+          stats))))