GNU bug report logs - #41653
[PATCH 0/4] Add (guix git-authenticate) with tests

Previous Next

Package: guix-patches;

Reported by: Ludovic Courtès <ludo <at> gnu.org>

Date: Mon, 1 Jun 2020 21:31:01 UTC

Severity: normal

Tags: fixed, patch

Done: Ludovic Courtès <ludo <at> gnu.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 41653 in the body.
You can then email your comments to 41653 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Mon, 01 Jun 2020 21:31:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ludovic Courtès <ludo <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Mon, 01 Jun 2020 21:31:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/4] Add (guix git-authenticate) with tests
Date: Mon,  1 Jun 2020 23:29:57 +0200
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





Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Mon, 01 Jun 2020 21:42:02 GMT) Full text and rfc822 format available.

Message #8 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/4] Add (guix git-authenticate).
Date: Mon,  1 Jun 2020 23:41:44 +0200
* 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))
 
-
-;;;
-;;; 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))))))
-
 
 ;;;
 ;;; 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 <at> 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))
+
+
+;;;
+;;; 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





Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Mon, 01 Jun 2020 21:43:01 GMT) Full text and rfc822 format available.

Message #11 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions.
Date: Mon,  1 Jun 2020 23:41:46 +0200
* 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





Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Mon, 01 Jun 2020 21:43:02 GMT) Full text and rfc822 format available.

Message #14 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 4/4] git-authenticate: Add tests.
Date: Mon,  1 Jun 2020 23:41:47 +0200
* 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 <at> 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 <at> 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))))
+
+
+(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





Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Mon, 01 Jun 2020 21:43:02 GMT) Full text and rfc822 format available.

Message #17 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring
 reference.
Date: Mon,  1 Jun 2020 23:41:45 +0200
* 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





Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Fri, 05 Jun 2020 21:14:02 GMT) Full text and rfc822 format available.

Message #20 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Subject: Re: [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests
Date: Fri, 05 Jun 2020 23:13:40 +0200
Hi,

Ludovic Courtès <ludo <at> 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’.




Added tag(s) fixed. Request was from Ludovic Courtès <ludo <at> gnu.org> to control <at> debbugs.gnu.org. (Fri, 05 Jun 2020 21:14:02 GMT) Full text and rfc822 format available.

bug closed, send any further explanations to 41653 <at> debbugs.gnu.org and Ludovic Courtès <ludo <at> gnu.org> Request was from Ludovic Courtès <ludo <at> gnu.org> to control <at> debbugs.gnu.org. (Fri, 05 Jun 2020 21:14:02 GMT) Full text and rfc822 format available.

Information forwarded to guix-patches <at> gnu.org:
bug#41653; Package guix-patches. (Sun, 07 Jun 2020 21:20:01 GMT) Full text and rfc822 format available.

Message #27 received at 41653 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 41653 <at> debbugs.gnu.org
Subject: Re: [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests
Date: Sun, 07 Jun 2020 23:19:25 +0200
[Message part 1 (text/plain, inline)]
Ludovic Courtès <ludo <at> 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’.

[Message part 2 (text/x-patch, inline)]
commit e78275608065ef073775fabb9f1a757da65851f2
Author: Ludovic Courtès <ludo <at> 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")
 

bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 06 Jul 2020 11:24:07 GMT) Full text and rfc822 format available.

This bug report was last modified 3 years and 266 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.