git-authenticate: Add tests.
* 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}.
This commit is contained in:
Ludovic Courtès
parent
f8213f1bca
commit
c83eedba23
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 ...)))
|
||||
|
|
@ -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-----
|
||||
|
|
@ -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-----
|
||||
|
|
@ -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-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")
|
||||
|
||||
Loading…
Reference in New Issue