tests: Add test for gpgconf.

* tests/openpgp/Makefile.am (XTESTS): Add new test.
* tests/openpgp/defs.scm (percent-encode): New function.
(gpg-conf): Generalize so that we can feed stdin.
(gpg-config): New function.
* tests/openpgp/gpgconf.scm: New file.

Signed-off-by: Justus Winter <justus@g10code.com>

3 files changed, 73 insertions, 2 deletions

diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am
index c93857f1e..d1dd44914 100644
--- a/tests/openpgp/Makefile.am
+++ b/tests/openpgp/Makefile.am
@@ -92,6 +92,7 @@ XTESTS = \
 	quick-key-manipulation.scm \
 	key-selection.scm \
 	delete-keys.scm \
+	gpgconf.scm \
 	issue2015.scm \
 	issue2346.scm \
 	issue2417.scm \
diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
index 837e09691..1895a7587 100644
--- a/tests/openpgp/defs.scm
+++ b/tests/openpgp/defs.scm
@@ -1,6 +1,6 @@
 ;; Common definitions for the OpenPGP test scripts.
 ;;
-;; Copyright (C) 2016 g10 Code GmbH
+;; Copyright (C) 2016, 2017 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
@@ -96,6 +96,21 @@
 (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")
@@ -117,13 +132,27 @@
 			  (string-append (getenv "objdir") "/" (caddr t)))))))
 
 (define (gpg-conf . args)
-  (let ((s (call-popen `(,(tool-hardcoded 'gpgconf) ,@args) "")))
+  (gpg-conf' "" args))
+(define (gpg-conf' input args)
+  (let ((s (call-popen `(,(tool-hardcoded 'gpgconf) ,@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 (gpg-config component key)
+  (package
+   (define (value)
+     (assoc key (gpg-conf '--list-options component)))
+   (define (update value)
+     (gpg-conf' (string-append key ":0:" (percent-encode value))
+		`(--change-options ,component)))
+   (define (clear)
+     (gpg-conf' (string-append key ":1:")
+		`(--change-options ,component)))))
+
+
 (unless installed?
 	(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t))
 (define gpg-components (apply gpg-conf
diff --git a/tests/openpgp/gpgconf.scm b/tests/openpgp/gpgconf.scm
new file mode 100644
index 000000000..cdb6b760a
--- /dev/null
+++ b/tests/openpgp/gpgconf.scm
@@ -0,0 +1,41 @@
+#!/usr/bin/env gpgscm
+
+;; Copyright (C) 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/>.
+
+(load (with-path "defs.scm"))
+(setup-environment)
+
+(for-each-p'
+ "Checking reading and writing configuration via gpgconf... "
+ (lambda (name opt make-value)
+   (call-with-progress
+    ""
+    (lambda (progress)
+      (do ((i 0 (+ 1 i))) ((> i 12) #t)
+	(opt::update (make-value i))
+	(assert (string=? (make-value i) (list-ref (opt::value) 9)))
+	(progress ".")))))
+ (lambda (name . rest) name)
+ (list "keyserver" "verbose")
+ (list (gpg-config 'gpg "keyserver")
+       (gpg-config 'gpg "verbose"))
+ (list (lambda (i) (if (even? i) "\"hkp://foo.bar" "\"hkps://bar.baz"))
+       (lambda (i) (number->string
+		    ;; gpgconf: argument for option verbose of type 0
+		    ;; (none) must be positive
+		    (+ 1 i)))))