diff options
Diffstat (limited to 'guix/tests')
| -rw-r--r-- | guix/tests/git.scm | 28 | ||||
| -rw-r--r-- | guix/tests/gnupg.scm | 52 |
2 files changed, 62 insertions, 18 deletions
diff --git a/guix/tests/git.scm b/guix/tests/git.scm index 566660e85e..b8e5f7e643 100644 --- a/guix/tests/git.scm +++ b/guix/tests/git.scm @@ -30,24 +30,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: @@ -94,9 +76,15 @@ 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)) + ((('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 +96,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..47c858d232 --- /dev/null +++ b/guix/tests/gnupg.scm @@ -0,0 +1,52 @@ +;;; 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)) + +(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 ...))) |