* [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests
@ 2020-06-01 21:29 Ludovic Courtès
2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès
` (2 more replies)
0 siblings, 3 replies; 7+ messages in thread
From: Ludovic Courtès @ 2020-06-01 21:29 UTC (permalink / raw)
To: 41653; +Cc: Ludovic Courtès
Hello Guix!
This series moves code from ‘build-aux/git-authenticate.scm’ to a proper
module in preparation of integration with (guix channels), as discussed
at <https://issues.guix.gnu.org/22883>.
More importantly, it adds tests. I hope those tests are readable and
I would welcome feedback on all this!
Ludo’.
Ludovic Courtès (4):
Add (guix git-authenticate).
git-authenticate: Don't hard-code "origin/" for keyring reference.
git-authenticate: Raise proper SRFI-35 conditions.
git-authenticate: Add tests.
.dir-locals.el | 2 +
Makefile.am | 9 +-
build-aux/git-authenticate.scm | 203 +----------------------
guix/git-authenticate.scm | 282 ++++++++++++++++++++++++++++++++
guix/tests/git.scm | 26 +--
guix/tests/gnupg.scm | 72 +++++++++
tests/ed25519bis.key | 10 ++
tests/ed25519bis.sec | 10 ++
tests/git-authenticate.scm | 286 +++++++++++++++++++++++++++++++++
9 files changed, 684 insertions(+), 216 deletions(-)
create mode 100644 guix/git-authenticate.scm
create mode 100644 guix/tests/gnupg.scm
create mode 100644 tests/ed25519bis.key
create mode 100644 tests/ed25519bis.sec
create mode 100644 tests/git-authenticate.scm
--
2.26.2
^ permalink raw reply [flat|nested] 7+ messages in thread* [bug#41653] [PATCH 1/4] Add (guix git-authenticate). 2020-06-01 21:29 [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès @ 2020-06-01 21:41 ` Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference Ludovic Courtès ` (2 more replies) 2020-06-05 21:13 ` [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès 2020-06-07 21:19 ` Ludovic Courtès 2 siblings, 3 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-01 21:41 UTC (permalink / raw) To: 41653; +Cc: Ludovic Courtès * 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. --- Makefile.am | 3 +- build-aux/git-authenticate.scm | 203 +-------------------------- guix/git-authenticate.scm | 244 +++++++++++++++++++++++++++++++++ 3 files changed, 253 insertions(+), 197 deletions(-) create mode 100644 guix/git-authenticate.scm 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,195 +226,9 @@ ;; 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)) -\f -;;; -;;; 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)))))) - \f ;;; ;;; 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)) + +\f +;;; +;;; 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)))))) -- 2.26.2 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference. 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès @ 2020-06-01 21:41 ` Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 4/4] git-authenticate: Add tests Ludovic Courtès 2 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-01 21:41 UTC (permalink / raw) To: 41653; +Cc: Ludovic Courtès * guix/git-authenticate.scm (load-keyring-from-reference): Remove hard-coded "origin/". Use BRANCH-ALL instead of BRANCH-REMOTE. --- guix/git-authenticate.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index 4df56fab59..4217ab6d27 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -161,9 +161,7 @@ may not be ASCII-armored." (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)) + (let* ((reference (branch-lookup repository reference BRANCH-ALL)) (target (reference-target reference)) (commit (commit-lookup repository target)) (tree (commit-tree commit))) -- 2.26.2 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#41653] [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions. 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference Ludovic Courtès @ 2020-06-01 21:41 ` Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 4/4] git-authenticate: Add tests Ludovic Courtès 2 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-01 21:41 UTC (permalink / raw) To: 41653; +Cc: Ludovic Courtès * guix/git-authenticate.scm (&git-authentication-error) (&unsigned-commit-error, &unauthorized-commit-error) (&signature-verification-error, &missing-key-error): New condition types. (commit-signing-key, authenticate-commit): Raise them. --- guix/git-authenticate.scm | 44 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index 4217ab6d27..b73f957105 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -41,7 +41,18 @@ authenticate-commits load-keyring-from-reference previously-authenticated-commits - cache-authenticated-commit)) + cache-authenticated-commit + + git-authentication-error? + git-authentication-error-commit + unsigned-commit-error? + unauthorized-commit-error? + unauthorized-commit-error-signing-key + signature-verification-error? + signature-verification-error-keyring + signature-verification-error-signature + missing-key-error? + missing-key-error-signature)) ;;; Commentary: ;;; @@ -52,6 +63,27 @@ ;;; ;;; Code: +(define-condition-type &git-authentication-error &error + git-authentication-error? + (commit git-authentication-error-commit)) + +(define-condition-type &unsigned-commit-error &git-authentication-error + unsigned-commit-error?) + +(define-condition-type &unauthorized-commit-error &git-authentication-error + unauthorized-commit-error? + (signing-key unauthorized-commit-error-signing-key)) + +(define-condition-type &signature-verification-error &git-authentication-error + signature-verification-error? + (signature signature-verification-error-signature) + (keyring signature-verification-error-keyring)) + +(define-condition-type &missing-key-error &git-authentication-error + missing-key-error? + (signature missing-key-error-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 @@ -64,9 +96,10 @@ not in KEYRING." (values #f #f))))) (unless signature (raise (condition + (&unsigned-commit-error (commit commit-id)) (&message (message (format #f (G_ "commit ~a lacks a signature") - commit-id)))))) + (oid->string commit-id))))))) (let ((signature (string->openpgp-packet signature))) (with-fluids ((%default-port-encoding "UTF-8")) @@ -77,12 +110,17 @@ not in KEYRING." ('bad-signature ;; There's a signature but it's invalid. (raise (condition + (&signature-verification-error (commit commit-id) + (signature signature) + (keyring keyring)) (&message (message (format #f (G_ "signature verification failed \ for commit ~a") (oid->string commit-id))))))) ('missing-key (raise (condition + (&missing-key-error (commit commit-id) + (signature signature)) (&message (message (format #f (G_ "could not authenticate \ commit ~a: key ~a is missing") @@ -138,6 +176,8 @@ not specify anything, fall back to DEFAULT-AUTHORIZATIONS." (commit-authorized-keys repository commit default-authorizations)) (raise (condition + (&unauthorized-commit-error (commit id) + (signing-key signing-key)) (&message (message (format #f (G_ "commit ~a not signed by an authorized \ key: ~a") -- 2.26.2 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#41653] [PATCH 4/4] git-authenticate: Add tests. 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions Ludovic Courtès @ 2020-06-01 21:41 ` Ludovic Courtès 2 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-01 21:41 UTC (permalink / raw) To: 41653; +Cc: Ludovic Courtès * guix/tests/git.scm (call-with-environment-variables) (with-environment-variables): Remove. * guix/tests/git.scm (populate-git-repository): Add clauses for signed commits and signed merges. * guix/tests/gnupg.scm: New file. * tests/git-authenticate.scm: New file. * tests/ed25519bis.key, tests/ed25519bis.sec: New files. * Makefile.am (dist_noinst_DATA): Add 'guix/tests/gnupg.scm'. (SCM_TESTS): Add 'tests/git-authenticate.scm'. (EXTRA_DIST): Add tests/ed25519bis.{key,sec}. --- .dir-locals.el | 2 + Makefile.am | 6 +- guix/tests/git.scm | 26 ++-- guix/tests/gnupg.scm | 72 ++++++++++ tests/ed25519bis.key | 10 ++ tests/ed25519bis.sec | 10 ++ tests/git-authenticate.scm | 286 +++++++++++++++++++++++++++++++++++++ 7 files changed, 393 insertions(+), 19 deletions(-) create mode 100644 guix/tests/gnupg.scm create mode 100644 tests/ed25519bis.key create mode 100644 tests/ed25519bis.sec create mode 100644 tests/git-authenticate.scm diff --git a/.dir-locals.el b/.dir-locals.el index fcde914e60..e34ddc5a85 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -96,6 +96,8 @@ (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1)) (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2)) + (eval . (put 'with-environment-variables 'scheme-indent-function 1)) + (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1)) ;; This notably allows '(' in Paredit to not insert a space when the ;; preceding symbol is one of these. diff --git a/Makefile.am b/Makefile.am index db30004b1b..f3985f9572 100644 --- a/Makefile.am +++ b/Makefile.am @@ -319,7 +319,8 @@ MODULES += $(STORE_MODULES) dist_noinst_DATA = \ guix/tests.scm \ guix/tests/http.scm \ - guix/tests/git.scm + guix/tests/git.scm \ + guix/tests/gnupg.scm # Auxiliary files for packages. AUX_FILES = \ @@ -404,6 +405,7 @@ SCM_TESTS = \ tests/gem.scm \ tests/gexp.scm \ tests/git.scm \ + tests/git-authenticate.scm \ tests/glob.scm \ tests/gnu-maintenance.scm \ tests/grafts.scm \ @@ -576,6 +578,8 @@ EXTRA_DIST += \ tests/dsa.key \ tests/ed25519.key \ tests/ed25519.sec \ + tests/ed25519bis.key \ + tests/ed25519bis.sec \ build-aux/config.rpath \ bootstrap \ doc/build.scm \ diff --git a/guix/tests/git.scm b/guix/tests/git.scm index 566660e85e..c77c544e03 100644 --- a/guix/tests/git.scm +++ b/guix/tests/git.scm @@ -21,6 +21,7 @@ #:use-module ((guix git) #:select (with-repository)) #:use-module (guix utils) #:use-module (guix build utils) + #:use-module ((guix tests gnupg) #:select (with-environment-variables)) #:use-module (ice-9 match) #:use-module (ice-9 control) #:export (git-command @@ -30,24 +31,6 @@ (define git-command (make-parameter "git")) -(define (call-with-environment-variables variables thunk) - "Call THUNK with the environment VARIABLES set." - (let ((environment (environ))) - (dynamic-wind - (lambda () - (for-each (match-lambda - ((variable value) - (setenv variable value))) - variables)) - thunk - (lambda () - (environ environment))))) - -(define-syntax-rule (with-environment-variables variables exp ...) - "Evaluate EXP with the given environment VARIABLES set." - (call-with-environment-variables variables - (lambda () exp ...))) - (define (populate-git-repository directory directives) "Initialize a new Git checkout and repository in DIRECTORY and apply DIRECTIVES. Each element of DIRECTIVES is an sexp like: @@ -97,6 +80,9 @@ Return DIRECTORY on success." ((('commit text) rest ...) (git "commit" "-m" text) (loop rest)) + ((('commit text ('signer fingerprint)) rest ...) + (git "commit" "-m" text (string-append "--gpg-sign=" fingerprint)) + (loop rest)) ((('tag name) rest ...) (git "tag" name) (loop rest)) @@ -108,6 +94,10 @@ Return DIRECTORY on success." (loop rest)) ((('merge branch message) rest ...) (git "merge" branch "-m" message) + (loop rest)) + ((('merge branch message ('signer fingerprint)) rest ...) + (git "merge" branch "-m" message + (string-append "--gpg-sign=" fingerprint)) (loop rest))))) (define (call-with-temporary-git-repository directives proc) diff --git a/guix/tests/gnupg.scm b/guix/tests/gnupg.scm new file mode 100644 index 0000000000..6e7fdbcf65 --- /dev/null +++ b/guix/tests/gnupg.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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 tests gnupg) + #:use-module (guix utils) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:export (gpg-command + gpgconf-command + with-fresh-gnupg-setup + + with-environment-variables)) + +(define (call-with-environment-variables variables thunk) + "Call THUNK with the environment VARIABLES set." + (let ((environment (environ))) + (dynamic-wind + (lambda () + (for-each (match-lambda + ((variable value) + (setenv variable value))) + variables)) + thunk + (lambda () + (environ environment))))) + +(define-syntax-rule (with-environment-variables variables exp ...) + "Evaluate EXP with the given environment VARIABLES set." + (call-with-environment-variables variables + (lambda () exp ...))) + +(define gpg-command + (make-parameter "gpg")) + +(define gpgconf-command + (make-parameter "gpgconf")) + +(define (call-with-fresh-gnupg-setup imported thunk) + (call-with-temporary-directory + (lambda (home) + (with-environment-variables `(("GNUPGHOME" ,home)) + (dynamic-wind + (lambda () + (for-each (lambda (file) + (invoke (gpg-command) "--import" file)) + imported)) + thunk + (lambda () + ;; Terminate 'gpg-agent' & co. + (invoke (gpgconf-command) "--kill" "all"))))))) + +(define-syntax-rule (with-fresh-gnupg-setup imported exp ...) + "Evaluate EXP in the context of a fresh GnuPG setup where all the files +listed in IMPORTED, and only them, have been imported. This sets 'GNUPGHOME' +such that the user's real GnuPG files are left untouched. The 'gpg-agent' +process is terminated afterwards." + (call-with-fresh-gnupg-setup imported (lambda () exp ...))) diff --git a/tests/ed25519bis.key b/tests/ed25519bis.key new file mode 100644 index 0000000000..f5329105d5 --- /dev/null +++ b/tests/ed25519bis.key @@ -0,0 +1,10 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- + +mDMEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw +8jAw0OG0IkNoYXJsaWUgR3VpeCA8Y2hhcmxpZUBleGFtcGxlLm9yZz6IlgQTFggA +PhYhBKBDaY1jer75FlruS4IkDtyrgNqDBQJe1Ww2AhsDBQkDwmcABQsJCAcCBhUK +CQgLAgQWAgMBAh4BAheAAAoJEIIkDtyrgNqDM6cA/idDdoxo9SU+witdTXt24APH +yRzHbX9Iyh4dZNIek9JwAP9E0BwSvDHB4LY9z4RWf2hJp3dm/yZ/jEpK+w4BGN4J +Ag== +=JIU0 +-----END PGP PUBLIC KEY BLOCK----- diff --git a/tests/ed25519bis.sec b/tests/ed25519bis.sec new file mode 100644 index 0000000000..059765f557 --- /dev/null +++ b/tests/ed25519bis.sec @@ -0,0 +1,10 @@ +-----BEGIN PGP PRIVATE KEY BLOCK----- + +lFgEXtVsNhYJKwYBBAHaRw8BAQdAnLsYdh3BpeK1xDguJE80XW2/MSmqeeP6pbQw +8jAw0OEAAP9lsLf3tk0OH1X4By4flYSz4PBFo40EwS4t6xx76poUphCEtCJDaGFy +bGllIEd1aXggPGNoYXJsaWVAZXhhbXBsZS5vcmc+iJYEExYIAD4WIQSgQ2mNY3q+ ++RZa7kuCJA7cq4DagwUCXtVsNgIbAwUJA8JnAAULCQgHAgYVCgkICwIEFgIDAQIe +AQIXgAAKCRCCJA7cq4DagzOnAP4nQ3aMaPUlPsIrXU17duADx8kcx21/SMoeHWTS +HpPScAD/RNAcErwxweC2Pc+EVn9oSad3Zv8mf4xKSvsOARjeCQI= +=gUik +-----END PGP PRIVATE KEY BLOCK----- diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm new file mode 100644 index 0000000000..5937c37ee6 --- /dev/null +++ b/tests/git-authenticate.scm @@ -0,0 +1,286 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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 (test-git-authenticate) + #:use-module (git) + #:use-module (guix git) + #:use-module (guix git-authenticate) + #:use-module (guix openpgp) + #:use-module (guix tests git) + #:use-module (guix tests gnupg) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports)) + +;; Test the (guix git-authenticate) tools. + +(define %ed25519-public-key-file + (search-path %load-path "tests/ed25519.key")) +(define %ed25519-secret-key-file + (search-path %load-path "tests/ed25519.sec")) +(define %ed25519bis-public-key-file + (search-path %load-path "tests/ed25519bis.key")) +(define %ed25519bis-secret-key-file + (search-path %load-path "tests/ed25519bis.sec")) + +(define (read-openpgp-packet file) + (get-openpgp-packet + (open-bytevector-input-port + (call-with-input-file file read-radix-64)))) + +(define key-fingerprint + (compose openpgp-format-fingerprint + openpgp-public-key-fingerprint + read-openpgp-packet)) + +(define (key-id file) + (define id + (openpgp-public-key-id (read-openpgp-packet))) + + (string-pad (number->string id 16) 16 #\0)) + +(define (gpg+git-available?) + (and (which (git-command)) + (which (gpg-command)) (which (gpgconf-command)))) + +\f +(test-begin "git-authenticate") + +(unless (which (git-command)) (test-skip 1)) +(test-assert "unsigned commits" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.txt" "B") + (commit "second commit")) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second"))) + (guard (c ((unsigned-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit1)))) + (authenticate-commits repository (list commit1 commit2) + #:keyring-reference "master") + 'failed))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, default authorizations" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository directory + `((add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second"))) + (authenticate-commits repository (list commit1 commit2) + #:default-authorizations + (list (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file))) + #:keyring-reference "master")))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository directory + `((add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add ".guix-authorizations" + ,(object->string `(authorizations (version 0) ()))) ;empty + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "third commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third"))) + ;; COMMIT1 and COMMIT2 are fine. + (and (authenticate-commits repository (list commit1 commit2) + #:keyring-reference "master") + + ;; COMMIT3 is signed by an unauthorized key according to its + ;; parent's '.guix-authorizations' file. + (guard (c ((unauthorized-commit-error? c) + (and (oid=? (git-authentication-error-commit c) + (commit-id commit3)) + (bytevector=? + (openpgp-public-key-fingerprint + (unauthorized-commit-error-signing-key c)) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file)))))) + (authenticate-commits repository + (list commit1 commit2 commit3) + #:keyring-reference "master") + 'failed))))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations, unauthorized merge" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add "signer1.key" + ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "signer2.key" + ,(call-with-input-file %ed25519bis-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (branch "devel") + (checkout "devel") + (add "devel/1.txt" "1") + (commit "first devel commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file))) + (checkout "master") + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (merge "devel" "merge" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((master1 (find-commit repository "first commit")) + (master2 (find-commit repository "second commit")) + (devel1 (find-commit repository "first devel commit")) + (merge (find-commit repository "merge"))) + (define (correct? c commit) + (and (oid=? (git-authentication-error-commit c) + (commit-id commit)) + (bytevector=? + (openpgp-public-key-fingerprint + (unauthorized-commit-error-signing-key c)) + (openpgp-public-key-fingerprint + (read-openpgp-packet %ed25519bis-public-key-file))))) + + (and (authenticate-commits repository (list master1 master2) + #:keyring-reference "master") + + ;; DEVEL1 is signed by an unauthorized key according to its + ;; parent's '.guix-authorizations' file. + (guard (c ((unauthorized-commit-error? c) + (correct? c devel1))) + (authenticate-commits repository + (list master1 devel1) + #:keyring-reference "master") + #f) + + ;; MERGE is authorized but one of its ancestors is not. + (guard (c ((unauthorized-commit-error? c) + (correct? c devel1))) + (authenticate-commits repository + (list master1 master2 + devel1 merge) + #:keyring-reference "master") + #f))))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations, authorized merge" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add "signer1.key" + ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "signer2.key" + ,(call-with-input-file %ed25519bis-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (branch "devel") + (checkout "devel") + (add ".guix-authorizations" + ,(object->string ;add the second signer + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Alice")) + (,(key-fingerprint + %ed25519bis-public-key-file)))))) + (commit "first devel commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "devel/2.txt" "2") + (commit "second devel commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file))) + (checkout "master") + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (merge "devel" "merge" + (signer ,(key-fingerprint %ed25519-public-key-file))) + ;; After the merge, the second signer is authorized. + (add "c.txt" "C") + (commit "third commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file)))) + (with-repository directory repository + (let ((master1 (find-commit repository "first commit")) + (master2 (find-commit repository "second commit")) + (devel1 (find-commit repository "first devel commit")) + (devel2 (find-commit repository "second devel commit")) + (merge (find-commit repository "merge")) + (master3 (find-commit repository "third commit"))) + (authenticate-commits repository + (list master1 master2 devel1 devel2 + merge master3) + #:keyring-reference "master")))))) + +(test-end "git-authenticate") + -- 2.26.2 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests 2020-06-01 21:29 [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès @ 2020-06-05 21:13 ` Ludovic Courtès 2020-06-07 21:19 ` Ludovic Courtès 2 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-05 21:13 UTC (permalink / raw) To: 41653 Hi, Ludovic Courtès <ludo@gnu.org> skribis: > Add (guix git-authenticate). > git-authenticate: Don't hard-code "origin/" for keyring reference. > git-authenticate: Raise proper SRFI-35 conditions. > git-authenticate: Add tests. Pushed! I still take feedback though, for instance about the tests, because I’d rather have more eyeballs for this kind of code. Ludo’. ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests 2020-06-01 21:29 [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès 2020-06-05 21:13 ` [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès @ 2020-06-07 21:19 ` Ludovic Courtès 2 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2020-06-07 21:19 UTC (permalink / raw) To: 41653 [-- Attachment #1: Type: text/plain, Size: 570 bytes --] Ludovic Courtès <ludo@gnu.org> skribis: > Add (guix git-authenticate). > git-authenticate: Don't hard-code "origin/" for keyring reference. > git-authenticate: Raise proper SRFI-35 conditions. > git-authenticate: Add tests. As a followup, I pushed this patch: https://git.savannah.gnu.org/cgit/guix.git/commit/?id=e78275608065ef073775fabb9f1a757da65851f2 Its effect is to prevent removal of ‘.guix-authorizations’ since doing that would trivially force the authentication code to fall back to ‘default-authorizations’. Ludo’. [-- Attachment #2: Type: text/x-patch, Size: 6371 bytes --] commit e78275608065ef073775fabb9f1a757da65851f2 Author: Ludovic Courtès <ludo@gnu.org> Date: Sun Jun 7 23:06:41 2020 +0200 git-authenticate: Prevent removal of '.guix-authorizations'. * guix/git-authenticate.scm (commit-authorized-keys) [parents-have-authorizations-file?, assert-parents-lack-authorizations]: New procedures. Use the latter before returning DEFAULT-AUTHORIZATIONS. * guix/git.scm (false-if-git-not-found): Export. * guix/tests/git.scm (populate-git-repository): Add 'remove' clause. * tests/git-authenticate.scm ("signed commits, .guix-authorizations removed"): New test. diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index b73f957105..00d22ef479 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -19,6 +19,7 @@ (define-module (guix git-authenticate) #:use-module (git) #:use-module (guix base16) + #:use-module ((guix git) #:select (false-if-git-not-found)) #:use-module (guix i18n) #:use-module (guix openpgp) #:use-module ((guix utils) @@ -145,6 +146,27 @@ return a list of authorized fingerprints." "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 (parents-have-authorizations-file? commit) + ;; Return true if at least one of the parents of COMMIT has the + ;; '.guix-authorizations' file. + (find (lambda (commit) + (false-if-git-not-found + (tree-entry-bypath (commit-tree commit) + ".guix-authorizations"))) + (commit-parents commit))) + + (define (assert-parents-lack-authorizations commit) + ;; If COMMIT removes the '.guix-authorizations' file found in one of its + ;; parents, raise an error. + (when (parents-have-authorizations-file? commit) + (raise (condition + (&unauthorized-commit-error (commit (commit-id commit)) + (signing-key #f)) + (&message + (message (format #f (G_ "commit ~a attempts \ +to remove '.guix-authorizations' file") + (oid->string (commit-id commit))))))))) + (define (commit-authorizations commit) (catch 'git-error (lambda () @@ -155,7 +177,11 @@ does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." (open-bytevector-input-port (blob-content blob))))) (lambda (key error) (if (= (git-error-code error) GIT_ENOTFOUND) - default-authorizations + (begin + ;; Prevent removal of '.guix-authorizations' since it would make + ;; it trivial to force a fallback to DEFAULT-AUTHORIZATIONS. + (assert-parents-lack-authorizations commit) + default-authorizations) (throw key error))))) (apply lset-intersection bytevector=? diff --git a/guix/git.scm b/guix/git.scm index 1c45afa050..1671f57d9f 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -39,6 +39,7 @@ honor-system-x509-certificates! with-repository + false-if-git-not-found update-cached-checkout url+commit->name latest-repository-commit diff --git a/guix/tests/git.scm b/guix/tests/git.scm index 5d7056bb53..b8e5f7e643 100644 --- a/guix/tests/git.scm +++ b/guix/tests/git.scm @@ -76,6 +76,9 @@ Return DIRECTORY on success." port))) (git "add" file) (loop rest))) + ((('remove file) rest ...) + (git "rm" "-f" file) + (loop rest)) ((('commit text) rest ...) (git "commit" "-m" text) (loop rest)) diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm index 5937c37ee6..84689d628e 100644 --- a/tests/git-authenticate.scm +++ b/tests/git-authenticate.scm @@ -282,5 +282,46 @@ merge master3) #:keyring-reference "master")))))) +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "signed commits, .guix-authorizations removed" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository directory + `((add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (remove ".guix-authorizations") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "third commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third"))) + ;; COMMIT1 and COMMIT2 are fine. + (and (authenticate-commits repository (list commit1 commit2) + #:keyring-reference "master") + + ;; COMMIT3 is rejected because COMMIT2 removes + ;; '.guix-authorizations'. + (guard (c ((unauthorized-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit2)))) + (authenticate-commits repository + (list commit1 commit2 commit3) + #:keyring-reference "master") + 'failed))))))) + (test-end "git-authenticate") ^ permalink raw reply related [flat|nested] 7+ messages in thread
end of thread, other threads:[~2020-06-07 21:20 UTC | newest] Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2020-06-01 21:29 [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 1/4] Add (guix git-authenticate) Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions Ludovic Courtès 2020-06-01 21:41 ` [bug#41653] [PATCH 4/4] git-authenticate: Add tests Ludovic Courtès 2020-06-05 21:13 ` [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests Ludovic Courtès 2020-06-07 21:19 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/guix.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).