diff --git a/tests/gpgscm/lib.scm b/tests/gpgscm/lib.scm
index e4ab48303..316eacf87 100644
--- a/tests/gpgscm/lib.scm
+++ b/tests/gpgscm/lib.scm
@@ -1,169 +1,187 @@
 ;; Additional library functions for TinySCHEME.
 ;;
 ;; 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/>.
 
 (macro (assert form)
   `(if (not ,(cadr form))
        (begin
 	 (display "Assertion failed: ")
 	 (write (quote ,(cadr form)))
 	 (newline)
 	 (exit 1))))
 (assert #t)
 
 (define (filter pred lst)
   (cond ((null? lst) '())
         ((pred (car lst))
          (cons (car lst) (filter pred (cdr lst))))
         (else (filter pred (cdr lst)))))
 
 (define (any p l)
   (cond ((null? l) #f)
         ((p (car l)) #t)
         (else (any p (cdr l)))))
 
 (define (all p l)
   (cond ((null? l) #t)
         ((not (p (car l))) #f)
         (else (all p (cdr l)))))
 
+;; Return the first element of a list.
+(define first car)
+
+;; Return the last element of a list.
+(define (last lst)
+  (if (null? (cdr lst))
+      (car lst)
+      (last (cdr lst))))
+
+;; Compute the powerset of a list.
+(define (powerset set)
+  (if (null? set)
+      '(())
+      (let ((rst (powerset (cdr set))))
+        (append (map (lambda (x) (cons (car set) x))
+                     rst)
+                rst))))
+
 ;; Is PREFIX a prefix of S?
 (define (string-prefix? s prefix)
   (and (>= (string-length s) (string-length prefix))
        (string=? prefix (substring s 0 (string-length prefix)))))
 (assert (string-prefix? "Scheme" "Sch"))
 
 ;; Is SUFFIX a suffix of S?
 (define (string-suffix? s suffix)
   (and (>= (string-length s) (string-length suffix))
        (string=? suffix (substring s (- (string-length s)
 					(string-length suffix))
 				   (string-length s)))))
 (assert (string-suffix? "Scheme" "eme"))
 
 ;; Locate the first occurrence of needle in haystack starting at offset.
 (ffi-define (string-index haystack needle [offset]))
 (assert (= 2 (string-index "Hallo" #\l)))
 (assert (= 3 (string-index "Hallo" #\l 3)))
 (assert (equal? #f (string-index "Hallo" #\.)))
 
 ;; Locate the last occurrence of needle in haystack starting at offset.
 (ffi-define (string-rindex haystack needle [offset]))
 (assert (= 3 (string-rindex "Hallo" #\l)))
 (assert (equal? #f (string-rindex "Hallo" #\a 2)))
 (assert (equal? #f (string-rindex "Hallo" #\.)))
 
 ;; Split haystack at delimiter at most n times.
 (define (string-splitn haystack delimiter n)
   (let ((length (string-length haystack)))
     (define (split acc delimiter offset n)
       (if (>= offset length)
 	  (reverse acc)
 	  (let ((i (string-index haystack delimiter offset)))
 	    (if (or (eq? i #f) (= 0 n))
 		(reverse (cons (substring haystack offset length) acc))
 		(split (cons (substring haystack offset i) acc)
 		       delimiter (+ i 1) (- n 1))))))
     (split '() delimiter 0 n)))
 (assert (= 2 (length (string-splitn "foo:bar:baz" #\: 1))))
 (assert (string=? "foo" (car (string-splitn "foo:bar:baz" #\: 1))))
 (assert (string=? "bar:baz" (cadr (string-splitn "foo:bar:baz" #\: 1))))
 
 ;; Split haystack at delimiter.
 (define (string-split haystack delimiter)
   (string-splitn haystack delimiter -1))
 (assert (= 3 (length (string-split "foo:bar:baz" #\:))))
 (assert (string=? "foo" (car (string-split "foo:bar:baz" #\:))))
 (assert (string=? "bar" (cadr (string-split "foo:bar:baz" #\:))))
 (assert (string=? "baz" (caddr (string-split "foo:bar:baz" #\:))))
 
 ;; Split haystack at newlines.
 (define (string-split-newlines haystack)
   (if *win32*
       (map (lambda (line) (if (string-suffix? line "\r")
 			      (substring line 0 (- (string-length line) 1))
 			      line))
 	   (string-split haystack #\newline))
       (string-split haystack #\newline)))
 
 ;; Trim the prefix of S containing only characters that make PREDICATE
 ;; true.
 (define (string-ltrim predicate s)
   (let loop ((s' (string->list s)))
     (if (predicate (car s'))
 	(loop (cdr s'))
 	(list->string s'))))
 (assert (string=? "foo" (string-ltrim char-whitespace? "  foo")))
 
 ;; Trim the suffix of S containing only characters that make PREDICATE
 ;; true.
 (define (string-rtrim predicate s)
   (let loop ((s' (reverse (string->list s))))
     (if (predicate (car s'))
 	(loop (cdr s'))
 	(list->string (reverse s')))))
 (assert (string=? "foo" (string-rtrim char-whitespace? "foo 	")))
 
 ;; Trim both the prefix and suffix of S containing only characters
 ;; that make PREDICATE true.
 (define (string-trim predicate s)
   (string-ltrim predicate (string-rtrim predicate s)))
 (assert (string=? "foo" (string-trim char-whitespace? " 	foo 	")))
 
 ;; Check if needle is contained in haystack.
 (ffi-define (string-contains? haystack needle))
 (assert (string-contains? "Hallo" "llo"))
 (assert (not (string-contains? "Hallo" "olla")))
 
 ;; Read a word from port P.
 (define (read-word . p)
   (list->string
    (let f ()
      (let ((c (apply peek-char p)))
        (cond
 	((eof-object? c) '())
 	((char-alphabetic? c)
 	 (apply read-char p)
 	 (cons c (f)))
 	(else
 	 (apply read-char p)
 	 '()))))))
 
 ;; Read a line from port P.
 (define (read-line . p)
   (list->string
    (let f ()
      (let ((c (apply peek-char p)))
        (cond
 	((eof-object? c) '())
 	((char=? c #\newline)
 	 (apply read-char p)
 	 '())
 	(else
 	 (apply read-char p)
 	 (cons c (f))))))))
 
 ;; Read everything from port P.
 (define (read-all . p)
   (let loop ((acc (open-output-string)))
     (let ((c (apply peek-char p)))
       (cond
        ((eof-object? c) (get-output-string acc))
        (else
 	(write-char (apply read-char p) acc)
 	(loop acc))))))
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 8986a705a..d89a96f88 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -1,483 +1,491 @@
 ;; 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 (error . 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)
   (for-each-p' msg proc (lambda (x) x) lst))
 
 (define (for-each-p' msg proc fmt lst)
   (call-with-progress
    msg
    (lambda (progress)
      (for-each (lambda (a)
 		 (progress (fmt a))
 		 (proc a))
 	       lst))))
 
 ;; 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 (list 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"))
 
 (define (canonical-path path)
   (if (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)))))
       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>.
 (macro (letfd form)
   (let ((result-sym (gensym)))
     `((lambda (,(caaadr form))
 	(let ((,result-sym
 	       ,(if (= 1 (length (cadr form)))
 		    `(catch (begin (close ,(caaadr form))
 				   (apply throw *error*))
 			    ,@(cddr form))
 		    `(letfd ,(cdadr form) ,@(cddr form)))))
 	  (close ,(caaadr form))
 	  ,result-sym)) ,@(cdaadr form))))
 
 (macro (with-working-directory form)
   (let ((result-sym (gensym)) (cwd-sym (gensym)))
     `(let* ((,cwd-sym (getcwd))
 	    (_ (if ,(cadr form) (chdir ,(cadr form))))
 	    (,result-sym (catch (begin (chdir ,cwd-sym)
 				       (apply throw *error*))
 				,@(cddr form))))
        (chdir ,cwd-sym)
        ,result-sym)))
 
 ;; 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.
 (define (mkdtemp . components)
   (_mkdtemp (if (null? components)
 		(path-join (getenv "TMP")
 			   (string-append "gpgscm-" (get-isotime) "-"
 					  (basename-suffix *scriptname* ".scm")
 					  "-XXXXXX"))
 		(apply path-join components))))
 
 (macro (with-temporary-working-directory form)
   (let ((result-sym (gensym)) (cwd-sym (gensym)) (tmp-sym (gensym)))
     `(let* ((,cwd-sym (getcwd))
 	    (,tmp-sym (mkdtemp))
 	    (_ (chdir ,tmp-sym))
 	    (,result-sym (catch (begin (chdir ,cwd-sym)
 				       (unlink-recursively ,tmp-sym)
 				       (apply throw *error*))
 				,@(cdr form))))
        (chdir ,cwd-sym)
        (unlink-recursively ,tmp-sym)
        ,result-sym)))
 
 (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>.
 (macro (lettmp form)
   (let ((result-sym (gensym)))
     `((lambda (,(caadr form))
 	(let ((,result-sym
 	       ,(if (= 1 (length (cadr form)))
 		    `(catch (begin (remove-temporary-file ,(caadr form))
 				   (apply throw *error*))
 			    ,@(cddr form))
 		    `(lettmp ,(cdadr form) ,@(cddr form)))))
 	  (remove-temporary-file ,(caadr form))
 	  ,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))
 
 (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))
 	      (error "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))
 	(error (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)))
 		 (error (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))
 	(error "mismatch"))
     (list tmpfiles source #f)))
 
 (define (tr:assert-weak-identity reference)
   (lambda (tmpfiles source)
     (if (not (text-file=? source reference))
 	(error "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")) 0 1 2))
diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am
index bb9b2f4db..5725e110c 100644
--- a/tests/openpgp/Makefile.am
+++ b/tests/openpgp/Makefile.am
@@ -1,207 +1,207 @@
 # Makefile.am - For tests/openpgp
 # Copyright (C) 1998, 1999, 2000, 2001, 2003,
 #               2010 Free Software Foundation, Inc.
 #
 # 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/>.
 # Process this file with automake to create Makefile.in
 
 
 # Programs required before we can run these tests.
 required_pgms = ../../g10/gpg$(EXEEXT) ../../agent/gpg-agent$(EXEEXT) \
                 ../../tools/gpg-connect-agent$(EXEEXT) \
 		../../tools/mk-tdata$(EXEEXT) \
 		../gpgscm/gpgscm$(EXEEXT)
 
 AM_CPPFLAGS = -I$(top_srcdir)/common
 include $(top_srcdir)/am/cmacros.am
 
 AM_CFLAGS =
 
 noinst_PROGRAMS = fake-pinentry
 
 fake_pinentry_SOURCES = fake-pinentry.c
 
 TMP ?= /tmp
 
 TESTS_ENVIRONMENT = LC_ALL=C \
 	EXEEXT=$(EXEEXT) \
 	PATH=../gpgscm:$(PATH) \
 	TMP=$(TMP) \
 	srcdir=$(abs_srcdir) \
 	objdir=$(abs_top_builddir) \
 	GPGSCM_PATH=$(abs_top_srcdir)/tests/gpgscm:$(abs_top_srcdir)/tests/openpgp
 
 XTESTS = \
 	version.scm \
 	mds.scm \
 	decrypt.scm \
 	decrypt-dsa.scm \
 	sigs.scm \
 	sigs-dsa.scm \
 	encrypt.scm \
 	encrypt-dsa.scm \
 	seat.scm \
 	clearsig.scm \
 	encryptp.scm \
 	detach.scm \
 	detachm.scm \
 	armsigs.scm \
 	armencrypt.scm \
 	armencryptp.scm \
 	signencrypt.scm \
 	signencrypt-dsa.scm \
 	armsignencrypt.scm \
 	armdetach.scm \
 	armdetachm.scm \
 	genkey1024.scm \
 	conventional.scm \
 	conventional-mdc.scm \
 	multisig.scm \
 	verify.scm \
 	gpgv-forged-keyring.scm \
 	armor.scm \
 	import.scm \
 	ecc.scm \
 	4gb-packet.scm \
 	tofu.scm \
 	gpgtar.scm \
 	use-exact-key.scm \
 	default-key.scm \
 	export.scm \
 	ssh.scm \
 	quick-key-manipulation.scm \
 	issue2015.scm \
 	issue2346.scm \
 	issue2417.scm \
 	issue2419.scm
 
 # XXX: Currently, one cannot override automake's 'check' target.  As a
 # workaround, we avoid defining 'TESTS', thus automake will not emit
 # the 'check' target.  For extra robustness, we merely define a
 # dependency on 'xcheck', so this hack should also work even if
 # automake would emit the 'check' target, as adding dependencies to
 # targets is okay.
 check: xcheck
 
 .PHONY: xcheck
 xcheck:
 	$(TESTS_ENVIRONMENT) $(abs_top_builddir)/tests/gpgscm/gpgscm \
 	  run-tests.scm $(TESTFLAGS) $(XTESTS)
 
 TEST_FILES = pubring.asc secring.asc plain-1o.asc plain-2o.asc plain-3o.asc \
 	     plain-1.asc plain-2.asc plain-3.asc plain-1-pgp.asc \
 	     plain-largeo.asc \
 	     pubring.pkr.asc secring.skr.asc secdemo.asc pubdemo.asc \
              gpg.conf.tmpl gpg-agent.conf.tmpl \
 	     bug537-test.data.asc bug894-test.asc \
 	     bug1223-good.asc bug1223-bogus.asc 4gb-packet.asc \
 	     tofu-keys.asc tofu-keys-secret.asc \
 	     tofu-2183839A-1.txt tofu-BC15C85A-1.txt tofu-EE37CF96-1.txt \
 	     tofu/cross-sigs/EC38277E-secret.gpg \
 	     tofu/cross-sigs/EC38277E-1.gpg \
 	     tofu/cross-sigs/EC38277E-1.txt \
 	     tofu/cross-sigs/EC38277E-2.gpg \
 	     tofu/cross-sigs/EC38277E-2.txt \
 	     tofu/cross-sigs/EC38277E-3.txt \
 	     tofu/cross-sigs/871C2247-secret.gpg \
 	     tofu/cross-sigs/871C2247-1.gpg \
 	     tofu/cross-sigs/871C2247-1.txt \
 	     tofu/cross-sigs/871C2247-2.gpg \
 	     tofu/cross-sigs/871C2247-2.txt \
 	     tofu/cross-sigs/871C2247-3.gpg \
 	     tofu/cross-sigs/871C2247-3.txt \
 	     tofu/cross-sigs/871C2247-4.gpg \
 	     tofu/cross-sigs/README
 
 data_files = data-500 data-9000 data-32000 data-80000 plain-large
 
 priv_keys = privkeys/50B2D4FA4122C212611048BC5FC31BD44393626E.asc \
             privkeys/7E201E28B6FEB2927B321F443205F4724EBE637E.asc \
             privkeys/13FDB8809B17C5547779F9D205C45F47CE0217CE.asc \
             privkeys/343D8AF79796EE107D645A2787A9D9252F924E6F.asc \
             privkeys/8B5ABF3EF9EB8D96B91A0B8C2C4401C91C834C34.asc \
             privkeys/0D6F6AD4C4C803B25470F9104E9F4E6A4CA64255.asc \
             privkeys/FD692BD59D6640A84C8422573D469F84F3B98E53.asc \
             privkeys/76F7E2B35832976B50A27A282D9B87E44577EB66.asc \
             privkeys/A0747D5F9425E6664F4FFBEED20FBCA79FDED2BD.asc \
 	    privkeys/0DD40284FF992CD24DC4AAC367037E066FCEE26A.asc \
 	    privkeys/2BC997C0B8691D41D29A4EC81CCBCF08454E4961.asc \
 	    privkeys/3C9D5ECA70130C2DBB1FC6AC0076BEEEC197716F.asc \
 	    privkeys/449E644892C951A37525654730DD32C202079926.asc \
 	    privkeys/58FFE844087634E62440224908BDE44BEA7EB730.asc \
 	    privkeys/4DF9172D6FF428C97A0E9AA96F03E8BCE3B2F188.asc \
 	    privkeys/9D7CD8F53F2F14C3E2177D1E9D1D11F39513A4A4.asc \
 	    privkeys/6E6B7ED0BD4425018FFC54F3921D5467A3AE00EB.asc \
 	    privkeys/C905D0AB6AE9655C5A35975939997BBF3325D6DD.asc \
 	    privkeys/B2BAA7144303DF19BB6FDE23781DD3FDD97918D4.asc \
 	    privkeys/CF60965BF51F67CF80DECE853E0D2D343468571D.asc \
 	    privkeys/DF00E361D34F80868D06879AC21D7A7D4E4FAD76.asc \
 	    privkeys/00FE67F28A52A8AA08FFAED20AF832DA916D1985.asc \
 	    privkeys/1DF48228FEFF3EC2481B106E0ACA8C465C662CC5.asc \
 	    privkeys/A2832820DC9F40751BDCD375BB0945BA33EC6B4C.asc \
 	    privkeys/ADE710D74409777B7729A7653373D820F67892E0.asc \
 	    privkeys/CEFC51AF91F68A2904FBFF62C4F075A4785B803F.asc \
             privkeys/1E28F20E41B54C2D1234D896096495FF57E08D18.asc \
             privkeys/EB33B687EB8581AB64D04852A54453E85F3DF62D.asc \
 	    privkeys/C6A6390E9388CDBAD71EAEA698233FE5E04F001E.asc \
 	    privkeys/D69102E0F5AC6B6DB8E4D16DA8E18CF46D88CAE3.asc
 
 sample_keys = samplekeys/README \
               samplekeys/ecc-sample-1-pub.asc \
               samplekeys/ecc-sample-2-pub.asc \
               samplekeys/ecc-sample-3-pub.asc \
               samplekeys/ecc-sample-1-sec.asc \
               samplekeys/ecc-sample-2-sec.asc \
               samplekeys/ecc-sample-3-sec.asc \
 	      samplekeys/eddsa-sample-1-pub.asc \
 	      samplekeys/eddsa-sample-1-sec.asc \
 	      samplekeys/dda252ebb8ebe1af-1.asc \
 	      samplekeys/dda252ebb8ebe1af-2.asc \
 	      samplekeys/whats-new-in-2.1.asc \
 	      samplekeys/e2e-p256-1-clr.asc \
 	      samplekeys/e2e-p256-1-prt.asc \
 	      samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc \
               samplekeys/rsa-rsa-sample-1.asc \
               samplekeys/ed25519-cv25519-sample-1.asc \
 	      samplekeys/silent-running.asc \
 	      samplekeys/ssh-dsa.key \
 	      samplekeys/ssh-ecdsa.key \
 	      samplekeys/ssh-ed25519.key \
 	      samplekeys/ssh-rsa.key \
 	      samplekeys/issue2346.gpg
 
 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
+	     setup.scm finish.scm shell.scm
 
 CLEANFILES = prepared.stamp x y yy z out err  $(data_files) \
 	     plain-1 plain-2 plain-3 trustdb.gpg *.lock .\#lk* \
 	     *.test.log gpg_dearmor gpg.conf gpg-agent.conf S.gpg-agent \
 	     pubring.gpg pubring.gpg~ pubring.kbx pubring.kbx~ \
 	     secring.gpg pubring.pkr secring.skr \
 	     gnupg-test.stop random_seed gpg-agent.log tofu.db \
 	     passphrases sshcontrol S.gpg-agent.ssh
 
 clean-local:
 	-rm -rf private-keys-v1.d openpgp-revocs.d tofu.d gpgtar.d
 
 
 # We need to depend on a couple of programs so that the tests don't
 # start before all programs are built.
 all-local: $(required_pgms)
diff --git a/tests/openpgp/README b/tests/openpgp/README
index 8845afd34..75d818e9e 100644
--- a/tests/openpgp/README
+++ b/tests/openpgp/README
@@ -1,219 +1,222 @@
 #                                   Emacs, this is an -*- org -*- file.
 
 * How to run the test suite
 From your build directory, run
 
   obj $ make -C tests/openpgp check
 
 to run all tests or
 
   obj $ make -C tests/openpgp check XTESTS=your-test.scm
 
 to run a specific test (or any number of tests separated by spaces).
 
 If you want to debug a test, add verbose=1 to see messages printed by
 spawned programs to their standard error stream, verbose=2 to see what
 programs are executed, or verbose=3 to see even more program output
 and exit codes.
 
 ** Passing options to the test driver
 
 You can set TESTFLAGS to pass flags to 'run-tests.scm'.  For example,
 to speed up the test suite when bisecting, do
 
   obj $ make -C tests/openpgp check TESTFLAGS=--parallel
 
 See below for the arguments supported by the driver.
 
 ** Calling the test driver directly
 This is a bit tricky because one needs to manually set some
 environment variables.  We should make that easier.  See discussion
 below.  From your build directory, do:
 
   obj $ TMP=/tmp srcdir=<path to>/tests/openpgp \
         GPGSCM_PATH=<path to>/tests/gpgscm:<path to>/tests/openpgp \
         $(pwd)/tests/gpgscm/gpgscm [gpgscm args] \
         run-tests.scm [test suite runner args]
 
 *** Arguments supported by the test suite runner
 The test suite runner supports four modes of operation,
 {sequential,parallel}x{isolated,shared}.  You can select the mode of
 operation using a combination of the flags --parallel, --sequential,
 --shared, and --isolated.
 
 By default the tests are run in sequential order, each one in a clean
 environment.
 
 You can specify the tests to run as positional arguments relative to
 srcdir (e.g. just 'version.scm').  By default all tests listed in
 run-tests.scm are executed.  Note that you do not have to specify
 setup.scm and finish.scm, they are executed implicitly.
 
 The test suite runner can be executed in any location that the current
 user can write to.  It will create temporary files and directories,
 but will in general clean up all of them.
 *** Discussion of the various environment variables
 **** srcdir
 Must be set to the source of the openpgp test suite.  Used to locate
 data files.
 **** GPGSCM_PATH
 Used to locate the Scheme library as well as code used by the test
 suite.
 **** BIN_PREFIX
 The test suite does not hardcode any paths to tools.  If set it is
 used to locate the tools to test, otherwise the test suite assumes to
 be run from the build directory.
 **** MKTDATA and GPG_PRESET_PASSPHRASE
 These two tools are not installed by 'make install', hence we need to
 explicitly override their position.  In fact, the location of any tool
 used by the test suite can be overridden this way.  See defs.scm.
 **** argv[0]
 run-tests.scm depends on being able to re-exec gpgscm.  It uses
 argv[0] for that.  Therefore you must use an absolute path to invoke
 gpgscm.
 * How to write tests
 gpgscm provides a number of functions to aid you in writing tests, as
 well as bindings to process management abstractions provided by GnuPG.
 For the Scheme environment provided by TinySCHEME, see the TinySCHEME
 manual that is included in tests/gpgscm/Manual.txt.
 
 For a quick start, please have a look at various tests that are
 already implemented, e.g. 'encrypt.scm'.
 ** The test framework
 The functions info, error, and skip display their first argument and
 flush the output buffers.  error and skip will also terminate the
 process, signaling that the test failed or should be skipped.
 
 (for-each-p msg proc list) will display msg, and call proc with each
 element of list while displaying the progress appropriately.
 for-each-p' is similar, but accepts another callback before the 'list'
 argument to format each item.  for-each-p can be safely nested, and
 the inner progress indicator will be abbreviated using '.'.
 ** Debugging tests
 
 Say you are working on a new test called 'your-test.scm', you can run
 it on its own using
 
   obj $ make -C tests/openpgp check XTESTS=your-test.scm
 
 but something isn't working as expected.  There are several little
 gadgets that might help.  The first one is 'trace', a function that
 prints the value given to it and evaluates to it.  E.g.
 
   (trace (+ 2 3))
 
 prints '5' and evaluates to 5.  Also, there is an 'assert' macro that
 aborts the execution if its argument does not evaluate to a trueish
 value.  Feel free to express invariants with it.
 
 You can also get an interactive repl by dropping
 
   (interactive-repl (current-environment))
 
-anywhere you like.
+anywhere you like.  Or, if you want to examine the environment from an
+operating system shell, use
+
+  (interactive-shell)
 
 ** Interfacing with gpg
 
 defs.scm defines several convenience functions.  Say you want to parse
 the colon output from gpg, there is gpg-with-colons that splits the
 result at newlines and colons, so you can use the result like this:
 
  (define (fpr some-key)
    (list-ref (assoc "fpr" (gpg-with-colons
 			   `(--with-fingerprint
 			     --list-secret-keys ,some-key)))
 	     9))
 
 Or if you want to count all non-revoked uids for a given key, do
 
  (define (count-uids-of-secret-key some-key)
    (length (filter (lambda (x) (and (string=? "uid" (car x))
 				    (string=? "u" (cadr x))))
 		   (gpg-with-colons
 		    `(--with-fingerprint
 		      --list-secret-keys ,some-key)))))
 
 ** Temporary files
 (lettmp <bindings> <body>) will create and delete temporary files that
 you can use in <body>.  (with-temporary-working-directory <body>) will
 create a temporary director, change to that, and clean it up after
 executing <body>).
 
 make-temporary-file will create a temporary file.  You can optionally
 provide an argument to that function that will serve as tag so you can
 distinguish the files for debugging.  remove-temporary-file will
 delete a file created using make-temporary-file.
 
 ** Monadic transformer and pipe support
 Tests often perform sequential transformations on files, or connect
 processes using pipes.  To aid you in this, the test framework
 provides two monadic data structures.
 
 (Currently, the implementation mashes the 'bind' operation together
 with the application of the monad.  Also, there is no 'return'
 operation.  I guess all of that could be implemented on top of
 call/cc, but it isn't at the moment.)
 *** pipe
 The pipe monad constructs pipe lines.  It consists of a function
 pipe:do that binds the functions together and manages the execution of
 the child processes, a family of functions that act as sources, a
 function to spawn processes, and a family of functions acting as
 sinks.
 
 Sources are pipe:open, pipe:defer, pipe:echo.  To spawn a process use
 pipe:spawn, or the convenience function pipe:gpg.  To sink the data
 use pipe:splice, or pipe:write-to.
 
 Example:
 
   (pipe:do
     (pipe:echo "3\n1\n2\n")
     (pipe:spawn '("/usr/bin/sort"))
     (pipe:write-to "sorted" (logior O_WRONLY O_CREAT) #o600))
 
 Caveats: Due to the single-threaded nature of gpgscm you cannot use
 both a source and sink that is implemented in Scheme.  pipe:defer and
 pipe:echo are executing in gpgscm, and so does pipe:splice.
 *** tr
 The transformer monad describes sequential file transformations.
 
 There is one source function, tr:open.  To describe a transformation
 using some process, use tr:spawn, tr:gpg, or tr:pipe-do.  There are
 several sinks, although sink is not quite the right term, because the
 data is not consumed, and hence one can use them at any position.  The
 "sinks" are tr:write-to, tr:call-with-content, tr:assert-identity, and
 tr:assert-weak-identity.
 
 A somewhat contrived example demonstrating many functions is:
 
   (tr:do
     (tr:pipe-do
       (pipe:echo "3\n1\n2\n")
       (pipe:spawn '("/usr/bin/sort")))
     (tr:write-to "reference")
     (tr:call-with-content
      (lambda (c)
        (echo "currently, c contains" (string-length c) "bytes")))
     (tr:spawn "" '("/usr/bin/gcc" -x c "-E" -o **out** **in**))
     (tr:pipe-do
       (pipe:spawn '("/bin/grep" -v "#")))
     (tr:assert-identity "reference"))
 
 Caveats: As a convenience, gpgscm allows one to specify command line
 arguments as Scheme symbols.  Scheme symbols, however, are
 case-insensitive, and get converted to lower case.  Therefore, the -E
 argument must be given as a string in the example above.  Similarly,
 you need to quote numerical values.
 ** Process management
 If you just need to execute a single command, there is (call-with-fds
 cmdline infd outfd errfd) which executes cmdline with the given file
 descriptors bound to it, and waits for its completion returning the
 status code.  There is (call cmdline) which is similar, but calls the
 command with a closed stdin, connecting stdout and stderr to stderr if
 gpgscm is executed with --verbose.  (call-check cmdline) raises an
 exception if the command does not return 0.
 
 (call-popen cmdline input) calls a command, writes input to its stdin,
 and returns any output from stdout, or raises an exception containing
 stderr on failure.
 * Sample messages
diff --git a/tests/openpgp/shell.scm b/tests/openpgp/shell.scm
new file mode 100644
index 000000000..dadafff05
--- /dev/null
+++ b/tests/openpgp/shell.scm
@@ -0,0 +1,32 @@
+#!/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"))
+
+;; This is not a test, but can be used to inspect the test
+;; environment.  Simply execute
+;;
+;;   make -Ctests/openpgp check XTESTS=shell.scm
+;;
+;; to run it.
+
+(echo "Note that gpg.conf includes 'batch'.  If you want to use gpg")
+(echo "interactively you should drop that.")
+(echo)
+(interactive-shell)