09/15: git-authenticate: Use (guix openpgp).

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 051a45e642ff21908375bee24d272c536096d026
Author: Ludovic Courtès <address@hidden>
AuthorDate: Thu Apr 30 16:39:44 2020 +0200

    git-authenticate: Use (guix openpgp).
    
    It can now authenticate 14K+ commits in 23s instead of 4mn20.
    
    * build-aux/git-authenticate.scm (%authorized-signing-keys): Turn
    fingerprints into bytevectors.
    (with-temporary-files): Remove.
    (commit-signing-key): Add 'keyring' parameter.  Use
    'string->openpgp-packet' and 'verify-openpgp-signature' instead of (guix
    gnupg) procedures.
    (authenticate-commit): Add 'keyring' parameter.  Pass it to
    'commit-signing-key'.  Adjust to SIGNING-KEY being an <openpgp-public-key>.
    (authenticate-commits): Remove 'parameterize'.  Load keyring with
    'get-openpgp-keyring'.
    (git-authenticate): When printing stats, adjust to SIGNER being an
    <openpgp-public-key>.
---
 build-aux/git-authenticate.scm | 131 +++++++++++++++++++----------------------
 1 file changed, 62 insertions(+), 69 deletions(-)

diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm
index bb48ddd..0d5eb4c 100644
--- a/build-aux/git-authenticate.scm
+++ b/build-aux/git-authenticate.scm
@@ -23,8 +23,9 @@
 
 (use-modules (git)
              (guix git)
-             (guix gnupg)
-             (guix utils)
+             (guix openpgp)
+             ((guix utils) #:select (config-directory))
+             (guix base16)
              ((guix build utils) #:select (mkdir-p))
              (guix i18n)
              (guix progress)
@@ -215,7 +216,8 @@
   ;; Fingerprint of authorized signing keys.
   (map (match-lambda
          ((name fingerprint)
-          (string-filter char-set:graphic fingerprint)))
+          (base16-string->bytevector
+           (string-downcase (string-filter char-set:graphic fingerprint)))))
        %committers))
 
 (define %commits-with-bad-signature
@@ -226,75 +228,63 @@
   ;; Commits lacking a signature.
   '())
 
-(define-syntax-rule (with-temporary-files file1 file2 exp ...)
-  (call-with-temporary-output-file
-   (lambda (file1 port1)
-     (call-with-temporary-output-file
-      (lambda (file2 port2)
-        exp ...)))))
-
-(define (commit-signing-key repo commit-id)
-  "Return the OpenPGP key ID that signed COMMIT-ID (an OID).  Raise an
-exception if the commit is unsigned or has an invalid 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)))))
-    (if (not signature)
-        (raise (condition
-                (&message
-                 (message (format #f (G_ "commit ~a lacks a signature")
-                                  commit-id)))))
-        (begin
-          (with-fluids ((%default-port-encoding "UTF-8"))
-            (with-temporary-files data-file signature-file
-              (call-with-output-file data-file
-                (cut display signed-data <>))
-              (call-with-output-file signature-file
-                (cut display signature <>))
-
-              (let-values (((status data)
-                            (with-error-to-port (%make-void-port "w")
-                              (lambda ()
-                                (gnupg-verify* signature-file data-file
-                                               #:key-download 'always)))))
-                (match status
-                  ('invalid-signature
-                   ;; There's a signature but it's invalid.
-                   (raise (condition
-                           (&message
-                            (message (format #f (G_ "signature verification 
failed \
+    (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 \
+                                       (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))))))
-                  ('valid-signature
-                   (match data
-                     ((fingerprint . user)
-                      fingerprint)))))))))))
-
-(define (authenticate-commit repository commit)
+                                       (oid->string commit-id)
+                                       data))))))
+            ('good-signature data)))))))
+
+(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))
+    (commit-signing-key repository id keyring))
 
-  (unless (member signing-key %authorized-signing-keys)
+  (unless (member (openpgp-public-key-fingerprint signing-key)
+                  %authorized-signing-keys)
     (raise (condition
             (&message
              (message (format #f (G_ "commit ~a not signed by an authorized \
 key: ~a")
-                              (oid->string id) signing-key))))))
+                              (oid->string id)
+                              (openpgp-format-fingerprint
+                               (openpgp-public-key-fingerprint
+                                signing-key))))))))
 
   signing-key)
 
@@ -302,17 +292,21 @@ key: ~a")
                                #:key (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."
-  (parameterize ((current-keyring (string-append (config-directory)
-                                                 
"/keyrings/channels/guix.kbx")))
-    (fold (lambda (commit stats)
-            (report-progress)
-            (let ((signer (authenticate-commit repository commit)))
-              (match (assoc signer stats)
-                (#f          (cons `(,signer . 1) stats))
-                ((_ . count) (cons `(,signer . ,(+ count 1))
-                                   (alist-delete signer stats))))))
-          '()
-          commits)))
+  (define keyring-file
+    (string-append (config-directory) "/keyrings/channels/guix.kbx"))
+
+  (define keyring
+    (call-with-input-file keyring-file get-openpgp-keyring))
+
+  (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))
@@ -409,7 +403,10 @@ COMMIT-ID is written to cache, though)."
            (format #t (G_ "Signing statistics:~%"))
            (for-each (match-lambda
                        ((signer . count)
-                        (format #t "  ~a ~10d~%" signer count)))
+                        (format #t "  ~a ~10d~%"
+                                (openpgp-format-fingerprint
+                                 (openpgp-public-key-fingerprint signer))
+                                count)))
                      (sort stats
                            (match-lambda*
                              (((_ . count1) (_ . count2))
@@ -423,7 +420,3 @@ COMMIT-ID is written to cache, though)."
                (G_ "Usage: git-authenticate START [END]
 
 Authenticate commits START to END or the current head.\n"))))))
-
-;;; Local Variables:
-;;; eval: (put 'with-temporary-files 'scheme-indent-function 2)
-;;; End: