From 46c4333c372f0e1ad2aadc411490c2a330b4c5a6 Mon Sep 17 00:00:00 2001 From: Justus Winter Date: Mon, 5 Sep 2016 17:17:24 +0200 Subject: [PATCH] tests: Speed up the test suite. * tests/openpgp/run-tests.scm (test::run-sync): Pass additional arguments to the test. (test::run-sync-quiet): Likewise. (test::run-async): Likewise. (run-tests-{parallel,sequential}-isolated): Create a tarball of the gnupghome, then extract it for each test. * tests/openpgp/setup.scm: Refactor into functions, add an interface to tar-up the created environment, and untar it multiple times. Signed-off-by: Justus Winter --- tests/openpgp/run-tests.scm | 80 ++++++++------- tests/openpgp/setup.scm | 196 +++++++++++++++++++----------------- 2 files changed, 150 insertions(+), 126 deletions(-) diff --git a/tests/openpgp/run-tests.scm b/tests/openpgp/run-tests.scm index e3b6b6a47..3334f61e6 100644 --- a/tests/openpgp/run-tests.scm +++ b/tests/openpgp/run-tests.scm @@ -82,10 +82,10 @@ (new name directory command pid x)) (define (set-pid x) (new name directory command x retcode)) - (define (run-sync) + (define (run-sync . args) (with-working-directory directory (let* ((p (inbound-pipe)) - (pid (spawn-process-fd command CLOSED_FD + (pid (spawn-process-fd (append command args) CLOSED_FD (:write-end p) (:write-end p)))) (close (:write-end p)) (splice (:read-end p) STDERR_FILENO) @@ -93,14 +93,16 @@ (let ((t' (set-retcode (wait-process name pid #t)))) (t'::report) t')))) - (define (run-sync-quiet) + (define (run-sync-quiet . args) (with-working-directory directory (set-retcode (wait-process - name (spawn-process-fd command CLOSED_FD CLOSED_FD CLOSED_FD) #t)))) - (define (run-async) + name (spawn-process-fd (append command args) + CLOSED_FD CLOSED_FD CLOSED_FD) #t)))) + (define (run-async . args) (with-working-directory directory - (set-pid (spawn-process-fd command CLOSED_FD CLOSED_FD CLOSED_FD)))) + (set-pid (spawn-process-fd (append command args) + CLOSED_FD CLOSED_FD CLOSED_FD)))) (define (status) (let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR"))))) (if (not t) "FAIL" (cadr t)))) @@ -119,21 +121,24 @@ (loop (pool::add (test::run-async)) (cdr tests')))))) (define (run-tests-parallel-isolated setup teardown . tests) - (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) - (loop (pool::add (test'::run-async)) (cdr 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'))))))) (define (run-tests-sequential-shared setup teardown . tests) (let loop ((pool (test-pool::new '())) @@ -145,21 +150,24 @@ (loop (pool::add (test::run-sync)) (cdr tests')))))) (define (run-tests-sequential-isolated setup teardown . tests) - (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) - (loop (pool::add (test'::run-sync)) (cdr 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'))))))) (define all-tests '("version.scm" diff --git a/tests/openpgp/setup.scm b/tests/openpgp/setup.scm index 8fc154346..d4a3e3701 100755 --- a/tests/openpgp/setup.scm +++ b/tests/openpgp/setup.scm @@ -19,103 +19,119 @@ (load (with-path "defs.scm")) -(echo "Creating test environment...") +(define (create-gpghome) + (echo "Creating test environment...") -(letfd ((fd (open "random_seed" (logior O_WRONLY O_CREAT O_BINARY) #o600))) - (call-with-fds (list (tool 'mktdata) "600") CLOSED_FD fd STDERR_FILENO)) + (letfd ((fd (open "random_seed" (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (call-with-fds (list (tool 'mktdata) "600") CLOSED_FD fd STDERR_FILENO)) -(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 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")) -(echo "Starting gpg-agent...") -(call-check `(,(tool 'gpg-connect-agent) --verbose - ,(string-append "--agent-program=" (tool 'gpg-agent) - "|--debug-quick-random") - /bye)) + (for-each-p "Creating sample data files" + (lambda (size) + (letfd ((fd (open (string-append "data-" (number->string size)) + (logior O_WRONLY O_CREAT O_BINARY) #o600))) + (call-with-fds (list (tool 'mktdata) (number->string size)) + CLOSED_FD fd STDERR_FILENO))) + '(500 9000 32000 80000)) -(for-each-p "Creating sample data files" - (lambda (size) - (letfd ((fd (open (string-append "data-" (number->string size)) - (logior O_WRONLY O_CREAT O_BINARY) #o600))) - (call-with-fds (list (tool 'mktdata) (number->string size)) - CLOSED_FD fd STDERR_FILENO))) - '(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")) -(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")) -;; 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")) -(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")) + (info "Importing public demo and test keys") + (call-check `(,@GPG --yes --import + ,(in-srcdir "pubdemo.asc") + ,(in-srcdir "pubring.asc") + ,(in-srcdir 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)))) -(info "Importing public demo and test keys") -(call-check `(,@GPG --yes --import - ,(in-srcdir "pubdemo.asc") - ,(in-srcdir "pubring.asc") - ,(in-srcdir key-file1))) -;; (letfd ((source (open (in-srcdir "pubring.pkr.asc") O_RDONLY))) -;; ((gpg-pipe '(--dearmor) '(--yes --import) STDERR_FILENO) -;; source CLOSED_FD)) -(pipe:do - (pipe:open (in-srcdir "pubring.pkr.asc") (logior O_RDONLY O_BINARY)) - (pipe:spawn `(,@GPG --dearmor)) - (pipe:spawn `(,@GPG --yes --import))) +(define (start-agent) + (echo "Starting gpg-agent...") + (call-check `(,(tool 'gpg-connect-agent) --verbose + ,(string-append "--agent-program=" (tool 'gpg-agent) + "|--debug-quick-random") + /bye)) -(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")) + (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.")) -(echo "All set up.") +(define (kill-agent) + (call-check `(,(tool 'gpg-connect-agent) --verbose killagent /bye))) + +(cond + ((member "--create-tarball" *args*) + (with-temporary-working-directory + (setenv "GNUPGHOME" (getcwd) #t) + (create-gpghome) + (kill-agent) + (call-check `(,(tool 'gpgtar) --create --output ,(cadr *args*) + ,@(glob "*"))))) + ((member "--unpack-tarball" *args*) + (call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*))) + (start-agent)) + (else + (create-gpghome) + (start-agent)))