tests/openpgp: Port the remaining tests to Scheme.
authorJustus Winter <justus@g10code.com>
Tue, 21 Jun 2016 11:20:29 +0000 (13:20 +0200)
committerJustus Winter <justus@g10code.com>
Tue, 21 Jun 2016 14:22:11 +0000 (16:22 +0200)
* tests/openpgp/Makefile.am (TESTS): Add new tests.
* tests/openpgp/defs.scm (gpg-with-colons): New function.
(get-config): Use new function.
* tests/openpgp/export.scm: New file.
* tests/openpgp/tofu.scm: Likewise.

Signed-off-by: Justus Winter <justus@g10code.com>
tests/openpgp/Makefile.am
tests/openpgp/defs.scm
tests/openpgp/export.scm [new file with mode: 0755]
tests/openpgp/tofu.scm [new file with mode: 0755]

index 921619f..5c4c370 100644 (file)
@@ -40,12 +40,6 @@ TESTS_ENVIRONMENT = GNUPGHOME=$(abs_builddir) GPG_AGENT_INFO= LC_ALL=C \
        objdir=$(abs_top_builddir) \
        GPGSCM_PATH=$(top_srcdir)/tests/gpgscm:$(top_srcdir)/tests/openpgp
 
-if SQLITE3
-sqlite3_dependent_tests = tofu.test
-else
-sqlite3_dependent_tests =
-endif
-
 # Note: setup.scm needs to be the first test to run and finish.scm
 # the last one
 TESTS = setup.scm \
@@ -79,11 +73,11 @@ TESTS = setup.scm \
        import.scm \
        ecc.scm \
        4gb-packet.scm \
-       $(sqlite3_dependent_tests) \
+       tofu.scm \
        gpgtar.scm \
        use-exact-key.scm \
        default-key.scm \
-       export.test \
+       export.scm \
        finish.scm
 
 
index 6fdb955..4257b28 100644 (file)
 (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 s #\newline))))
+
 (define (get-config what)
-  (let* ((config-string
-         (call-popen `(,@GPG --with-colons --list-config ,what) ""))
-        (config (string-splitn
-                 (string-rtrim char-whitespace? config-string) #\: 2)))
-    (string-split (caddr config) #\;)))
+  (string-split (caddar (gpg-with-colons `(--list-config ,what))) #\;))
 
 (define all-pubkey-algos (get-config "pubkeyname"))
 (define all-hash-algos (get-config "digestname"))
diff --git a/tests/openpgp/export.scm b/tests/openpgp/export.scm
new file mode 100755 (executable)
index 0000000..8291705
--- /dev/null
@@ -0,0 +1,99 @@
+#!/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"))
+
+(define (check-for predicate lines message)
+  (unless (any predicate lines)
+         (error message)))
+
+(define (check-exported-key dump keyid)
+  (check-for (lambda (l)
+              (and (string-prefix? l " keyid: ")
+                   (string-suffix? l keyid))) dump
+                   "Keyid not found")
+  (check-for (lambda (l) (string-prefix? l ":user ID packet:")) dump
+            "User ID packet not found")
+  (check-for (lambda (l)
+              (and (string-prefix? l ":signature packet:")
+                   (string-contains? l "keyid")
+                   (string-suffix? l keyid))) dump
+                   "Signature packet not found"))
+
+(define (check-exported-public-key packet-dump keyid)
+  (let ((dump (string-split packet-dump #\newline)))
+    (check-for (lambda (l) (string-prefix? l ":public key packet:")) dump
+              "Public key packet not found")
+    (check-exported-key dump keyid)))
+
+(define (check-exported-private-key packet-dump keyid)
+  (let ((dump (string-split packet-dump #\newline)))
+    (check-for (lambda (l) (string-prefix? l ":secret key packet:")) dump
+              "Secret key packet not found")
+    (check-exported-key dump keyid)))
+
+(lettmp
+ ;; Prepare two temporary files for communication with the fake
+ ;; pinentry program.
+ (logfile ppfile)
+
+ (define (prepare-passphrases . passphrases)
+   (call-with-output-file ppfile
+     (lambda (port)
+       (for-each (lambda (passphrase)
+                  (display passphrase port)
+                  (display #\newline port)) passphrases))))
+
+ (define CONFIRM "fake-entry being started to CONFIRM the weak phrase")
+
+ (define (assert-passphrases-consumed)
+   (call-with-input-file ppfile
+     (lambda (port)
+       (unless
+       (eof-object? (peek-char port))
+       (error (string-append
+               "Expected all passphrases to be consumed, but found: "
+               (read-all port)))))))
+
+ (setenv "PINENTRY_USER_DATA"
+        (string-append "--logfile=" logfile " --passphrasefile=" ppfile) #t)
+
+ (for-each-p
+  "Checking key export"
+  (lambda (keyid)
+    (tr:do
+     (tr:pipe-do
+      (pipe:gpg `(--export ,keyid))
+      (pipe:gpg '(--list-packets)))
+     (tr:call-with-content check-exported-public-key keyid))
+
+    (if (string=? "D74C5F22" keyid)
+       ;; Key D74C5F22 is protected by a passphrase.  Prepare this
+       ;; one.  Currently, GnuPG does not ask for an export passphrase
+       ;; in this case.
+       (prepare-passphrases usrpass1))
+
+    (tr:do
+     (tr:pipe-do
+      (pipe:gpg `(--export-secret-keys ,keyid))
+      (pipe:gpg '(--list-packets)))
+     (tr:call-with-content check-exported-private-key keyid))
+
+    (assert-passphrases-consumed))
+  '("D74C5F22" "C40FDECF" "ECABF51D")))
diff --git a/tests/openpgp/tofu.scm b/tests/openpgp/tofu.scm
new file mode 100755 (executable)
index 0000000..24fa9df
--- /dev/null
@@ -0,0 +1,165 @@
+#!/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"))
+
+(define GPG `(,(tool 'gpg) --no-permission-warning)) ;; w/o --always-trust
+(define GNUPGHOME (getenv "GNUPGHOME"))
+(if (string=? "" GNUPGHOME)
+    (error "GNUPGHOME not set"))
+
+(catch (skip "Tofu not supported")
+       (call-check `(,@GPG --trust-model=tofu --list-config)))
+
+(define KEYS '("2183839A" "BC15C85A" "EE37CF96"))
+
+;; Import the test keys.
+(call-check `(,@GPG --import ,(in-srcdir "tofu-keys.asc")))
+
+;; Make sure the keys are imported.
+(for-each (lambda (keyid)
+           (catch (error "Missing key" keyid)
+                  (call-check `(,@GPG --list-keys ,keyid))))
+         KEYS)
+
+;; Get tofu policy for KEYID.  Any remaining arguments are simply
+;; passed to GPG.
+;;
+;; This function only supports keys with a single user id.
+(define (getpolicy keyid format . args)
+  (let ((policy
+        (list-ref (assoc "uid" (gpg-with-colons
+                                `(--tofu-db-format ,format
+                                  --trust-model=tofu
+                                  ,@args
+                                  --list-keys ,keyid))) 17)))
+    (unless (member policy '("auto" "good" "unknown" "bad" "ask"))
+           (error "Bad policy:" policy))
+    policy))
+
+;; Check that KEYID's tofu policy matches EXPECTED-POLICY.  Any
+;; remaining arguments are simply passed to GPG.
+;;
+;; This function only supports keys with a single user id.
+(define (checkpolicy keyid format expected-policy . args)
+  (let ((policy (apply getpolicy `(,keyid ,format ,@args))))
+    (unless (string=? policy expected-policy)
+           (error keyid ": Expected policy to be" expected-policy
+                  "but got" policy))))
+
+;; Get the trust level for KEYID.  Any remaining arguments are simply
+;; passed to GPG.
+;;
+;; This function only supports keys with a single user id.
+(define (gettrust keyid format . args)
+  (let ((trust
+        (list-ref (assoc "pub" (gpg-with-colons
+                                `(--tofu-db-format ,format
+                                  --trust-model=tofu
+                                  ,@args
+                                  --list-keys ,keyid))) 1)))
+    (unless (and (= 1 (string-length trust))
+                (member (string-ref trust 0) (string->list "oidreqnmfuws-")))
+           (error "Bad trust value:" trust))
+    trust))
+
+;; Check that KEYID's trust level matches EXPECTED-TRUST.  Any
+;; remaining arguments are simply passed to GPG.
+;;
+;; This function only supports keys with a single user id.
+(define (checktrust keyid format expected-trust . args)
+  (let ((trust (apply gettrust `(,keyid ,format ,@args))))
+    (unless (string=? trust expected-trust)
+           (error keyid ": Expected trust to be" expected-trust
+                  "but got" trust))))
+
+;; Set key KEYID's policy to POLICY.  Any remaining arguments are
+;; passed as options to gpg.
+(define (setpolicy keyid format policy . args)
+  (call-check `(,@GPG --tofu-db-format ,format
+                     --trust-model=tofu ,@args
+                     --tofu-policy ,policy ,keyid)))
+
+(for-each-p
+ "Testing tofu db formats"
+ (lambda (format)
+   ;; Carefully remove the TOFU db.
+   (catch '() (unlink (string-append GNUPGHOME "/tofu.db")))
+   (catch '() (unlink-recursively (string-append GNUPGHOME "/tofu.d")))
+
+   ;; Verify a message.  There should be no conflict and the trust
+   ;; policy should be set to auto.
+   (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
+                      --verify ,(in-srcdir "tofu-2183839A-1.txt")))
+
+   (checkpolicy "2183839A" format "auto")
+   ;; Check default trust.
+   (checktrust "2183839A" format "m")
+
+   ;; Trust should be derived lazily.  Thus, if the policy is set to
+   ;; auto and we change --tofu-default-policy, then the trust should
+   ;; change as well.  Try it.
+   (checktrust "2183839A" format "f" '--tofu-default-policy=good)
+   (checktrust "2183839A" format "-" '--tofu-default-policy=unknown)
+   (checktrust "2183839A" format "n" '--tofu-default-policy=bad)
+
+   ;; Change the policy to something other than auto and make sure the
+   ;; policy and the trust are correct.
+   (for-each-p
+    ""
+    (lambda (policy)
+      (let ((expected-trust
+            (cond
+             ((string=? "good" policy) "f")
+             ((string=? "unknown" policy) "-")
+             (else "n"))))
+       (setpolicy "2183839A" format policy)
+
+       ;; Since we have a fixed policy, the trust level shouldn't
+       ;; change if we change the default policy.
+       (for-each-p
+        ""
+        (lambda (default-policy)
+          (checkpolicy "2183839A" format policy
+                       '--tofu-default-policy default-policy)
+          (checktrust "2183839A" format expected-trust
+                      '--tofu-default-policy default-policy))
+        '("auto" "good" "unknown" "bad" "ask"))))
+    '("good" "unknown" "bad"))
+
+   ;; BC15C85A conflicts with 2183839A.  On conflict, this will set
+   ;; BC15C85A to ask.  If 2183839A is auto (it's not, it's bad), then
+   ;; it will be set to ask.
+   (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
+                      --verify ,(in-srcdir "tofu-BC15C85A-1.txt")))
+   (checkpolicy "BC15C85A" format "ask")
+   (checkpolicy "2183839A" format "bad")
+
+   ;; EE37CF96 conflicts with 2183839A and BC15C85A.  We change
+   ;; BC15C85A's policy to auto and leave 2183839A's policy at bad.
+   ;; This conflict should cause BC15C85A's policy to be changed to
+   ;; ask (since it is auto), but not affect 2183839A's policy.
+   (setpolicy "BC15C85A" format "auto")
+   (checkpolicy "BC15C85A" format "auto")
+   (call-check `(,@GPG --tofu-db-format ,format --trust-model=tofu
+                      --verify ,(in-srcdir "tofu-EE37CF96-1.txt")))
+   (checkpolicy "BC15C85A" format "ask")
+   (checkpolicy "2183839A" format "bad")
+   (checkpolicy "EE37CF96" format "ask"))
+ '("split" "flat"))