diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 0c02c349a..329a31a58 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -1,683 +1,685 @@
 ;; Common definitions for writing tests.
 ;;
 ;; 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/>.
 
 ;; Trace displays and returns the given value.  A debugging aid.
 (define (trace x)
   (display x)
   (newline)
   x)
 
 ;; Stringification.
 (define (stringify expression)
   (let ((p (open-output-string)))
     (write expression p)
     (get-output-string p)))
 
 ;; Reporting.
 (define (echo . msg)
   (for-each (lambda (x) (display x) (display " ")) msg)
   (newline))
 
 (define (info . msg)
   (apply echo msg)
   (flush-stdio))
 
 (define (log . msg)
   (if (> (*verbose*) 0)
       (apply info msg)))
 
 (define (fail . msg)
   (apply info msg)
   (exit 1))
 
 (define (skip . msg)
   (apply info msg)
   (exit 77))
 
 (define (make-counter)
   (let ((c 0))
     (lambda ()
       (let ((r c))
 	(set! c (+ 1 c))
 	r))))
 
 (define *progress-nesting* 0)
 
 (define (call-with-progress msg what)
   (set! *progress-nesting* (+ 1 *progress-nesting*))
   (if (= 1 *progress-nesting*)
       (begin
 	(info msg)
 	(display "    > ")
 	(flush-stdio)
 	(what (lambda (item)
 	      (display item)
 	      (display " ")
 	      (flush-stdio)))
 	(info "< "))
       (begin
 	(what (lambda (item) (display ".") (flush-stdio)))
 	(display " ")
 	(flush-stdio)))
   (set! *progress-nesting* (- *progress-nesting* 1)))
 
 (define (for-each-p msg proc lst . lsts)
   (apply for-each-p' `(,msg ,proc ,(lambda (x . xs) x) ,lst ,@lsts)))
 
 (define (for-each-p' msg proc fmt lst . lsts)
   (call-with-progress
    msg
    (lambda (progress)
      (apply for-each
 	    `(,(lambda args
 		 (progress (apply fmt args))
 		 (apply proc args))
 	      ,lst ,@lsts)))))
 
 ;; Process management.
 (define CLOSED_FD -1)
 (define (call-with-fds what infd outfd errfd)
   (wait-process (stringify what) (spawn-process-fd what infd outfd errfd) #t))
 (define (call what)
   (call-with-fds what
 		 CLOSED_FD
 		 (if (< (*verbose*) 0) STDOUT_FILENO CLOSED_FD)
 		 (if (< (*verbose*) 0) STDERR_FILENO CLOSED_FD)))
 
 ;; Accessor functions for the results of 'spawn-process'.
 (define :stdin car)
 (define :stdout cadr)
 (define :stderr caddr)
 (define :pid cadddr)
 
 (define (call-with-io what in)
   (let ((h (spawn-process what 0)))
     (es-write (:stdin h) in)
     (es-fclose (:stdin h))
     (let* ((out (es-read-all (:stdout h)))
 	   (err (es-read-all (:stderr h)))
 	   (result (wait-process (car what) (:pid h) #t)))
       (es-fclose (:stdout h))
       (es-fclose (:stderr h))
       (if (> (*verbose*) 2)
 	  (begin
 	    (echo (stringify what) "returned:" result)
 	    (echo (stringify what) "wrote to stdout:" out)
 	    (echo (stringify what) "wrote to stderr:" err)))
       (list result out err))))
 
 ;; Accessor function for the results of 'call-with-io'.  ':stdout' and
 ;; ':stderr' can also be used.
 (define :retcode car)
 
 (define (call-check what)
   (let ((result (call-with-io what "")))
     (if (= 0 (:retcode result))
 	(:stdout result)
 	(throw (string-append (stringify what) " failed")
 	       (:stderr result)))))
 
 (define (call-popen command input-string)
   (let ((result (call-with-io command input-string)))
     (if (= 0 (:retcode result))
 	(:stdout result)
 	(throw (:stderr result)))))
 
 ;;
 ;; estream helpers.
 ;;
 
 (define (es-read-all stream)
   (let loop
       ((acc ""))
     (if (es-feof stream)
 	acc
 	(loop (string-append acc (es-read stream 4096))))))
 
 ;;
 ;; File management.
 ;;
 (define (file-exists? name)
   (call-with-input-file name (lambda (port) #t)))
 
 (define (file=? a b)
   (file-equal a b #t))
 
 (define (text-file=? a b)
   (file-equal a b #f))
 
 (define (file-copy from to)
   (catch '() (unlink to))
   (letfd ((source (open from (logior O_RDONLY O_BINARY)))
 	  (sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600)))
     (splice source sink)))
 
 (define (text-file-copy from to)
   (catch '() (unlink to))
   (letfd ((source (open from O_RDONLY))
 	  (sink (open to (logior O_WRONLY O_CREAT) #o600)))
     (splice source sink)))
 
 (define (path-join . components)
   (let loop ((acc #f) (rest (filter (lambda (s)
 				      (not (string=? "" s))) components)))
     (if (null? rest)
 	acc
 	(loop (if (string? acc)
 		  (string-append acc "/" (car rest))
 		  (car rest))
 	      (cdr rest)))))
 (assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
 (assert (string=? (path-join "" "bar" "baz") "bar/baz"))
 
 ;; Is PATH an absolute path?
 (define (absolute-path? path)
   (or (char=? #\/ (string-ref path 0))
       (and *win32* (char=? #\\ (string-ref path 0)))
       (and *win32*
 	   (char-alphabetic? (string-ref path 0))
 	   (char=? #\: (string-ref path 1))
 	   (or (char=? #\/ (string-ref path 2))
 	       (char=? #\\ (string-ref path 2))))))
 
 ;; Make PATH absolute.
 (define (canonical-path path)
   (if (absolute-path? path) path (path-join (getcwd) path)))
 
 (define (in-srcdir . names)
   (canonical-path (apply path-join (cons (getenv "srcdir") names))))
 
 ;; Try to find NAME in PATHS.  Returns the full path name on success,
 ;; or raises an error.
 (define (path-expand name paths)
   (let loop ((path paths))
     (if (null? path)
 	(throw "Could not find" name "in" paths)
 	(let* ((qualified-name (path-join (car path) name))
 	       (file-exists (call-with-input-file qualified-name
 			      (lambda (x) #t))))
 	  (if file-exists
 	      qualified-name
 	      (loop (cdr path)))))))
 
 ;; Expand NAME using the gpgscm load path.  Use like this:
 ;;   (load (with-path "library.scm"))
 (define (with-path name)
   (catch name
 	 (path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*))))
 
 (define (basename path)
   (let ((i (string-index path #\/)))
     (if (equal? i #f)
 	path
 	(basename (substring path (+ 1 i) (string-length path))))))
 
 (define (basename-suffix path suffix)
   (basename
    (if (string-suffix? path suffix)
        (substring path 0 (- (string-length path) (string-length suffix)))
        path)))
 
 ;; Helper for (pipe).
 (define :read-end car)
 (define :write-end cadr)
 
 ;; let-like macro that manages file descriptors.
 ;;
 ;; (letfd <bindings> <body>)
 ;;
 ;; Bind all variables given in <bindings> and initialize each of them
 ;; to the given initial value, and close them after evaluting <body>.
 (define-macro (letfd bindings . body)
   (let bind ((bindings' bindings))
     (if (null? bindings')
 	`(begin ,@body)
 	(let* ((binding (car bindings'))
 	       (name (car binding))
 	       (initializer (cadr binding)))
 	  `(let ((,name ,initializer))
 	     (finally (close ,name)
 		      ,(bind (cdr bindings'))))))))
 
 (define-macro (with-working-directory new-directory . expressions)
   (let ((new-dir (gensym))
 	(old-dir (gensym)))
     `(let* ((,new-dir ,new-directory)
 	    (,old-dir (getcwd)))
        (dynamic-wind
 	   (lambda () (if ,new-dir (chdir ,new-dir)))
 	   (lambda () ,@expressions)
 	   (lambda () (chdir ,old-dir))))))
 
 ;; Make a temporary directory.  If arguments are given, they are
 ;; joined using path-join, and must end in a component ending in
 ;; "XXXXXX".  If no arguments are given, a suitable location and
 ;; generic name is used.  Returns an absolute path.
 (define (mkdtemp . components)
   (canonical-path (_mkdtemp (if (null? components)
-				(string-append "gpgscm-" (get-isotime) "-"
-					       (basename-suffix *scriptname* ".scm")
-					       "-XXXXXX")
+				(path-join
+				 (if *win32* (getenv "Temp") "/tmp")
+				 (string-append "gpgscm-" (get-isotime) "-"
+						(basename-suffix *scriptname* ".scm")
+						"-XXXXXX"))
 				(apply path-join components)))))
 
 (define-macro (with-temporary-working-directory . expressions)
   (let ((tmp-sym (gensym)))
     `(let* ((,tmp-sym (mkdtemp)))
        (finally (unlink-recursively ,tmp-sym)
 		(with-working-directory ,tmp-sym
 					,@expressions)))))
 
 (define (make-temporary-file . args)
   (canonical-path (path-join
 		   (mkdtemp)
 		   (if (null? args) "a" (car args)))))
 
 (define (remove-temporary-file filename)
   (catch '()
     (unlink filename))
   (let ((dirname (substring filename 0 (string-rindex filename #\/))))
     (catch (echo "removing temporary directory" dirname "failed")
       (rmdir dirname))))
 
 ;; let-like macro that manages temporary files.
 ;;
 ;; (lettmp <bindings> <body>)
 ;;
 ;; Bind all variables given in <bindings>, initialize each of them to
 ;; a string representing an unique path in the filesystem, and delete
 ;; them after evaluting <body>.
 (define-macro (lettmp bindings . body)
   (let bind ((bindings' bindings))
     (if (null? bindings')
 	`(begin ,@body)
 	(let ((name (car bindings'))
 	      (rest (cdr bindings')))
 	  `(let ((,name (make-temporary-file ,(symbol->string name))))
 	     (finally (remove-temporary-file ,name)
 		      ,(bind rest)))))))
 
 (define (check-execution source transformer)
   (lettmp (sink)
 	  (transformer source sink)))
 
 (define (check-identity source transformer)
   (lettmp (sink)
 	  (transformer source sink)
 	  (if (not (file=? source sink))
 	      (fail "mismatch"))))
 
 ;;
 ;; Monadic pipe support.
 ;;
 
 (define pipeM
   (package
    (define (new procs source sink producer)
      (package
       (define (dump)
 	(write (list procs source sink producer))
 	(newline))
       (define (add-proc command pid)
 	(new (cons (list command pid) procs) source sink producer))
       (define (commands)
 	(map car procs))
       (define (pids)
 	(map cadr procs))
       (define (set-source source')
 	(new procs source' sink producer))
       (define (set-sink sink')
 	(new procs source sink' producer))
       (define (set-producer producer')
 	(if producer
 	    (throw "producer already set"))
 	(new procs source sink producer'))))))
 
 
 (define (pipe:do . commands)
   (let loop ((M (pipeM::new '() CLOSED_FD CLOSED_FD #f)) (cmds commands))
     (if (null? cmds)
 	(begin
 	  (if M::producer (M::producer))
 	  (if (not (null? M::procs))
 	      (let* ((retcodes (wait-processes (map stringify (M::commands))
 					       (M::pids) #t))
 		     (results (map (lambda (p r) (append p (list r)))
 				   M::procs retcodes))
 		     (failed (filter (lambda (x) (not (= 0 (caddr x))))
 				     results)))
 		(if (not (null? failed))
 		    (throw failed))))) ; xxx nicer reporting
 	(if (and (= 2 (length cmds)) (number? (cadr cmds)))
 	    ;; hack: if it's an fd, use it as sink
 	    (let ((M' ((car cmds) (M::set-sink (cadr cmds)))))
 	      (if (> M::source 2) (close M::source))
 	      (if (> (cadr cmds) 2) (close (cadr cmds)))
 	      (loop M' '()))
 	    (let ((M' ((car cmds) M)))
 	      (if (> M::source 2) (close M::source))
 	      (loop M' (cdr cmds)))))))
 
 (define (pipe:open pathname flags)
   (lambda (M)
     (M::set-source (open pathname flags))))
 
 (define (pipe:defer producer)
   (lambda (M)
     (let* ((p (outbound-pipe))
 	   (M' (M::set-source (:read-end p))))
       (M'::set-producer (lambda ()
 			  (producer (:write-end p))
 			  (close (:write-end p)))))))
 (define (pipe:echo data)
  (pipe:defer (lambda (sink) (display data (fdopen sink "wb")))))
 
 (define (pipe:spawn command)
   (lambda (M)
     (define (do-spawn M new-source)
       (let ((pid (spawn-process-fd command M::source M::sink
 				   (if (> (*verbose*) 0)
 				       STDERR_FILENO CLOSED_FD)))
 	    (M' (M::set-source new-source)))
 	(M'::add-proc command pid)))
     (if (= CLOSED_FD M::sink)
 	(let* ((p (pipe))
 	       (M' (do-spawn (M::set-sink (:write-end p)) (:read-end p))))
 	  (close (:write-end p))
 	  (M'::set-sink CLOSED_FD))
 	(do-spawn M CLOSED_FD))))
 
 (define (pipe:splice sink)
   (lambda (M)
     (splice M::source sink)
     (M::set-source CLOSED_FD)))
 
 (define (pipe:write-to pathname flags mode)
   (open pathname flags mode))
 
 ;;
 ;; Monadic transformer support.
 ;;
 
 (define (tr:do . commands)
   (let loop ((tmpfiles '()) (source  #f) (cmds commands))
     (if (null? cmds)
 	(for-each remove-temporary-file tmpfiles)
 	(let* ((v ((car cmds) tmpfiles source))
 	       (tmpfiles' (car v))
 	       (sink (cadr v))
 	       (error (caddr v)))
 	  (if error
 	      (begin
 		(for-each remove-temporary-file tmpfiles')
 		(apply throw error)))
 	  (loop tmpfiles' sink (cdr cmds))))))
 
 (define (tr:open pathname)
   (lambda (tmpfiles source)
     (list tmpfiles pathname #f)))
 
 (define (tr:spawn input command)
   (lambda (tmpfiles source)
     (if (and (member '**in** command) (not source))
 	(fail (string-append (stringify cmd) " needs an input")))
     (let* ((t (make-temporary-file))
 	   (cmd (map (lambda (x)
 		       (cond
 			((equal? '**in** x) source)
 			((equal? '**out** x) t)
 			(else x))) command)))
       (catch (list (cons t tmpfiles) t *error*)
 	     (call-popen cmd input)
 	     (if (and (member '**out** command) (not (file-exists? t)))
 		 (fail (string-append (stringify cmd)
 				       " did not produce '" t "'.")))
 	     (list (cons t tmpfiles) t #f)))))
 
 (define (tr:write-to pathname)
   (lambda (tmpfiles source)
     (rename source pathname)
     (list tmpfiles pathname #f)))
 
 (define (tr:pipe-do . commands)
   (lambda (tmpfiles source)
     (let ((t (make-temporary-file)))
       (apply pipe:do
         `(,@(if source `(,(pipe:open source (logior O_RDONLY O_BINARY))) '())
 	  ,@commands
 	  ,(pipe:write-to t (logior O_WRONLY O_BINARY O_CREAT) #o600)))
       (list (cons t tmpfiles) t #f))))
 
 (define (tr:assert-identity reference)
   (lambda (tmpfiles source)
     (if (not (file=? source reference))
 	(fail "mismatch"))
     (list tmpfiles source #f)))
 
 (define (tr:assert-weak-identity reference)
   (lambda (tmpfiles source)
     (if (not (text-file=? source reference))
 	(fail "mismatch"))
     (list tmpfiles source #f)))
 
 (define (tr:call-with-content function . args)
   (lambda (tmpfiles source)
     (catch (list tmpfiles source *error*)
 	   (apply function `(,(call-with-input-file source read-all) ,@args)))
     (list tmpfiles source #f)))
 
 ;;
 ;; Developing and debugging tests.
 ;;
 
 ;; Spawn an os shell.
 (define (interactive-shell)
   (call-with-fds `(,(getenv "SHELL") -i) 0 1 2))
 
 ;;
 ;; The main test framework.
 ;;
 
 ;; A pool of tests.
 (define test-pool
   (package
    (define (new procs)
      (package
       (define (add test)
 	(new (cons test procs)))
       (define (wait)
 	(let ((unfinished (filter (lambda (t) (not t::retcode)) procs)))
 	  (if (null? unfinished)
 	      (package)
 	      (let* ((names (map (lambda (t) t::name) unfinished))
 		     (pids (map (lambda (t) t::pid) unfinished))
 		     (results
 		      (map (lambda (pid retcode) (list pid retcode))
 			   pids
 			   (wait-processes (map stringify names) pids #t))))
 		(new
 		 (map (lambda (t)
 			(if t::retcode
 			    t
 			    (t::set-retcode (cadr (assoc t::pid results)))))
 		      procs))))))
       (define (passed)
 	(filter (lambda (p) (= 0 p::retcode)) procs))
       (define (skipped)
 	(filter (lambda (p) (= 77 p::retcode)) procs))
       (define (hard-errored)
 	(filter (lambda (p) (= 99 p::retcode)) procs))
       (define (failed)
 	(filter (lambda (p)
 		  (not (or (= 0 p::retcode) (= 77 p::retcode)
 			   (= 99 p::retcode))))
 		procs))
       (define (report)
 	(define (print-tests tests message)
 	  (unless (null? tests)
 		  (apply echo (cons message
 				    (map (lambda (t) t::name) tests)))))
 
 	(let ((failed' (failed)) (skipped' (skipped)))
 	  (echo (length procs) "tests run,"
 		(length (passed)) "succeeded,"
 		(length failed') "failed,"
 		(length skipped') "skipped.")
 	  (print-tests failed' "Failed tests:")
 	  (print-tests skipped' "Skipped tests:")
 	  (length failed')))))))
 
 (define (verbosity n)
   (if (= 0 n) '() (cons '--verbose (verbosity (- n 1)))))
 
 (define (locate-test path)
   (if (absolute-path? path) path (in-srcdir path)))
 
 ;; A single test.
 (define test
   (package
    (define (scm setup name path . args)
      ;; Start the process.
      (define (spawn-scm args' in out err)
        (spawn-process-fd `(,*argv0* ,@(verbosity (*verbose*))
 				    ,(locate-test path)
 				    ,@(if setup (force setup) '())
 				    ,@args' ,@args) in out err))
      (new name #f spawn-scm #f #f CLOSED_FD))
 
    (define (binary setup name path . args)
      ;; Start the process.
      (define (spawn-binary args' in out err)
        (spawn-process-fd `(,path ,@(if setup (force setup) '()) ,@args' ,@args)
 			 in out err))
      (new name #f spawn-binary #f #f CLOSED_FD))
 
    (define (new name directory spawn pid retcode logfd)
      (package
       (define (set-directory x)
 	(new name x spawn pid retcode logfd))
       (define (set-retcode x)
 	(new name directory spawn pid x logfd))
       (define (set-pid x)
 	(new name directory spawn x retcode logfd))
       (define (set-logfd x)
 	(new name directory spawn pid retcode x))
       (define (open-log-file)
 	(let ((filename (string-append (basename name) ".log")))
 	  (catch '() (unlink filename))
 	  (open filename (logior O_RDWR O_BINARY O_CREAT) #o600)))
       (define (run-sync . args)
 	(letfd ((log (open-log-file)))
 	  (with-working-directory directory
 	    (let* ((p (inbound-pipe))
 		   (pid (spawn args 0 (:write-end p) (:write-end p))))
 	      (close (:write-end p))
 	      (splice (:read-end p) STDERR_FILENO log)
 	      (close (:read-end p))
 	      (let ((t' (set-retcode (wait-process name pid #t))))
 		(t'::report)
 		t')))))
       (define (run-sync-quiet . args)
 	(with-working-directory directory
 	  (set-retcode
 	   (wait-process
 	    name (spawn args CLOSED_FD CLOSED_FD CLOSED_FD) #t))))
       (define (run-async . args)
 	(let ((log (open-log-file)))
 	  (with-working-directory directory
 	    (new name directory spawn
 		 (spawn args CLOSED_FD log log)
 		 retcode log))))
       (define (status)
 	(let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR")))))
 	  (if (not t) "FAIL" (cadr t))))
       (define (report)
 	(unless (= logfd CLOSED_FD)
 		(seek logfd 0 SEEK_SET)
 		(splice logfd STDERR_FILENO)
 		(close logfd))
 	(echo (string-append (status) ":") name))))))
 
 ;; Run the setup target to create an environment, then run all given
 ;; tests in parallel.
 (define (run-tests-parallel tests)
   (let loop ((pool (test-pool::new '())) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
 	  (for-each (lambda (t)
 		      (catch (echo "Removing" t::directory "failed:" *error*)
 			     (unlink-recursively t::directory))
 		      (t::report)) (reverse results::procs))
 	  (exit (results::report)))
 	(let* ((wd (mkdtemp))
 	       (test (car tests'))
 	       (test' (test::set-directory wd)))
 	  (loop (pool::add (test'::run-async))
 		(cdr tests'))))))
 
 ;; Run the setup target to create an environment, then run all given
 ;; tests in sequence.
 (define (run-tests-sequential tests)
   (let loop ((pool (test-pool::new '())) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
 	  (for-each (lambda (t)
 		      (catch (echo "Removing" t::directory "failed:" *error*)
 			     (unlink-recursively t::directory)))
 		    results::procs)
 	  (exit (results::report)))
 	(let* ((wd (mkdtemp))
 	       (test (car tests'))
 	       (test' (test::set-directory wd)))
 	  (loop (pool::add (test'::run-sync))
 		(cdr tests'))))))
 
 ;; Helper to create environment caches from test functions.  SETUP
 ;; must be a test implementing the producer side cache protocol.
 ;; Returns a promise containing the arguments that must be passed to a
 ;; test implementing the consumer side of the cache protocol.
 (define (make-environment-cache setup)
   (delay (let* ((tarball (make-temporary-file "environment-cache")))
 	   (atexit (lambda () (remove-temporary-file tarball)))
 	   (setup::run-sync '--create-tarball tarball)
 	   `(--unpack-tarball ,tarball))))
 
 ;; Command line flag handling.  Returns the elements following KEY in
 ;; ARGUMENTS up to the next argument, or #f if KEY is not in
 ;; ARGUMENTS.
 (define (flag key arguments)
   (cond
    ((null? arguments)
     #f)
    ((string=? key (car arguments))
     (let loop ((acc '())
 	       (args (cdr arguments)))
       (if (or (null? args) (string-prefix? (car args) "--"))
 	  (reverse acc)
 	  (loop (cons (car args) acc) (cdr args)))))
    ((string=? "--" (car arguments))
     #f)
    (else
     (flag key (cdr arguments)))))
 (assert (equal? (flag "--xxx" '("--yyy")) #f))
 (assert (equal? (flag "--xxx" '("--xxx")) '()))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy")) '("yyy")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz")) '("yyy" "zzz")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz" "--")) '("yyy" "zzz")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "--" "zzz")) '("yyy")))
 (assert (equal? (flag "--" '("--" "xxx" "yyy" "--" "zzz")) '("xxx" "yyy")))
diff --git a/tests/migrations/common.scm b/tests/migrations/common.scm
index b1c90aa04..fa8f1295a 100644
--- a/tests/migrations/common.scm
+++ b/tests/migrations/common.scm
@@ -1,60 +1,60 @@
 ;; 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/>.
 
 (if (string=? "" (getenv "srcdir"))
     (error "not called from make"))
 
 (let ((verbose (string->number (getenv "verbose"))))
   (if (number? verbose)
       (*set-verbose!* verbose)))
 
 (define (qualify executable)
   (string-append executable (getenv "EXEEXT")))
 
 ;; We may not use a relative name for gpg-agent.
 (define gpgconf (path-join (getenv "objdir") "tools" (qualify "gpgconf")))
 (define GPG-AGENT (path-join (getenv "objdir") "agent" (qualify "gpg-agent")))
 (define GPG `(,(path-join (getenv "objdir") "g10" (qualify "gpg"))
 	      --no-permission-warning --no-greeting
 	      --no-secmem-warning --batch
 	      ,(string-append "--agent-program=" GPG-AGENT
 			      "|--debug-quick-random")))
 (define GPG-no-batch
   (filter (lambda (arg) (not (equal? arg '--batch))) GPG))
 
 (define GPGTAR (path-join (getenv "objdir") "tools" (qualify "gpgtar")))
 
 (define (untar-armored source-name)
   (pipe:do
    (pipe:open source-name (logior O_RDONLY O_BINARY))
    (pipe:spawn `(,@GPG --dearmor))
    (pipe:spawn `(,GPGTAR --extract --directory=. -))))
 
 (define (run-test message src-tarball test)
   (catch (skip "gpgtar not built")
 	 (call-check `(,GPGTAR --help)))
 
   (with-temporary-working-directory
    (info message)
    (untar-armored src-tarball)
    (setenv "GNUPGHOME" (getcwd) #t)
 
-   (catch (fail "Creating socket directory failed (see README):" (car *error*))
+   (catch (log "Warning: Creating socket directory failed:" (car *error*))
 	  (call-popen `(,gpgconf --create-socketdir) ""))
    (test (getcwd))
    (catch (log "Warning: Removing socket directory failed.")
 	  (call-popen `(,gpgconf --remove-socketdir) ""))))
diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
index 64c086d8c..7c8e10a7e 100644
--- a/tests/openpgp/defs.scm
+++ b/tests/openpgp/defs.scm
@@ -1,462 +1,462 @@
 ;; Common definitions for the OpenPGP test scripts.
 ;;
 ;; Copyright (C) 2016, 2017 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/>.
 
 ;;
 ;; Constants.
 ;;
 
 (define usrname1 "one@example.com")
 (define usrpass1 "def")
 (define usrname2 "two@example.com")
 (define usrpass2 "")
 (define usrname3 "three@example.com")
 (define usrpass3 "")
 
 (define dsa-usrname1 "pgp5")
 ;; we use the sub key because we do not yet have the logic to derive
 ;; the first encryption key from a keyblock (I guess) (Well of course
 ;; we have this by now and the notation below will lookup the primary
 ;; first and then search for the encryption subkey.)
 (define dsa-usrname2 "0xCB879DE9")
 
 (define keys
   (package
    (define (new fpr grip uids subkeys)
      (package))
    (define (subkey fpr grip)
      (package))
    (define alfa (new "A0FF4590BB6122EDEF6E3C542D727CC768697734"
 		     "76F7E2B35832976B50A27A282D9B87E44577EB66"
 		     '("alfa@example.net" "alpha@example.net")
 		     (list
 		      (subkey "3B3FBC948FE59301ED629EFB6AE6D7EE46A871F8"
 			      "A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD"))))
    (define one (new "289B0EF1D105E124B6F626020EF77096D74C5F22"
 		    "50B2D4FA4122C212611048BC5FC31BD44393626E"
 		    '("one@example.com")
 		    (list
 		     (subkey "EB467DCA4AD7676A6A62B2ABABAB28A247BE2775"
 			     "7E201E28B6FEB2927B321F443205F4724EBE637E"))))
    (define two (new "C1DEBB34EA8B71009EAFA474973D50E1C40FDECF"
 		    "343D8AF79796EE107D645A2787A9D9252F924E6F"
 		    '("two@example.com")
 		    (list
 		     (subkey "CD3D0F5701CBFCACB2A4907305A37887B27907AA"
 			     "8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34"))))))
 
 (define key-file1 "samplekeys/rsa-rsa-sample-1.asc")
 (define key-file2 "samplekeys/ed25519-cv25519-sample-1.asc")
 
 (define plain-files '("plain-1" "plain-2" "plain-3" "plain-large"))
 (define data-files '("data-500" "data-9000" "data-32000" "data-80000"))
 (define exp-files '())
 (define all-files (append plain-files data-files))
 
 (let ((verbose (string->number (getenv "verbose"))))
   (if (number? verbose)
       (*set-verbose!* verbose)))
 
 (define (qualify executable)
   (string-append executable (getenv "EXEEXT")))
 
 (define (getenv' key default)
   (let ((value (getenv key)))
     (if (string=? "" value)
 	default
 	value)))
 
 (define (percent-decode s)
   (define (decode c)
     (if (and (> (length c) 2) (char=? #\% (car c)))
 	(integer->char (string->number (string #\# #\x (cadr c) (caddr c))))
 	#f))
   (let loop ((i 0) (c (string->list s)) (r (make-string (string-length s))))
     (if (null? c)
 	(substring r 0 i)
 	(let ((decoded (decode c)))
 	  (string-set! r i (if decoded decoded (car c)))
 	  (loop (+ 1 i) (if decoded (cdddr c) (cdr c)) r)))))
 (assert (equal? (percent-decode "") ""))
 (assert (equal? (percent-decode "%61") "a"))
 (assert (equal? (percent-decode "foob%61r") "foobar"))
 
 (define (percent-encode s)
   (define (encode c)
     `(#\% ,@(string->list (number->string (char->integer c) 16))))
   (let loop ((acc '()) (cs (reverse (string->list s))))
     (if (null? cs)
 	(list->string acc)
 	(case (car cs)
 	  ((#\: #\%)
 	   (loop (append (encode (car cs)) acc) (cdr cs)))
 	  (else
 	   (loop (cons (car cs) acc) (cdr cs)))))))
 (assert (equal? (percent-encode "") ""))
 (assert (equal? (percent-encode "%61") "%2561"))
 (assert (equal? (percent-encode "foob%61r") "foob%2561r"))
 
 (define tools
   '((gpgv "GPGV" "g10/gpgv")
     (gpg-connect-agent "GPG_CONNECT_AGENT" "tools/gpg-connect-agent")
     (gpgconf "GPGCONF" "tools/gpgconf")
     (gpg-preset-passphrase "GPG_PRESET_PASSPHRASE"
 			   "agent/gpg-preset-passphrase")
     (gpgtar "GPGTAR" "tools/gpgtar")
     (gpg-zip "GPGZIP" "tools/gpg-zip")
     (pinentry "PINENTRY" "tests/openpgp/fake-pinentry")))
 
 (define bin-prefix (getenv "BIN_PREFIX"))
 (define installed? (not (string=? "" bin-prefix)))
 
 (define (tool-hardcoded which)
   (let ((t (assoc which tools)))
     (getenv' (cadr t)
 	     (qualify (if installed?
 			  (string-append bin-prefix "/" (basename (caddr t)))
 			  (string-append (getenv "objdir") "/" (caddr t)))))))
 
 ;; You can splice VALGRIND into your argument vector to run programs
 ;; under valgrind.  For example, to run valgrind on gpg, you may want
 ;; to redefine gpg:
 ;;
 ;; (set! gpg `(,@valgrind ,@gpg))
 ;;
 (define valgrind
   '("/usr/bin/valgrind" --leak-check=full --error-exitcode=154))
 
 (unless installed?
 	(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t))
 
 (define (gpg-conf . args)
   (gpg-conf' "" args))
 (define (gpg-conf' input args)
   (let ((s (call-popen `(,(tool-hardcoded 'gpgconf)
 			 ,@(if installed? '()
 			       (list '--build-prefix (getenv "objdir")))
 			 ,@args) input)))
     (map (lambda (line) (map percent-decode (string-split line #\:)))
 	 (string-split-newlines s))))
 (define :gc:c:name car)
 (define :gc:c:description cadr)
 (define :gc:c:pgmname caddr)
 (define (:gc:o:name x)             (list-ref x 0))
 (define (:gc:o:flags x)            (string->number (list-ref x 1)))
 (define (:gc:o:level x)            (string->number (list-ref x 2)))
 (define (:gc:o:description x)      (list-ref x 3))
 (define (:gc:o:type x)             (string->number (list-ref x 4)))
 (define (:gc:o:alternate-type x)   (string->number (list-ref x 5)))
 (define (:gc:o:argument-name x)    (list-ref x 6))
 (define (:gc:o:default-value x)    (list-ref x 7))
 (define (:gc:o:default-argument x) (list-ref x 8))
 (define (:gc:o:value x)            (if (< (length x) 10) "" (list-ref x 9)))
 
 (define (gpg-config component key)
   (package
    (define (value)
      (let* ((conf (assoc key (gpg-conf '--list-options component)))
 	    (type (:gc:o:type conf))
 	    (value (:gc:o:value conf)))
        (case type
 	 ((0 2 3) (string->number value))
 	 ((1 32) (substring value 1 (string-length value))))))
    (define (update value)
      (let ((value' (cond
 		    ((string? value) (string-append "\"" value))
 		    ((number? value) (number->string value))
 		    (else (throw "Unsupported value" value)))))
        (gpg-conf' (string-append key ":0:" (percent-encode value'))
 		  `(--change-options ,component))))
    (define (clear)
      (gpg-conf' (string-append key ":16:")
 		`(--change-options ,component)))))
 
 (define gpg-components (apply gpg-conf '(--list-components)))
 
 (define (tool which)
   (case which
     ((gpg gpg-agent scdaemon gpgsm dirmngr)
      (:gc:c:pgmname (assoc (symbol->string which) gpg-components)))
     (else
      (tool-hardcoded which))))
 
 (define (gpg-has-option? option)
   (string-contains? (call-popen `(,(tool 'gpg) --dump-options) "")
 		    option))
 
 (define have-opt-always-trust
   (catch #f
 	 (call-check `(,(tool 'gpg) --gpgconf-test --always-trust))
 	 #t))
 
 (define GPG `(,(tool 'gpg) --no-permission-warning
 	      ,@(if have-opt-always-trust '(--always-trust) '())))
 (define GPGV `(,(tool 'gpgv)))
 (define PINENTRY (tool 'pinentry))
 
 (define (tr:gpg input args)
   (tr:spawn input `(,@GPG --output **out** ,@args **in**)))
 
 (define (pipe:gpg args)
   (pipe:spawn `(,@GPG --output - ,@args -)))
 
 (define (gpg-with-colons args)
   (let ((s (call-popen `(,@GPG --with-colons ,@args) "")))
     (map (lambda (line) (string-split line #\:))
 	 (string-split-newlines s))))
 
 ;; Convenient accessors for the colon output.
 (define (:type x)   (string->symbol (list-ref x 0)))
 (define (:length x) (string->number (list-ref x 2)))
 (define (:alg x) (string->number (list-ref x 3)))
 (define (:expire x) (list-ref x 6))
 (define (:fpr x) (list-ref x 9))
 (define (:cap x) (list-ref x 11))
 
 (define (have-public-key? key)
   (catch #f
 	 (pair? (filter (lambda (l) (and (equal? 'fpr (:type l))
 					 (equal? key::fpr (:fpr l))))
 			(gpg-with-colons `(--list-keys ,key::fpr))))))
 
 (define (have-secret-key? key)
   (catch #f
 	 (pair? (filter (lambda (l) (and (equal? 'fpr (:type l))
 					 (equal? key::fpr (:fpr l))))
 			(gpg-with-colons `(--list-secret-keys ,key::fpr))))))
 
 (define (have-secret-key-file? key)
   (file-exists? (path-join (getenv "GNUPGHOME") "private-keys-v1.d"
 			   (string-append key::grip ".key"))))
 
 (define (get-config what)
   (string-split (caddar (gpg-with-colons `(--list-config ,what))) #\;))
 
 (define all-pubkey-algos (delay (get-config "pubkeyname")))
 (define all-hash-algos (delay (get-config "digestname")))
 (define all-cipher-algos (delay (get-config "ciphername")))
 (define all-compression-algos (delay (get-config "compressname")))
 
 (define (have-pubkey-algo? x)
   (not (not (member x (force all-pubkey-algos)))))
 (define (have-hash-algo? x)
   (not (not (member x (force all-hash-algos)))))
 (define (have-cipher-algo? x)
   (not (not (member x (force all-cipher-algos)))))
 
 (define (gpg-pipe args0 args1 errfd)
   (lambda (source sink)
     (let* ((p (pipe))
 	   (task0 (spawn-process-fd `(,@GPG ,@args0)
 		   source (:write-end p) errfd))
 	   (_ (close (:write-end p)))
 	   (task1 (spawn-process-fd `(,@GPG ,@args1)
 		   (:read-end p) sink errfd)))
       (close (:read-end p))
       (wait-processes (list GPG GPG) (list task0 task1) #t))))
 
 (setenv "GPG_AGENT_INFO" "" #t)
 (setenv "GNUPGHOME" (getcwd) #t)
 (define GNUPGHOME (getcwd))
 
 ;;
 ;; GnuPG helper.
 ;;
 
 ;; Evaluate a sequence of expressions with the given home directory.
 (define-macro (with-home-directory gnupghome . expressions)
   (let ((original-home-directory (gensym)))
     `(let ((,original-home-directory (getenv "GNUPGHOME")))
        (dynamic-wind
 	   (lambda () (setenv "GNUPGHOME" ,gnupghome #t))
 	   (lambda () ,@expressions)
 	   (lambda () (setenv "GNUPGHOME" ,original-home-directory #t))))))
 
 ;; Evaluate a sequence of expressions with an ephemeral home
 ;; directory.
 (define-macro (with-ephemeral-home-directory . expressions)
   (let ((original-home-directory (gensym))
 	(ephemeral-home-directory (gensym)))
     `(let ((,original-home-directory (getenv "GNUPGHOME"))
 	   (,ephemeral-home-directory (mkdtemp)))
        (finally (unlink-recursively ,ephemeral-home-directory)
 	 (dynamic-wind
 	     (lambda () (setenv "GNUPGHOME" ,ephemeral-home-directory #t))
 	     (lambda () ,@expressions)
 	     (lambda () (setenv "GNUPGHOME" ,original-home-directory #t)))))))
 
 ;; Call GPG to obtain the hash sums.  Either specify an input file in
 ;; ARGS, or an string in INPUT.  Returns a list of (<algo>
 ;; "<hashsum>") lists.
 (define (gpg-hash-string args input)
   (map
    (lambda (line)
      (let ((p (string-split line #\:)))
        (list (string->number (cadr p)) (caddr p))))
    (string-split-newlines
     (call-popen `(,@GPG --with-colons ,@args) input))))
 
 ;; Dearmor a file.
 (define (dearmor source-name sink-name)
   (pipe:do
    (pipe:open source-name (logior O_RDONLY O_BINARY))
    (pipe:spawn `(,@GPG --dearmor))
    (pipe:write-to sink-name (logior O_WRONLY O_CREAT O_BINARY) #o600)))
 
 ;;
 ;; 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-sample-files)
   (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 ".." "openpgp" (string-append name "o.asc")) name))
    plain-files))
 
 (define (create-legacy-gpghome)
   (create-sample-files)
 
   (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)
   (create-gpghome)
   (if (member "--unpack-tarball" *args*)
       (begin
 	(call-check `(,(tool 'gpgtar) --extract --directory=. ,(cadr *args*)))
 	(start-agent))
       (begin
 	(start-agent)
 	(create-legacy-gpghome)))
   (preset-passphrases))
 
 ;; Create the socket dir and start the agent.
 (define (start-agent)
   (log "Starting gpg-agent...")
   (let ((gnupghome (getenv "GNUPGHOME")))
     (atexit (lambda ()
 	      (with-home-directory gnupghome
 				   (stop-agent)))))
-  (catch (fail "Creating socket directory failed (see README):" (car *error*))
+  (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)
 				"|--debug-quick-random")
 		/bye)))
 
 ;; Stop the agent and remove the socket dir.
 (define (stop-agent)
   (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)))