diff --git a/tests/openpgp/Makefile.am b/tests/openpgp/Makefile.am index 921619f8f..5c4c3703d 100644 --- a/tests/openpgp/Makefile.am +++ b/tests/openpgp/Makefile.am @@ -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 diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm index 6fdb95580..4257b286e 100644 --- a/tests/openpgp/defs.scm +++ b/tests/openpgp/defs.scm @@ -82,12 +82,13 @@ (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 index 000000000..829170541 --- /dev/null +++ b/tests/openpgp/export.scm @@ -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 . + +(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 index 000000000..24fa9df02 --- /dev/null +++ b/tests/openpgp/tofu.scm @@ -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 . + +(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"))