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
