bug#40565: [PATCH 1/1] git-authenticate: Fetch keyrings from Savannah.

[Tobias Geerinckx-Rice via Bug reports for GNU Guix <bug-guix@gnu.org>]

* build-aux/git-authenticate.scm (%project-keyring-uris)
(import-keyring-uri, import-project-keys): New variables.
(authenticate-commits): Import known project keys before authenticating.
* guix/gnupg.scm (ensure-file): New procedure.
(gnupg-receive-keys): Use it.
(gnupg-import): New exported procedure.
---
 build-aux/git-authenticate.scm | 23 +++++++++++++++++++++++
 guix/gnupg.scm                 | 24 ++++++++++++++++++++----
 2 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm
index 37e0c6800c..bd33546b7f 100644
--- a/build-aux/git-authenticate.scm
+++ b/build-aux/git-authenticate.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
 (use-modules (git)
              (guix git)
              (guix gnupg)
+             (guix http-client)
              (guix utils)
              ((guix build utils) #:select (mkdir-p))
              (guix i18n)
@@ -225,6 +227,26 @@
   ;; Commits lacking a signature.
   '())
 
+;; XXX HTTP here is OK but is there any realistic scenario where TLS won't work?
+(define %project-keyring-uris
+  ;; List of ‘project keyring’ URIs containing the %COMMITERS's keys.
+  ;; Signatures not made by any of the %AUTHORIZED-SIGNING-KEYS will still be
+  ;; rejected.  Missing keys will be fetched from the %OPENPGP-KEY-SERVER.
+  (list
+   "https://savannah.gnu.org/project/memberlist-gpgkeys.php?group=guix&download=1"
+
+   ;; Additional keys not in the Guix keyring nor on %OPENPGP-KEY-SERVER.
+   "https://savannah.gnu.org/people/viewgpg.php?user_id=147297")) ; ipetkov
+
+(define* (import-keyring-uri uri)
+  (let* ((port (http-fetch uri))
+         (keyring (get-bytevector-all port)))
+    (close-port port)
+    (gnupg-import keyring)))
+
+(define (import-project-keys)
+  (for-each import-keyring-uri %project-keyring-uris))
+
 (define-syntax-rule (with-temporary-files file1 file2 exp ...)
   (call-with-temporary-output-file
    (lambda (file1 port1)
@@ -303,6 +325,7 @@ key: ~a")
 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")))
+    (import-project-keys)
     (fold (lambda (commit stats)
             (report-progress)
             (let ((signer (authenticate-commit repository commit)))
diff --git a/guix/gnupg.scm b/guix/gnupg.scm
index bf0283f8fe..f407dfcab4 100644
--- a/guix/gnupg.scm
+++ b/guix/gnupg.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2013, 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +19,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix gnupg)
+  #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -30,6 +32,7 @@
   #:export (%gpg-command
             %openpgp-key-server
             current-keyring
+            gnupg-import
             gnupg-verify
             gnupg-verify*
             gnupg-status-good-signature?
@@ -173,18 +176,31 @@ missing key or its key id if the fingerprint is unavailable."
            (_ #f)))
        status))
 
+(define* (ensure-file file)
+  "Create a new empty FILE if none with that name exists."
+  (unless (file-exists? file)
+    (mkdir-p (dirname file))
+    (call-with-output-file file (const #t))))
+
 (define* (gnupg-receive-keys fingerprint/key-id server
                              #:optional (keyring (current-keyring)))
   "Download FINGERPRINT/KEY-ID from SERVER, a key server, and add it to
 KEYRING."
-  (unless (file-exists? keyring)
-    (mkdir-p (dirname keyring))
-    (call-with-output-file keyring (const #t)))   ;create an empty keybox
-
+  (ensure-file keyring)
   (zero? (system* (%gpg-command) "--keyserver" server
                   "--no-default-keyring" "--keyring" keyring
                   "--recv-keys" fingerprint/key-id)))
 
+(define* (gnupg-import keys
+                       #:optional (keyring (current-keyring)))
+  "Add all KEYS in a bytevector produced by ‘gpg --export’ to KEYRING."
+  (ensure-file keyring)
+  (let ((pipe (open-pipe* OPEN_WRITE
+                          (%gpg-command) "--import" "--batch" "--quiet"
+                          "--no-default-keyring" "--keyring" keyring)))
+    (put-bytevector pipe keys)
+    (close-port pipe)))
+
 (define* (gnupg-verify* sig file
                         #:key
                         (key-download 'interactive)
-- 
2.25.2