[PATCH 0/4] Add (guix git-authenticate) with tests

  • Done
  • quality assurance status badge
Details
One participant
  • Ludovic Courtès
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
L
L
Ludovic Courtès wrote on 1 Jun 2020 23:29
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20200601212957.3056-1-ludo@gnu.org
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

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
L
L
Ludovic Courtès wrote on 1 Jun 2020 23:41
[PATCH 1/4] Add (guix git-authenticate).
(address . 41653@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20200601214147.3357-1-ludo@gnu.org
* 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

Toggle diff (461 lines)
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@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 . ,
This message was truncated. Download the full message here.
L
L
Ludovic Courtès wrote on 1 Jun 2020 23:41
[PATCH 3/4] git-authenticate: Raise proper SRFI-35 conditions.
(address . 41653@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20200601214147.3357-3-ludo@gnu.org
* 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(-)

Toggle diff (93 lines)
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
L
L
Ludovic Courtès wrote on 1 Jun 2020 23:41
[PATCH 4/4] git-authenticate: Add tests.
(address . 41653@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20200601214147.3357-4-ludo@gnu.org
* 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

Toggle diff (465 lines)
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))))
+
+
+(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
This message was truncated. Download the full message here.
L
L
Ludovic Courtès wrote on 1 Jun 2020 23:41
[PATCH 2/4] git-authenticate: Don't hard-code "origin/" for keyring reference.
(address . 41653@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20200601214147.3357-2-ludo@gnu.org
* 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(-)

Toggle diff (17 lines)
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
L
L
Ludovic Courtès wrote on 5 Jun 2020 23:13
Re: [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests
(address . 41653@debbugs.gnu.org)
87wo4lxlkr.fsf@gnu.org
Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (5 lines)
> 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’.
L
L
Ludovic Courtès wrote on 5 Jun 2020 23:13
control message for bug #41653
(address . control@debbugs.gnu.org)
87v9k5xlkf.fsf@gnu.org
tags 41653 fixed
close 41653
quit
L
L
Ludovic Courtès wrote on 7 Jun 2020 23:19
Re: [bug#41653] [PATCH 0/4] Add (guix git-authenticate) with tests
(address . 41653@debbugs.gnu.org)
87img2r2ua.fsf@gnu.org
Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (5 lines)
> 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:


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: file
?