* 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 <[email protected]> +;;; Copyright © 2020 Tobias Geerinckx-Rice <[email protected]> ;;; ;;; 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 <[email protected]> ;;; Copyright © 2013 Nikita Karetnikov <[email protected]> +;;; Copyright © 2020 Tobias Geerinckx-Rice <[email protected]> ;;; ;;; 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
