mirror of git://git.gnupg.org/gnupg.git
tests/openpgp: Port the remaining tests to Scheme.
* 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>
This commit is contained in:
Justus Winter
parent
65081c31e7
commit
0340fcdac8
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
@ -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"))
|
||||
Loading…
Reference in New Issue