mirror of
git://git.gnupg.org/gnupg.git
synced 2025-01-30 16:17:02 +01:00
tests: Move environment creation and teardown into each test.
* tests/gpgscm/tests.scm (log): New function. * tests/openpgp/run-tests.scm (run-tests-parallel): Do not run the startup and teardown scripts. (run-tests-sequential): Likewise. * tests/openpgp/setup.scm: Move all functions... * tests/openpgp/defs.scm: ... here and make them less verbose. (setup-environment): New function. (setup-legacy-environment): Likewise. (start-agent): Make less verbose, run 'stop-agent' at interpreter exit. (stop-agent): Make less verbose. * tests/openpgp/finish.scm: Drop file. * tests/openpgp/Makefile.am (EXTRA_DIST): Drop removed file. * tests/openpgp/4gb-packet.scm: Use 'setup-environment' or 'setup-legacy-environment' as appropriate. * tests/openpgp/armdetach.scm: Likewise. * tests/openpgp/armdetachm.scm: Likewise. * tests/openpgp/armencrypt.scm: Likewise. * tests/openpgp/armencryptp.scm: Likewise. * tests/openpgp/armor.scm: Likewise. * tests/openpgp/armsignencrypt.scm: Likewise. * tests/openpgp/armsigs.scm: Likewise. * tests/openpgp/clearsig.scm: Likewise. * tests/openpgp/conventional-mdc.scm: Likewise. * tests/openpgp/conventional.scm: Likewise. * tests/openpgp/decrypt-dsa.scm: Likewise. * tests/openpgp/decrypt.scm: Likewise. * tests/openpgp/default-key.scm: Likewise. * tests/openpgp/detach.scm: Likewise. * tests/openpgp/detachm.scm: Likewise. * tests/openpgp/ecc.scm: Likewise. * tests/openpgp/encrypt-dsa.scm: Likewise. * tests/openpgp/encrypt.scm: Likewise. * tests/openpgp/encryptp.scm: Likewise. * tests/openpgp/export.scm: Likewise. * tests/openpgp/finish.scm: Likewise. * tests/openpgp/genkey1024.scm: Likewise. * tests/openpgp/gpgtar.scm: Likewise. * tests/openpgp/gpgv-forged-keyring.scm: Likewise. * tests/openpgp/import.scm: Likewise. * tests/openpgp/issue2015.scm: Likewise. * tests/openpgp/issue2417.scm: Likewise. * tests/openpgp/issue2419.scm: Likewise. * tests/openpgp/key-selection.scm: Likewise. * tests/openpgp/mds.scm: Likewise. * tests/openpgp/multisig.scm: Likewise. * tests/openpgp/quick-key-manipulation.scm: Likewise. * tests/openpgp/seat.scm: Likewise. * tests/openpgp/shell.scm: Likewise. * tests/openpgp/signencrypt-dsa.scm: Likewise. * tests/openpgp/signencrypt.scm: Likewise. * tests/openpgp/sigs-dsa.scm: Likewise. * tests/openpgp/sigs.scm: Likewise. * tests/openpgp/ssh.scm: Likewise. * tests/openpgp/tofu.scm: Likewise. * tests/openpgp/use-exact-key.scm: Likewise. * tests/openpgp/verify.scm: Likewise. * tests/openpgp/version.scm: Likewise. * tests/openpgp/issue2346.scm: Likewise and simplify. -- The previous Bourne Shell-based test suite created the environment before running all tests, and tore it down after executing them. When we created the Scheme-based test suite, we kept this design at first, but introduced a way to run each test in its own environment to prevent tests from interfering with each other. Nevertheless, every test started out with the same environment. Move the creation of the test environment into each test. This gives us finer control over the environment each test is run in. It also makes it possible to run each test by simply executing it using gpgscm without the use of the runner. Furthermore, it has the neat side-effect of speeding up the test suite if run in parallel. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
ac078469cb
commit
a55393cb5f
@ -38,6 +38,10 @@
|
||||
(apply echo msg)
|
||||
(flush-stdio))
|
||||
|
||||
(define (log . msg)
|
||||
(if (> (*verbose*) 0)
|
||||
(apply info msg)))
|
||||
|
||||
(define (error . msg)
|
||||
(apply info msg)
|
||||
(exit 1))
|
||||
|
@ -21,6 +21,7 @@
|
||||
;; 2^32-1 as invalid and exit with status code 2.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc"))))
|
||||
(info "Can parse 4GB packets.")
|
||||
|
@ -193,7 +193,7 @@ sample_msgs = samplemsgs/issue2419.asc
|
||||
EXTRA_DIST = defs.scm $(XTESTS) $(TEST_FILES) \
|
||||
mkdemodirs signdemokey $(priv_keys) $(sample_keys) \
|
||||
$(sample_msgs) ChangeLog-2011 run-tests.scm \
|
||||
setup.scm finish.scm shell.scm
|
||||
setup.scm shell.scm
|
||||
|
||||
CLEANFILES = prepared.stamp x y yy z out err $(data_files) \
|
||||
plain-1 plain-2 plain-3 trustdb.gpg *.lock .\#lk* \
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking armored detached signatures"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define files (append plain-files data-files))
|
||||
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking armored encryption"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking armored encryption and decryption using pipes"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define armored_key_8192 "-----BEGIN PGP PUBLIC KEY BLOCK-----
|
||||
Version: SKS 1.0.9
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking armored signing and encryption"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking armored signatures"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define (check-signing args input)
|
||||
(lambda (source sink)
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define s2k '--s2k-count=65536)
|
||||
(define passphrase "Hier spricht HAL")
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define s2k '--s2k-count=65536)
|
||||
(define passphrase "Hier spricht HAL")
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking decryption of supplied DSA encrypted file"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking decryption of supplied files"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
;; Import the sample key
|
||||
;;
|
||||
|
@ -146,10 +146,132 @@
|
||||
(if (number? verbose)
|
||||
(*set-verbose!* verbose)))
|
||||
|
||||
;;
|
||||
;; Support for test environment creation and teardown.
|
||||
;;
|
||||
|
||||
(define (make-test-data filename size)
|
||||
(call-with-binary-output-file
|
||||
filename
|
||||
(lambda (port)
|
||||
(display (make-random-string size) port))))
|
||||
|
||||
(define (create-gpghome)
|
||||
(log "Creating test environment...")
|
||||
|
||||
(srandom (getpid))
|
||||
(make-test-data "random_seed" 600)
|
||||
|
||||
(log "Creating configuration files")
|
||||
(for-each
|
||||
(lambda (name)
|
||||
(file-copy (in-srcdir (string-append name ".tmpl")) name)
|
||||
(let ((p (open-input-output-file name)))
|
||||
(cond
|
||||
((string=? "gpg.conf" name)
|
||||
(if have-opt-always-trust
|
||||
(display "no-auto-check-trustdb\n" p))
|
||||
(display (string-append "agent-program "
|
||||
(tool 'gpg-agent)
|
||||
"|--debug-quick-random\n") p)
|
||||
(display "allow-weak-digest-algos\n" p))
|
||||
((string=? "gpg-agent.conf" name)
|
||||
(display (string-append "pinentry-program " PINENTRY "\n") p)))))
|
||||
'("gpg.conf" "gpg-agent.conf")))
|
||||
|
||||
;; Initialize the test environment, install appropriate configuration
|
||||
;; and start the agent, without any keys.
|
||||
(define (setup-environment)
|
||||
(create-gpghome)
|
||||
(start-agent))
|
||||
|
||||
(define (create-legacy-gpghome)
|
||||
(log "Creating sample data files")
|
||||
(for-each
|
||||
(lambda (size)
|
||||
(make-test-data (string-append "data-" (number->string size))
|
||||
size))
|
||||
'(500 9000 32000 80000))
|
||||
|
||||
(log "Unpacking samples")
|
||||
(for-each
|
||||
(lambda (name)
|
||||
(dearmor (in-srcdir (string-append name "o.asc")) name))
|
||||
'("plain-1" "plain-2" "plain-3" "plain-large"))
|
||||
|
||||
(mkdir "private-keys-v1.d" "-rwx")
|
||||
|
||||
(log "Storing private keys")
|
||||
(for-each
|
||||
(lambda (name)
|
||||
(dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
|
||||
(string-append "private-keys-v1.d/" name ".key")))
|
||||
'("50B2D4FA4122C212611048BC5FC31BD44393626E"
|
||||
"7E201E28B6FEB2927B321F443205F4724EBE637E"
|
||||
"13FDB8809B17C5547779F9D205C45F47CE0217CE"
|
||||
"343D8AF79796EE107D645A2787A9D9252F924E6F"
|
||||
"8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"
|
||||
"0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255"
|
||||
"FD692BD59D6640A84C8422573D469F84F3B98E53"
|
||||
"76F7E2B35832976B50A27A282D9B87E44577EB66"
|
||||
"A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"
|
||||
"00FE67F28A52A8AA08FFAED20AF832DA916D1985"
|
||||
"1DF48228FEFF3EC2481B106E0ACA8C465C662CC5"
|
||||
"A2832820DC9F40751BDCD375BB0945BA33EC6B4C"
|
||||
"ADE710D74409777B7729A7653373D820F67892E0"
|
||||
"CEFC51AF91F68A2904FBFF62C4F075A4785B803F"
|
||||
"1E28F20E41B54C2D1234D896096495FF57E08D18"
|
||||
"EB33B687EB8581AB64D04852A54453E85F3DF62D"
|
||||
"C6A6390E9388CDBAD71EAEA698233FE5E04F001E"
|
||||
"D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3"))
|
||||
|
||||
(log "Importing public demo and test keys")
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(call-check `(,@GPG --yes --import ,(in-srcdir file))))
|
||||
(list "pubdemo.asc" "pubring.asc" key-file1))
|
||||
|
||||
(pipe:do
|
||||
(pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
|
||||
(pipe:spawn `(,@GPG --dearmor))
|
||||
(pipe:spawn `(,@GPG --yes --import))))
|
||||
|
||||
(define (preset-passphrases)
|
||||
(log "Presetting passphrases")
|
||||
;; one@example.com
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase def
|
||||
"50B2D4FA4122C212611048BC5FC31BD44393626E"))
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase def
|
||||
"7E201E28B6FEB2927B321F443205F4724EBE637E"))
|
||||
;; alpha@example.net
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase abc
|
||||
"76F7E2B35832976B50A27A282D9B87E44577EB66"))
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase abc
|
||||
"A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD")))
|
||||
|
||||
;; Initialize the test environment, install appropriate configuration
|
||||
;; and start the agent, with the keys from the legacy test suite.
|
||||
(define (setup-legacy-environment)
|
||||
(setup-environment)
|
||||
(if (member "--unpack-tarball" *args*)
|
||||
(begin
|
||||
(call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*)))
|
||||
(start-agent))
|
||||
(begin
|
||||
(create-gpghome)
|
||||
(start-agent)
|
||||
(create-legacy-gpghome)))
|
||||
(preset-passphrases))
|
||||
|
||||
;; Create the socket dir and start the agent.
|
||||
(define (start-agent)
|
||||
(echo "Starting gpg-agent...")
|
||||
(catch (echo "Warning: Creating socket directory failed:" (car *error*))
|
||||
(log "Starting gpg-agent...")
|
||||
(atexit stop-agent)
|
||||
(catch (log "Warning: Creating socket directory failed:" (car *error*))
|
||||
(call-popen `(,(tool 'gpgconf) --create-socketdir) ""))
|
||||
(call-check `(,(tool 'gpg-connect-agent) --verbose
|
||||
,(string-append "--agent-program=" (tool 'gpg-agent)
|
||||
@ -158,8 +280,8 @@
|
||||
|
||||
;; Stop the agent and remove the socket dir.
|
||||
(define (stop-agent)
|
||||
(echo "Stopping gpg-agent...")
|
||||
(catch (echo "Warning: Removing socket directory failed.")
|
||||
(log "Stopping gpg-agent...")
|
||||
(catch (log "Warning: Removing socket directory failed.")
|
||||
(call-popen `(,(tool 'gpgconf) --remove-socketdir) ""))
|
||||
(call-check `(,(tool 'gpg-connect-agent) --verbose --no-autostart
|
||||
killagent /bye)))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking detached signatures"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define files (append plain-files data-files))
|
||||
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define keygrips '("8E06A180EFFE4C65B812150CAF19BF30C0689A4C"
|
||||
"E4403F3FD7A443FAC29FEF288FA0D20AC212851E"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking encryption using DSA"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking encryption"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking encryption and decryption using pipes"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define (check-for predicate lines message)
|
||||
(unless (any predicate lines)
|
||||
|
@ -1,22 +0,0 @@
|
||||
#!/usr/bin/env gpgscm
|
||||
|
||||
;; Copyright (C) 2016 g10 Code GmbH
|
||||
;;
|
||||
;; This file is part of GnuPG.
|
||||
;;
|
||||
;; GnuPG 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.
|
||||
;;
|
||||
;; GnuPG 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 this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
|
||||
(stop-agent)
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(define (genkey config)
|
||||
(pipe:do
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(catch (skip "gpgtar not built")
|
||||
(call-check `(,(tool 'gpgtar) --help)))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define msg_signed_asc "
|
||||
-----BEGIN PGP SIGNED MESSAGE-----
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(info "Checking bug 894: segv importing certain keys.")
|
||||
(call-check `(,(tool 'gpg) --import ,(in-srcdir "bug894-test.asc")))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(info "Checking passphrase cache (issue2015)...")
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
|
@ -18,16 +18,11 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(define key (in-srcdir "samplekeys/issue2346.gpg"))
|
||||
(define old-home (getenv "GNUPGHOME"))
|
||||
|
||||
(with-temporary-working-directory
|
||||
(file-copy (path-join old-home "gpg.conf") "gpg.conf")
|
||||
(file-copy (path-join old-home "gpg-agent.conf") "gpg-agent.conf")
|
||||
(setenv "GNUPGHOME" "." #t)
|
||||
|
||||
(info "Checking import statistics (issue2346)...")
|
||||
(let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) "")))
|
||||
(unless (string-contains? status "IMPORT_RES 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0")
|
||||
(error "Unexpected number of keys imported" status))))
|
||||
(info "Checking import statistics (issue2346)...")
|
||||
(let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) "")))
|
||||
(unless (string-contains? status "IMPORT_RES 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0")
|
||||
(error "Unexpected number of keys imported" status)))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define old-home (getenv "GNUPGHOME"))
|
||||
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(info "Checking iobuf_peek corner case (issue2419)...")
|
||||
(lettmp
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
;; This test assumes a fixed time of 2004-01-01.
|
||||
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(define empty-string-hashes
|
||||
`((1 "D41D8CD98F00B204E9800998ECF8427E" "MD5")
|
||||
|
@ -24,6 +24,7 @@
|
||||
;; not really needed because verify could do the same. We keep it anyway.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(define sig-1ls1ls-valid "
|
||||
-----BEGIN PGP ARMORED FILE-----
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
;; XXX because of --always-trust, the trustdb is not created.
|
||||
;; Therefore, we redefine GPG without --always-trust.
|
||||
|
@ -109,49 +109,40 @@
|
||||
(define (report)
|
||||
(echo (string-append (status retcode) ":") name))))))
|
||||
|
||||
(define (run-tests-parallel setup teardown . tests)
|
||||
(define (run-tests-parallel setup tests)
|
||||
(lettmp (gpghome-tar)
|
||||
(setup::run-sync '--create-tarball gpghome-tar)
|
||||
(let loop ((pool (test-pool::new '())) (tests' tests))
|
||||
(if (null? tests')
|
||||
(let ((results (pool::wait)))
|
||||
(for-each (lambda (t)
|
||||
(let ((teardown' (teardown::set-directory
|
||||
t::directory)))
|
||||
(teardown'::run-sync-quiet))
|
||||
(unlink-recursively t::directory)
|
||||
(t::report)) results::procs)
|
||||
(exit (results::report)))
|
||||
(let* ((wd (mkdtemp))
|
||||
(test (car tests'))
|
||||
(test' (test::set-directory wd))
|
||||
(setup' (setup::set-directory wd)))
|
||||
(setup'::run-sync-quiet '--unpack-tarball gpghome-tar)
|
||||
(loop (pool::add (test'::run-async)) (cdr tests')))))))
|
||||
(test' (test::set-directory wd)))
|
||||
(loop (pool::add (test'::run-async '--unpack-tarball gpghome-tar))
|
||||
(cdr tests')))))))
|
||||
|
||||
(define (run-tests-sequential setup teardown . tests)
|
||||
(define (run-tests-sequential setup tests)
|
||||
(lettmp (gpghome-tar)
|
||||
(setup::run-sync '--create-tarball gpghome-tar)
|
||||
(let loop ((pool (test-pool::new '())) (tests' tests))
|
||||
(if (null? tests')
|
||||
(let ((results (pool::wait)))
|
||||
(for-each (lambda (t)
|
||||
(let ((teardown' (teardown::set-directory
|
||||
t::directory)))
|
||||
(teardown'::run-sync-quiet))
|
||||
(unlink-recursively t::directory))
|
||||
results::procs)
|
||||
(exit (results::report)))
|
||||
(let* ((wd (mkdtemp))
|
||||
(test (car tests'))
|
||||
(test' (test::set-directory wd))
|
||||
(setup' (setup::set-directory wd)))
|
||||
(setup'::run-sync-quiet '--unpack-tarball gpghome-tar)
|
||||
(loop (pool::add (test'::run-sync)) (cdr tests')))))))
|
||||
(test' (test::set-directory wd)))
|
||||
(loop (pool::add (test'::run-sync '--unpack-tarball gpghome-tar))
|
||||
(cdr tests')))))))
|
||||
|
||||
(let* ((runner (if (member "--parallel" *args*)
|
||||
run-tests-parallel
|
||||
run-tests-sequential))
|
||||
(tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*)))
|
||||
(apply runner (append (list (test::scm "setup.scm") (test::scm "finish.scm"))
|
||||
(map test::scm tests))))
|
||||
(runner (test::scm "setup.scm") (map test::scm tests)))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking encryption, signing, and producing armored output"
|
||||
|
@ -19,116 +19,12 @@
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
|
||||
(define (make-test-data filename size)
|
||||
(call-with-binary-output-file
|
||||
filename
|
||||
(lambda (port)
|
||||
(display (make-random-string size) port))))
|
||||
(unless (member "--create-tarball" *args*)
|
||||
(error "Usage: setup.scm --create-tarball <file>"))
|
||||
|
||||
(define (create-gpghome)
|
||||
(echo "Creating test environment...")
|
||||
|
||||
(srandom (getpid))
|
||||
(make-test-data "random_seed" 600)
|
||||
|
||||
(for-each-p
|
||||
"Creating configuration files"
|
||||
(lambda (name)
|
||||
(file-copy (in-srcdir (string-append name ".tmpl")) name)
|
||||
(let ((p (open-input-output-file name)))
|
||||
(cond
|
||||
((string=? "gpg.conf" name)
|
||||
(if have-opt-always-trust
|
||||
(display "no-auto-check-trustdb\n" p))
|
||||
(display (string-append "agent-program "
|
||||
(tool 'gpg-agent)
|
||||
"|--debug-quick-random\n") p)
|
||||
(display "allow-weak-digest-algos\n" p))
|
||||
((string=? "gpg-agent.conf" name)
|
||||
(display (string-append "pinentry-program " PINENTRY "\n") p)))))
|
||||
'("gpg.conf" "gpg-agent.conf"))
|
||||
|
||||
(for-each-p "Creating sample data files"
|
||||
(lambda (size)
|
||||
(make-test-data (string-append "data-" (number->string size))
|
||||
size))
|
||||
'(500 9000 32000 80000))
|
||||
|
||||
(for-each-p "Unpacking samples"
|
||||
(lambda (name)
|
||||
(dearmor (in-srcdir (string-append name "o.asc")) name))
|
||||
'("plain-1" "plain-2" "plain-3" "plain-large"))
|
||||
|
||||
;; XXX implement cleanup
|
||||
(catch '()
|
||||
(mkdir "private-keys-v1.d" "-rwx"))
|
||||
|
||||
(define counter (make-counter))
|
||||
(for-each-p' "Storing private keys"
|
||||
(lambda (name)
|
||||
(dearmor (in-srcdir (string-append "/privkeys/" name ".asc"))
|
||||
(string-append "private-keys-v1.d/" name ".key")))
|
||||
(lambda (name) (counter))
|
||||
'("50B2D4FA4122C212611048BC5FC31BD44393626E"
|
||||
"7E201E28B6FEB2927B321F443205F4724EBE637E"
|
||||
"13FDB8809B17C5547779F9D205C45F47CE0217CE"
|
||||
"343D8AF79796EE107D645A2787A9D9252F924E6F"
|
||||
"8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"
|
||||
"0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255"
|
||||
"FD692BD59D6640A84C8422573D469F84F3B98E53"
|
||||
"76F7E2B35832976B50A27A282D9B87E44577EB66"
|
||||
"A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"
|
||||
"00FE67F28A52A8AA08FFAED20AF832DA916D1985"
|
||||
"1DF48228FEFF3EC2481B106E0ACA8C465C662CC5"
|
||||
"A2832820DC9F40751BDCD375BB0945BA33EC6B4C"
|
||||
"ADE710D74409777B7729A7653373D820F67892E0"
|
||||
"CEFC51AF91F68A2904FBFF62C4F075A4785B803F"
|
||||
"1E28F20E41B54C2D1234D896096495FF57E08D18"
|
||||
"EB33B687EB8581AB64D04852A54453E85F3DF62D"
|
||||
"C6A6390E9388CDBAD71EAEA698233FE5E04F001E"
|
||||
"D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3"))
|
||||
|
||||
(for-each-p
|
||||
"Importing public demo and test keys"
|
||||
(lambda (file)
|
||||
(call-check `(,@GPG --yes --import ,(in-srcdir file))))
|
||||
(list "pubdemo.asc" "pubring.asc" key-file1))
|
||||
|
||||
(pipe:do
|
||||
(pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY))
|
||||
(pipe:spawn `(,@GPG --dearmor))
|
||||
(pipe:spawn `(,@GPG --yes --import))))
|
||||
|
||||
(define (preset-passphrases)
|
||||
(info "Preset passphrases")
|
||||
;; one@example.com
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase def
|
||||
"50B2D4FA4122C212611048BC5FC31BD44393626E"))
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase def
|
||||
"7E201E28B6FEB2927B321F443205F4724EBE637E"))
|
||||
;; alpha@example.net
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase abc
|
||||
"76F7E2B35832976B50A27A282D9B87E44577EB66"))
|
||||
(call-check `(,(tool 'gpg-preset-passphrase)
|
||||
--preset --passphrase abc
|
||||
"A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"))
|
||||
(echo "All set up."))
|
||||
|
||||
(cond
|
||||
((member "--create-tarball" *args*)
|
||||
(with-temporary-working-directory
|
||||
(setenv "GNUPGHOME" (getcwd) #t)
|
||||
(create-gpghome)
|
||||
(stop-agent)
|
||||
(call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) "."))))
|
||||
((member "--unpack-tarball" *args*)
|
||||
(call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*)))
|
||||
(start-agent)
|
||||
(preset-passphrases))
|
||||
(else
|
||||
(create-gpghome)
|
||||
(start-agent)
|
||||
(preset-passphrases)))
|
||||
(with-temporary-working-directory
|
||||
(setenv "GNUPGHOME" (getcwd) #t)
|
||||
(create-gpghome)
|
||||
(create-legacy-gpghome)
|
||||
(stop-agent)
|
||||
(call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) ".")))
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
;; This is not a test, but can be used to inspect the test
|
||||
;; environment. Simply execute
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking signing and encryption using DSA"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking signing and encryption"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking signing using DSA with the default hash algorithm"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
(for-each-p
|
||||
"Checking signing with the default hash algorithm"
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(define GNUPGHOME (getenv "GNUPGHOME"))
|
||||
(if (string=? "" GNUPGHOME)
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
;; Redefine GPG without --always-trust and a fixed time.
|
||||
(define GPG `(,(tool 'gpg) --no-permission-warning
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
;; Import the sample key
|
||||
;;
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-legacy-environment)
|
||||
|
||||
;;
|
||||
;; Two simple tests to check that verify fails for bad input data
|
||||
|
@ -18,6 +18,7 @@
|
||||
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(load (with-path "defs.scm"))
|
||||
(setup-environment)
|
||||
|
||||
(info "Printing the GPG version")
|
||||
(assert (string-contains? (call-check `(,@GPG --version))
|
||||
|
Loading…
x
Reference in New Issue
Block a user