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 @@ (define-module (guix tests git) #: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-module (guix tests git) (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 @@ (define (git command . args) ((('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 @@ (define (git command . args) (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 +;;; +;;; 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 . + +(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 +;;; +;;; 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 . + +(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") +