tests: Add test for gpgconf.
authorJustus Winter <justus@g10code.com>
Tue, 10 Jan 2017 11:38:07 +0000 (12:38 +0100)
committerJustus Winter <justus@g10code.com>
Tue, 10 Jan 2017 11:40:52 +0000 (12:40 +0100)
* 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>
tests/openpgp/Makefile.am
tests/openpgp/defs.scm
tests/openpgp/gpgconf.scm [new file with mode: 0644]

index c93857f..d1dd449 100644 (file)
@@ -92,6 +92,7 @@ XTESTS = \
        quick-key-manipulation.scm \
        key-selection.scm \
        delete-keys.scm \
+       gpgconf.scm \
        issue2015.scm \
        issue2346.scm \
        issue2417.scm \
index 837e096..1895a75 100644 (file)
@@ -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.
 ;;
 (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")
                          (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 (file)
index 0000000..cdb6b76
--- /dev/null
@@ -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)))))