diff options
| author | Jens Lechtenbörger | 2020-08-04 19:28:41 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2020-08-04 19:28:51 +0200 |
| commit | 0c6d2f0ff51eb24938f4af4116855b5facee9d24 (patch) | |
| tree | 081a9105615c5959e359c10f95c1a4f204d7407c | |
| parent | 59243e9f18a247bddd91ed704c8e3234383ed414 (diff) | |
| download | emacs-0c6d2f0ff51eb24938f4af4116855b5facee9d24.tar.gz emacs-0c6d2f0ff51eb24938f4af4116855b5facee9d24.zip | |
Add tests for mml-sec.el
36 files changed, 890 insertions, 0 deletions
diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/data/mml-sec/.gpg-v21-migrated new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/data/mml-sec/.gpg-v21-migrated | |||
diff --git a/test/data/mml-sec/gpg-agent.conf b/test/data/mml-sec/gpg-agent.conf new file mode 100644 index 00000000000..20192990caf --- /dev/null +++ b/test/data/mml-sec/gpg-agent.conf | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | # pinentry-program /usr/bin/pinentry-gtk-2 | ||
| 2 | |||
| 3 | # verbose | ||
| 4 | # log-file /tmp/gpg-agent.log | ||
| 5 | # debug-all | ||
diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key new file mode 100644 index 00000000000..58fd0b5edbc --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key new file mode 100644 index 00000000000..62f4ab25a69 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key new file mode 100644 index 00000000000..2a8ce135fb2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key new file mode 100644 index 00000000000..9f8de71c5e2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key new file mode 100644 index 00000000000..6e4a4e548fd --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key new file mode 100644 index 00000000000..cff58edaa89 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key new file mode 100644 index 00000000000..14af8662f79 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key new file mode 100644 index 00000000000..207a7237d3a --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key new file mode 100644 index 00000000000..85ca78da04d --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key new file mode 100644 index 00000000000..79f3cd2b841 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key new file mode 100644 index 00000000000..776ddf7e9e2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key new file mode 100644 index 00000000000..2b464f0ccbe --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key new file mode 100644 index 00000000000..28a07668b21 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key new file mode 100644 index 00000000000..137659693bd --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key new file mode 100644 index 00000000000..c99824ccd43 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key new file mode 100644 index 00000000000..49c2dc58bd8 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key new file mode 100644 index 00000000000..ca128408952 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key new file mode 100644 index 00000000000..3f14b40927a --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key new file mode 100644 index 00000000000..06adc06c427 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key new file mode 100644 index 00000000000..cf9a60d233b --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key new file mode 100644 index 00000000000..0ed35172fe0 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key new file mode 100644 index 00000000000..090059d9e81 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key new file mode 100644 index 00000000000..9061f675121 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key new file mode 100644 index 00000000000..89f6013100d --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key new file mode 100644 index 00000000000..41dac37574e --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key new file mode 100644 index 00000000000..5df7b4a5953 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key new file mode 100644 index 00000000000..03daf80975b --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/pubring.gpg b/test/data/mml-sec/pubring.gpg new file mode 100644 index 00000000000..6bd169963df --- /dev/null +++ b/test/data/mml-sec/pubring.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/pubring.kbx b/test/data/mml-sec/pubring.kbx new file mode 100644 index 00000000000..399a0414fd2 --- /dev/null +++ b/test/data/mml-sec/pubring.kbx | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/random_seed b/test/data/mml-sec/random_seed new file mode 100644 index 00000000000..530fd76c1e5 --- /dev/null +++ b/test/data/mml-sec/random_seed | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/secring.gpg b/test/data/mml-sec/secring.gpg new file mode 100644 index 00000000000..b323c072c04 --- /dev/null +++ b/test/data/mml-sec/secring.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/trustdb.gpg b/test/data/mml-sec/trustdb.gpg new file mode 100644 index 00000000000..09ebd8db114 --- /dev/null +++ b/test/data/mml-sec/trustdb.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/trustlist.txt b/test/data/mml-sec/trustlist.txt new file mode 100644 index 00000000000..f886572d283 --- /dev/null +++ b/test/data/mml-sec/trustlist.txt | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | # This is the list of trusted keys. Comment lines, like this one, as | ||
| 2 | # well as empty lines are ignored. Lines have a length limit but this | ||
| 3 | # is not a serious limitation as the format of the entries is fixed and | ||
| 4 | # checked by gpg-agent. A non-comment line starts with optional white | ||
| 5 | # space, followed by the SHA-1 fingerpint in hex, followed by a flag | ||
| 6 | # which may be one of 'P', 'S' or '*' and optionally followed by a list of | ||
| 7 | # other flags. The fingerprint may be prefixed with a '!' to mark the | ||
| 8 | # key as not trusted. You should give the gpg-agent a HUP or run the | ||
| 9 | # command "gpgconf --reload gpg-agent" after changing this file. | ||
| 10 | |||
| 11 | |||
| 12 | # Include the default trust list | ||
| 13 | include-default | ||
| 14 | |||
| 15 | |||
| 16 | # CN=No Expiry | ||
| 17 | D0:6A:A1:18:65:3C:C3:8E:9D:0C:AF:56:ED:7A:21:35:E1:58:21:77 S relax | ||
| 18 | |||
| 19 | # CN=Second Key Pair | ||
| 20 | 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 S relax | ||
| 21 | |||
| 22 | # CN=No Expiry two UIDs | ||
| 23 | D4:CA:78:E1:47:0B:9F:C2:AE:45:D7:84:64:9B:8C:E6:4E:BB:32:0C S relax | ||
| 24 | |||
| 25 | # CN=Different subkeys | ||
| 26 | 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC S relax | ||
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el new file mode 100644 index 00000000000..28be3b9bd46 --- /dev/null +++ b/test/lisp/gnus/mml-sec-tests.el | |||
| @@ -0,0 +1,859 @@ | |||
| 1 | ;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt. | ||
| 2 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 3 | |||
| 4 | ;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org> | ||
| 5 | |||
| 6 | ;; This file is not part of GNU Emacs. | ||
| 7 | |||
| 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 11 | ;; any later version. | ||
| 12 | |||
| 13 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;;; Code: | ||
| 24 | |||
| 25 | (require 'ert) | ||
| 26 | |||
| 27 | (require 'message) | ||
| 28 | (require 'epa) | ||
| 29 | (require 'epg) | ||
| 30 | (require 'mml-sec) | ||
| 31 | (require 'gnus-sum) | ||
| 32 | |||
| 33 | (defvar with-smime nil | ||
| 34 | "If nil, exclude S/MIME from tests as passphrases need to entered manually. | ||
| 35 | Mostly, the empty passphrase is used. However, the keys for | ||
| 36 | \"No Expiry two UIDs\" have the passphrase \"Passphrase\" (for OpenPGP as well | ||
| 37 | as S/MIME).") | ||
| 38 | |||
| 39 | (defun enc-standards () | ||
| 40 | (if with-smime '(enc-pgp enc-pgp-mime enc-smime) | ||
| 41 | '(enc-pgp enc-pgp-mime))) | ||
| 42 | (defun enc-sign-standards () | ||
| 43 | (if with-smime | ||
| 44 | '(enc-sign-pgp enc-sign-pgp-mime enc-sign-smime) | ||
| 45 | '(enc-sign-pgp enc-sign-pgp-mime))) | ||
| 46 | (defun sign-standards () | ||
| 47 | (if with-smime | ||
| 48 | '(sign-pgp sign-pgp-mime sign-smime) | ||
| 49 | '(sign-pgp sign-pgp-mime))) | ||
| 50 | |||
| 51 | (defun mml-secure-test-fixture (body &optional interactive) | ||
| 52 | "Setup GnuPG home containing test keys and prepare environment for BODY. | ||
| 53 | If optional INTERACTIVE is non-nil, allow questions to the user in case of | ||
| 54 | key problems. | ||
| 55 | This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests, | ||
| 56 | which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess. | ||
| 57 | Actually, I'm not sure why people would want to cache passwords in Emacs | ||
| 58 | instead of gpg-agent." | ||
| 59 | (unwind-protect | ||
| 60 | (let ((agent-info (getenv "GPG_AGENT_INFO")) | ||
| 61 | (gpghome (getenv "GNUPGHOME"))) | ||
| 62 | (condition-case error | ||
| 63 | (let ((epg-gpg-home-directory | ||
| 64 | (expand-file-name "test/data/mml-sec" source-directory)) | ||
| 65 | (mml-secure-allow-signing-with-unknown-recipient t) | ||
| 66 | (mml-smime-use 'epg) | ||
| 67 | ;; Create debug output in empty epg-debug-buffer. | ||
| 68 | (epg-debug t) | ||
| 69 | (epg-debug-buffer (get-buffer-create " *epg-test*")) | ||
| 70 | (mml-secure-fail-when-key-problem (not interactive))) | ||
| 71 | (with-current-buffer epg-debug-buffer | ||
| 72 | (erase-buffer)) | ||
| 73 | ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs. | ||
| 74 | ;; Just for testing. Jens does not recommend this for daily use. | ||
| 75 | (setenv "GPG_AGENT_INFO") | ||
| 76 | ;; Set GNUPGHOME as gpg-agent started by gpgsm does | ||
| 77 | ;; not look in the proper places otherwise, see: | ||
| 78 | ;; https://bugs.gnupg.org/gnupg/issue2126 | ||
| 79 | (setenv "GNUPGHOME" epg-gpg-home-directory) | ||
| 80 | (funcall body)) | ||
| 81 | (error | ||
| 82 | (setenv "GPG_AGENT_INFO" agent-info) | ||
| 83 | (setenv "GNUPGHOME" gpghome) | ||
| 84 | (signal (car error) (cdr error)))) | ||
| 85 | (setenv "GPG_AGENT_INFO" agent-info) | ||
| 86 | (setenv "GNUPGHOME" gpghome)))) | ||
| 87 | |||
| 88 | (defun mml-secure-test-message-setup (method to from &optional text bcc) | ||
| 89 | "Setup a buffer with MML METHOD, TO, and FROM headers. | ||
| 90 | Optionally, a message TEXT and BCC header can be passed." | ||
| 91 | (with-temp-buffer | ||
| 92 | (when bcc (insert (format "Bcc: %s\n" bcc))) | ||
| 93 | (insert (format "To: %s | ||
| 94 | From: %s | ||
| 95 | Subject: Test | ||
| 96 | %s\n" to from mail-header-separator)) | ||
| 97 | (if text | ||
| 98 | (insert (format "%s" text)) | ||
| 99 | (spook)) | ||
| 100 | (cond ((eq method 'enc-pgp-mime) | ||
| 101 | (mml-secure-message-encrypt-pgpmime 'nosig)) | ||
| 102 | ((eq method 'enc-sign-pgp-mime) | ||
| 103 | (mml-secure-message-encrypt-pgpmime)) | ||
| 104 | ((eq method 'enc-pgp) (mml-secure-message-encrypt-pgp 'nosig)) | ||
| 105 | ((eq method 'enc-sign-pgp) (mml-secure-message-encrypt-pgp)) | ||
| 106 | ((eq method 'enc-smime) (mml-secure-message-encrypt-smime 'nosig)) | ||
| 107 | ((eq method 'enc-sign-smime) (mml-secure-message-encrypt-smime)) | ||
| 108 | ((eq method 'sign-pgp-mime) (mml-secure-message-sign-pgpmime)) | ||
| 109 | ((eq method 'sign-pgp) (mml-secure-message-sign-pgp)) | ||
| 110 | ((eq method 'sign-smime) (mml-secure-message-sign-smime)) | ||
| 111 | (t (error "Unknown method"))) | ||
| 112 | (buffer-string))) | ||
| 113 | |||
| 114 | (defun mml-secure-test-mail-fixture (method to from body2 | ||
| 115 | &optional interactive) | ||
| 116 | "Setup buffer encrypted using METHOD for TO from FROM, call BODY2. | ||
| 117 | Pass optional INTERACTIVE to mml-secure-test-fixture." | ||
| 118 | (mml-secure-test-fixture | ||
| 119 | (lambda () | ||
| 120 | (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime)) | ||
| 121 | (epg-make-context 'CMS) | ||
| 122 | (epg-make-context 'OpenPGP))) | ||
| 123 | ;; Verify and decrypt by default. | ||
| 124 | (mm-verify-option 'known) | ||
| 125 | (mm-decrypt-option 'known) | ||
| 126 | (plaintext "The Magic Words are Squeamish Ossifrage")) | ||
| 127 | (with-temp-buffer | ||
| 128 | (insert (mml-secure-test-message-setup method to from plaintext)) | ||
| 129 | (message-options-set-recipient) | ||
| 130 | (message-encode-message-body) | ||
| 131 | ;; Replace separator line with newline. | ||
| 132 | (goto-char (point-min)) | ||
| 133 | (re-search-forward | ||
| 134 | (concat "^" (regexp-quote mail-header-separator) "\n")) | ||
| 135 | (replace-match "\n") | ||
| 136 | ;; The following treatment of handles, plainbuf, and multipart | ||
| 137 | ;; resulted from trial-and-error. | ||
| 138 | ;; Someone with more knowledge on how to decrypt messages and verify | ||
| 139 | ;; signatures might know more appropriate functions to invoke | ||
| 140 | ;; instead. | ||
| 141 | (let* ((handles (or (mm-dissect-buffer) | ||
| 142 | (mm-uu-dissect))) | ||
| 143 | (isplain (bufferp (car handles))) | ||
| 144 | (ismultipart (equal (car handles) "multipart/mixed")) | ||
| 145 | (plainbuf (if isplain | ||
| 146 | (car handles) | ||
| 147 | (if ismultipart | ||
| 148 | (car (cadadr handles)) | ||
| 149 | (caadr handles)))) | ||
| 150 | (decrypted | ||
| 151 | (with-current-buffer plainbuf (buffer-string))) | ||
| 152 | (gnus-info | ||
| 153 | (if isplain | ||
| 154 | nil | ||
| 155 | (if ismultipart | ||
| 156 | (or (mm-handle-multipart-ctl-parameter | ||
| 157 | (cadr handles) 'gnus-details) | ||
| 158 | (mm-handle-multipart-ctl-parameter | ||
| 159 | (cadr handles) 'gnus-info)) | ||
| 160 | (mm-handle-multipart-ctl-parameter | ||
| 161 | handles 'gnus-info))))) | ||
| 162 | (funcall body2 gnus-info plaintext decrypted))))) | ||
| 163 | interactive)) | ||
| 164 | |||
| 165 | ;; TODO If the variable BODY3 is renamed to BODY, an infinite recursion | ||
| 166 | ;; occurs. Emacs bug? | ||
| 167 | (defun mml-secure-test-key-fixture (body3) | ||
| 168 | "Customize unique keys for sub@example.org and call BODY3. | ||
| 169 | For OpenPGP, we have: | ||
| 170 | - 1E6B FA97 3D9E 3103 B77F D399 C399 9CF1 268D BEA2 | ||
| 171 | uid Different subkeys <sub@example.org> | ||
| 172 | - 1463 2ECA B9E2 2736 9C8D D97B F7E7 9AB7 AE31 D471 | ||
| 173 | uid Second Key Pair <sub@example.org> | ||
| 174 | |||
| 175 | For S/MIME: | ||
| 176 | ID: 0x479DC6E2 | ||
| 177 | Subject: /CN=Second Key Pair | ||
| 178 | aka: sub@example.org | ||
| 179 | fingerprint: 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 | ||
| 180 | |||
| 181 | ID: 0x5F88E9FC | ||
| 182 | Subject: /CN=Different subkeys | ||
| 183 | aka: sub@example.org | ||
| 184 | fingerprint: 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC | ||
| 185 | |||
| 186 | In both cases, the first key is customized for signing and encryption." | ||
| 187 | (mml-secure-test-fixture | ||
| 188 | (lambda () | ||
| 189 | (let* ((mml-secure-key-preferences | ||
| 190 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 191 | (pcontext (epg-make-context 'OpenPGP)) | ||
| 192 | (pkey (epg-list-keys pcontext "C3999CF1268DBEA2")) | ||
| 193 | (scontext (epg-make-context 'CMS)) | ||
| 194 | (skey (epg-list-keys scontext "0x479DC6E2"))) | ||
| 195 | (mml-secure-cust-record-keys pcontext 'encrypt "sub@example.org" pkey) | ||
| 196 | (mml-secure-cust-record-keys pcontext 'sign "sub@example.org" pkey) | ||
| 197 | (mml-secure-cust-record-keys scontext 'encrypt "sub@example.org" skey) | ||
| 198 | (mml-secure-cust-record-keys scontext 'sign "sub@example.org" skey) | ||
| 199 | (funcall body3))))) | ||
| 200 | |||
| 201 | (ert-deftest mml-secure-key-checks () | ||
| 202 | "Test mml-secure-check-user-id and mml-secure-check-sub-key on sample keys." | ||
| 203 | (mml-secure-test-fixture | ||
| 204 | (lambda () | ||
| 205 | (let* ((context (epg-make-context 'OpenPGP)) | ||
| 206 | (keys1 (epg-list-keys context "expired@example.org")) | ||
| 207 | (keys2 (epg-list-keys context "no-exp@example.org")) | ||
| 208 | (keys3 (epg-list-keys context "sub@example.org")) | ||
| 209 | (keys4 (epg-list-keys context "revoked-uid@example.org")) | ||
| 210 | (keys5 (epg-list-keys context "disabled@example.org")) | ||
| 211 | (keys6 (epg-list-keys context "sign@example.org")) | ||
| 212 | (keys7 (epg-list-keys context "jens.lechtenboerger@fsfe")) | ||
| 213 | ) | ||
| 214 | (should (and (= 1 (length keys1)) (= 1 (length keys2)) | ||
| 215 | (= 2 (length keys3)) | ||
| 216 | (= 1 (length keys4)) (= 1 (length keys5)) | ||
| 217 | )) | ||
| 218 | ;; key1 is expired | ||
| 219 | (should-not (mml-secure-check-user-id (car keys1) "expired@example.org")) | ||
| 220 | (should-not (mml-secure-check-sub-key context (car keys1) 'encrypt)) | ||
| 221 | (should-not (mml-secure-check-sub-key context (car keys1) 'sign)) | ||
| 222 | |||
| 223 | ;; key2 does not expire, but does not have the UID expired@example.org | ||
| 224 | (should-not (mml-secure-check-user-id (car keys2) "expired@example.org")) | ||
| 225 | (should (mml-secure-check-user-id (car keys2) "no-exp@example.org")) | ||
| 226 | (should (mml-secure-check-sub-key context (car keys2) 'encrypt)) | ||
| 227 | (should (mml-secure-check-sub-key context (car keys2) 'sign)) | ||
| 228 | |||
| 229 | ;; Two keys exist for sub@example.org. | ||
| 230 | (should (mml-secure-check-user-id (car keys3) "sub@example.org")) | ||
| 231 | (should (mml-secure-check-sub-key context (car keys3) 'encrypt)) | ||
| 232 | (should (mml-secure-check-sub-key context (car keys3) 'sign)) | ||
| 233 | (should (mml-secure-check-user-id (cadr keys3) "sub@example.org")) | ||
| 234 | (should (mml-secure-check-sub-key context (cadr keys3) 'encrypt)) | ||
| 235 | (should (mml-secure-check-sub-key context (cadr keys3) 'sign)) | ||
| 236 | |||
| 237 | ;; The UID revoked-uid@example.org is revoked. The key itself is | ||
| 238 | ;; usable, though (with the UID sub@example.org). | ||
| 239 | (should-not | ||
| 240 | (mml-secure-check-user-id (car keys4) "revoked-uid@example.org")) | ||
| 241 | (should (mml-secure-check-sub-key context (car keys4) 'encrypt)) | ||
| 242 | (should (mml-secure-check-sub-key context (car keys4) 'sign)) | ||
| 243 | (should (mml-secure-check-user-id (car keys4) "sub@example.org")) | ||
| 244 | |||
| 245 | ;; The next key is disabled and, thus, unusable. | ||
| 246 | (should (mml-secure-check-user-id (car keys5) "disabled@example.org")) | ||
| 247 | (should-not (mml-secure-check-sub-key context (car keys5) 'encrypt)) | ||
| 248 | (should-not (mml-secure-check-sub-key context (car keys5) 'sign)) | ||
| 249 | |||
| 250 | ;; The next key has multiple subkeys. | ||
| 251 | ;; 42466F0F is valid sign subkey, 501FFD98 is expired | ||
| 252 | (should (mml-secure-check-sub-key context (car keys6) 'sign "42466F0F")) | ||
| 253 | (should-not | ||
| 254 | (mml-secure-check-sub-key context (car keys6) 'sign "501FFD98")) | ||
| 255 | ;; DC7F66E7 is encrypt subkey | ||
| 256 | (should | ||
| 257 | (mml-secure-check-sub-key context (car keys6) 'encrypt "DC7F66E7")) | ||
| 258 | (should-not | ||
| 259 | (mml-secure-check-sub-key context (car keys6) 'sign "DC7F66E7")) | ||
| 260 | (should-not | ||
| 261 | (mml-secure-check-sub-key context (car keys6) 'encrypt "42466F0F")) | ||
| 262 | |||
| 263 | ;; The final key is just a public key. | ||
| 264 | (should (mml-secure-check-sub-key context (car keys7) 'encrypt)) | ||
| 265 | (should-not (mml-secure-check-sub-key context (car keys7) 'sign)) | ||
| 266 | )))) | ||
| 267 | |||
| 268 | (ert-deftest mml-secure-find-usable-keys-1 () | ||
| 269 | "Make sure that expired and disabled keys and revoked UIDs are not used." | ||
| 270 | (mml-secure-test-fixture | ||
| 271 | (lambda () | ||
| 272 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 273 | (should-not | ||
| 274 | (mml-secure-find-usable-keys context "expired@example.org" 'encrypt)) | ||
| 275 | (should-not | ||
| 276 | (mml-secure-find-usable-keys context "expired@example.org" 'sign)) | ||
| 277 | |||
| 278 | (should-not | ||
| 279 | (mml-secure-find-usable-keys context "disabled@example.org" 'encrypt)) | ||
| 280 | (should-not | ||
| 281 | (mml-secure-find-usable-keys context "disabled@example.org" 'sign)) | ||
| 282 | |||
| 283 | (should-not | ||
| 284 | (mml-secure-find-usable-keys | ||
| 285 | context "<revoked-uid@example.org>" 'encrypt)) | ||
| 286 | (should-not | ||
| 287 | (mml-secure-find-usable-keys | ||
| 288 | context "<revoked-uid@example.org>" 'sign)) | ||
| 289 | ;; Same test without ankles. Will fail for Ma Gnus v0.14 and earlier. | ||
| 290 | (should-not | ||
| 291 | (mml-secure-find-usable-keys | ||
| 292 | context "revoked-uid@example.org" 'encrypt)) | ||
| 293 | |||
| 294 | ;; Expired key should not be usable. | ||
| 295 | ;; Will fail for Ma Gnus v0.14 and earlier. | ||
| 296 | ;; sign@example.org has the expired subkey 0x501FFD98. | ||
| 297 | (should-not | ||
| 298 | (mml-secure-find-usable-keys context "0x501FFD98" 'sign)) | ||
| 299 | |||
| 300 | (should | ||
| 301 | (mml-secure-find-usable-keys context "no-exp@example.org" 'encrypt)) | ||
| 302 | (should | ||
| 303 | (mml-secure-find-usable-keys context "no-exp@example.org" 'sign)) | ||
| 304 | )))) | ||
| 305 | |||
| 306 | (ert-deftest mml-secure-find-usable-keys-2 () | ||
| 307 | "Test different ways to search for keys." | ||
| 308 | (mml-secure-test-fixture | ||
| 309 | (lambda () | ||
| 310 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 311 | ;; Plain substring search is not supported. | ||
| 312 | (should | ||
| 313 | (= 0 (length | ||
| 314 | (mml-secure-find-usable-keys context "No Expiry" 'encrypt)))) | ||
| 315 | (should | ||
| 316 | (= 0 (length | ||
| 317 | (mml-secure-find-usable-keys context "No Expiry" 'sign)))) | ||
| 318 | |||
| 319 | ;; Search for e-mail addresses works with and without ankle brackets. | ||
| 320 | (should | ||
| 321 | (= 1 (length (mml-secure-find-usable-keys | ||
| 322 | context "<no-exp@example.org>" 'encrypt)))) | ||
| 323 | (should | ||
| 324 | (= 1 (length (mml-secure-find-usable-keys | ||
| 325 | context "<no-exp@example.org>" 'sign)))) | ||
| 326 | (should | ||
| 327 | (= 1 (length (mml-secure-find-usable-keys | ||
| 328 | context "no-exp@example.org" 'encrypt)))) | ||
| 329 | (should | ||
| 330 | (= 1 (length (mml-secure-find-usable-keys | ||
| 331 | context "no-exp@example.org" 'sign)))) | ||
| 332 | |||
| 333 | ;; Use full UID string. | ||
| 334 | (should | ||
| 335 | (= 1 (length (mml-secure-find-usable-keys | ||
| 336 | context "No Expiry <no-exp@example.org>" 'encrypt)))) | ||
| 337 | (should | ||
| 338 | (= 1 (length (mml-secure-find-usable-keys | ||
| 339 | context "No Expiry <no-exp@example.org>" 'sign)))) | ||
| 340 | |||
| 341 | ;; If just the public key is present, only encryption is possible. | ||
| 342 | ;; Search works with key IDs, with and without prefix "0x". | ||
| 343 | (should | ||
| 344 | (= 1 (length (mml-secure-find-usable-keys | ||
| 345 | context "A142FD84" 'encrypt)))) | ||
| 346 | (should | ||
| 347 | (= 1 (length (mml-secure-find-usable-keys | ||
| 348 | context "0xA142FD84" 'encrypt)))) | ||
| 349 | (should | ||
| 350 | (= 0 (length (mml-secure-find-usable-keys | ||
| 351 | context "A142FD84" 'sign)))) | ||
| 352 | (should | ||
| 353 | (= 0 (length (mml-secure-find-usable-keys | ||
| 354 | context "0xA142FD84" 'sign)))) | ||
| 355 | )))) | ||
| 356 | |||
| 357 | (ert-deftest mml-secure-select-preferred-keys-1 () | ||
| 358 | "If only one key exists for an e-mail address, it is the preferred one." | ||
| 359 | (mml-secure-test-fixture | ||
| 360 | (lambda () | ||
| 361 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 362 | (should (equal "832F3CC6518D37BC658261B802372A42CA6D40FB" | ||
| 363 | (mml-secure-fingerprint | ||
| 364 | (car (mml-secure-select-preferred-keys | ||
| 365 | context '("no-exp@example.org") 'encrypt))))))))) | ||
| 366 | |||
| 367 | (ert-deftest mml-secure-select-preferred-keys-2 () | ||
| 368 | "If multiple keys exists for an e-mail address, customization is necessary." | ||
| 369 | (mml-secure-test-fixture | ||
| 370 | (lambda () | ||
| 371 | (let* ((context (epg-make-context 'OpenPGP)) | ||
| 372 | (mml-secure-key-preferences | ||
| 373 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 374 | (pref (car (mml-secure-find-usable-keys | ||
| 375 | context "sub@example.org" 'encrypt)))) | ||
| 376 | (should-error (mml-secure-select-preferred-keys | ||
| 377 | context '("sub@example.org") 'encrypt)) | ||
| 378 | (mml-secure-cust-record-keys | ||
| 379 | context 'encrypt "sub@example.org" (list pref)) | ||
| 380 | (should (mml-secure-select-preferred-keys | ||
| 381 | context '("sub@example.org") 'encrypt)) | ||
| 382 | (should-error (mml-secure-select-preferred-keys | ||
| 383 | context '("sub@example.org") 'sign)) | ||
| 384 | (should (mml-secure-select-preferred-keys | ||
| 385 | context '("sub@example.org") 'encrypt)) | ||
| 386 | (should | ||
| 387 | (equal (list (mml-secure-fingerprint pref)) | ||
| 388 | (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org"))) | ||
| 389 | (should (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")) | ||
| 390 | (should-error (mml-secure-select-preferred-keys | ||
| 391 | context '("sub@example.org") 'encrypt)))))) | ||
| 392 | |||
| 393 | (ert-deftest mml-secure-select-preferred-keys-3 () | ||
| 394 | "Expired customized keys are removed if multiple keys are available." | ||
| 395 | (mml-secure-test-fixture | ||
| 396 | (lambda () | ||
| 397 | (let ((context (epg-make-context 'OpenPGP)) | ||
| 398 | (mml-secure-key-preferences | ||
| 399 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))) | ||
| 400 | ;; sub@example.org has two keys (268DBEA2, AE31D471). | ||
| 401 | ;; Normal preference works. | ||
| 402 | (mml-secure-cust-record-keys | ||
| 403 | context 'encrypt "sub@example.org" (epg-list-keys context "268DBEA2")) | ||
| 404 | (should (mml-secure-select-preferred-keys | ||
| 405 | context '("sub@example.org") 'encrypt)) | ||
| 406 | (mml-secure-cust-remove-keys context 'encrypt "sub@example.org") | ||
| 407 | |||
| 408 | ;; Fake preference for expired (unrelated) key CE15FAE7, | ||
| 409 | ;; results in error (and automatic removal of outdated preference). | ||
| 410 | (mml-secure-cust-record-keys | ||
| 411 | context 'encrypt "sub@example.org" (epg-list-keys context "CE15FAE7")) | ||
| 412 | (should-error (mml-secure-select-preferred-keys | ||
| 413 | context '("sub@example.org") 'encrypt)) | ||
| 414 | (should-not | ||
| 415 | (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")))))) | ||
| 416 | |||
| 417 | (ert-deftest mml-secure-select-preferred-keys-4 () | ||
| 418 | "Multiple keys can be recorded per recipient or signature." | ||
| 419 | (mml-secure-test-fixture | ||
| 420 | (lambda () | ||
| 421 | (let ((pcontext (epg-make-context 'OpenPGP)) | ||
| 422 | (scontext (epg-make-context 'CMS)) | ||
| 423 | (pkeys '("1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" | ||
| 424 | "14632ECAB9E227369C8DD97BF7E79AB7AE31D471")) | ||
| 425 | (skeys '("0x5F88E9FC" "0x479DC6E2")) | ||
| 426 | (mml-secure-key-preferences | ||
| 427 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))) | ||
| 428 | |||
| 429 | ;; OpenPGP preferences via pcontext | ||
| 430 | (dolist (key pkeys nil) | ||
| 431 | (mml-secure-cust-record-keys | ||
| 432 | pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key)) | ||
| 433 | (mml-secure-cust-record-keys | ||
| 434 | pcontext 'sign "sub@example.org" (epg-list-keys pcontext key 'secret))) | ||
| 435 | (let ((p-e-fprs (mml-secure-cust-fpr-lookup | ||
| 436 | pcontext 'encrypt "sub@example.org")) | ||
| 437 | (p-s-fprs (mml-secure-cust-fpr-lookup | ||
| 438 | pcontext 'sign "sub@example.org"))) | ||
| 439 | (should (= 2 (length p-e-fprs))) | ||
| 440 | (should (= 2 (length p-s-fprs))) | ||
| 441 | (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-e-fprs)) | ||
| 442 | (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-e-fprs)) | ||
| 443 | (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-s-fprs)) | ||
| 444 | (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-s-fprs))) | ||
| 445 | ;; Duplicate record does not change anything. | ||
| 446 | (mml-secure-cust-record-keys | ||
| 447 | pcontext 'encrypt "sub@example.org" | ||
| 448 | (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2")) | ||
| 449 | (mml-secure-cust-record-keys | ||
| 450 | pcontext 'sign "sub@example.org" | ||
| 451 | (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2")) | ||
| 452 | (let ((p-e-fprs (mml-secure-cust-fpr-lookup | ||
| 453 | pcontext 'encrypt "sub@example.org")) | ||
| 454 | (p-s-fprs (mml-secure-cust-fpr-lookup | ||
| 455 | pcontext 'sign "sub@example.org"))) | ||
| 456 | (should (= 2 (length p-e-fprs))) | ||
| 457 | (should (= 2 (length p-s-fprs)))) | ||
| 458 | |||
| 459 | ;; S/MIME preferences via scontext | ||
| 460 | (dolist (key skeys nil) | ||
| 461 | (mml-secure-cust-record-keys | ||
| 462 | scontext 'encrypt "sub@example.org" | ||
| 463 | (epg-list-keys scontext key)) | ||
| 464 | (mml-secure-cust-record-keys | ||
| 465 | scontext 'sign "sub@example.org" | ||
| 466 | (epg-list-keys scontext key 'secret))) | ||
| 467 | (let ((s-e-fprs (mml-secure-cust-fpr-lookup | ||
| 468 | scontext 'encrypt "sub@example.org")) | ||
| 469 | (s-s-fprs (mml-secure-cust-fpr-lookup | ||
| 470 | scontext 'sign "sub@example.org"))) | ||
| 471 | (should (= 2 (length s-e-fprs))) | ||
| 472 | (should (= 2 (length s-s-fprs)))) | ||
| 473 | )))) | ||
| 474 | |||
| 475 | (defun mml-secure-test-en-decrypt | ||
| 476 | (method to from | ||
| 477 | &optional checksig checkplain enc-keys expectfail interactive) | ||
| 478 | "Encrypt message using METHOD, addressed to TO, from FROM. | ||
| 479 | If optional CHECKSIG is non-nil, it must be a number, and a signature check is | ||
| 480 | performed; the number indicates how many signatures are expected. | ||
| 481 | If optional CHECKPLAIN is non-nil, the expected plaintext should be obtained | ||
| 482 | via decryption. | ||
| 483 | If optional ENC-KEYS is non-nil, it is a list of pairs of encryption keys (for | ||
| 484 | OpenPGP and S/SMIME) expected in `epg-debug-buffer'. | ||
| 485 | If optional EXPECTFAIL is non-nil, a decryption failure is expected. | ||
| 486 | Pass optional INTERACTIVE to mml-secure-test-mail-fixture." | ||
| 487 | (mml-secure-test-mail-fixture method to from | ||
| 488 | (lambda (gnus-info plaintext decrypted) | ||
| 489 | (if expectfail | ||
| 490 | (should-not (equal plaintext decrypted)) | ||
| 491 | (when checkplain | ||
| 492 | (should (equal plaintext decrypted))) | ||
| 493 | (let ((protocol (if (memq method | ||
| 494 | '(enc-smime enc-sign-smime sign-smime)) | ||
| 495 | 'CMS | ||
| 496 | 'OpenPGP))) | ||
| 497 | (when checksig | ||
| 498 | (let* ((context (epg-make-context protocol)) | ||
| 499 | (signer-names (mml-secure-signer-names protocol from)) | ||
| 500 | (signer-keys (mml-secure-signers context signer-names)) | ||
| 501 | (signer-fprs (mapcar 'mml-secure-fingerprint signer-keys))) | ||
| 502 | (should (eq checksig (length signer-fprs))) | ||
| 503 | (if (eq checksig 0) | ||
| 504 | ;; First key in keyring | ||
| 505 | (should (string-match-p | ||
| 506 | (concat "Good signature from " | ||
| 507 | (if (eq protocol 'CMS) | ||
| 508 | "0E58229B80EE33959FF718FEEF25402B479DC6E2" | ||
| 509 | "02372A42CA6D40FB")) | ||
| 510 | gnus-info))) | ||
| 511 | (dolist (fpr signer-fprs nil) | ||
| 512 | ;; OpenPGP: "Good signature from 02372A42CA6D40FB No Expiry <no-exp@example.org> (trust undefined) created ..." | ||
| 513 | ;; S/MIME: "Good signature from D06AA118653CC38E9D0CAF56ED7A2135E1582177 /CN=No Expiry (trust full) ..." | ||
| 514 | (should (string-match-p | ||
| 515 | (concat "Good signature from " | ||
| 516 | (if (eq protocol 'CMS) | ||
| 517 | fpr | ||
| 518 | (substring fpr -16 nil))) | ||
| 519 | gnus-info))))) | ||
| 520 | (when enc-keys | ||
| 521 | (with-current-buffer epg-debug-buffer | ||
| 522 | (goto-char (point-min)) | ||
| 523 | ;; The following regexp does not necessarily match at the | ||
| 524 | ;; start of the line as a path may or may not be present. | ||
| 525 | ;; Also note that gpg.* matches gpg2 and gpgsm as well. | ||
| 526 | (let* ((line (concat "gpg.*--encrypt.*$")) | ||
| 527 | (end (re-search-forward line)) | ||
| 528 | (match (match-string 0))) | ||
| 529 | (should (and end match)) | ||
| 530 | (dolist (pair enc-keys nil) | ||
| 531 | (let ((fpr (if (eq protocol 'OpenPGP) | ||
| 532 | (car pair) | ||
| 533 | (cdr pair)))) | ||
| 534 | (should (string-match-p (concat "-r " fpr) match)))) | ||
| 535 | (goto-char (point-max)) | ||
| 536 | )))))) | ||
| 537 | interactive)) | ||
| 538 | |||
| 539 | (defun mml-secure-test-en-decrypt-with-passphrase | ||
| 540 | (method to from checksig jl-passphrase do-cache | ||
| 541 | &optional enc-keys expectfail) | ||
| 542 | "Call mml-secure-test-en-decrypt with changed passphrase caching. | ||
| 543 | Args METHOD, TO, FROM, CHECKSIG are passed to mml-secure-test-en-decrypt. | ||
| 544 | JL-PASSPHRASE is fixed as return value for `read-passwd', | ||
| 545 | boolean DO-CACHE determines whether to cache the passphrase. | ||
| 546 | If optional ENC-KEYS is non-nil, it is a list of encryption keys expected | ||
| 547 | in `epg-debug-buffer'. | ||
| 548 | If optional EXPECTFAIL is non-nil, a decryption failure is expected." | ||
| 549 | (let ((mml-secure-cache-passphrase do-cache) | ||
| 550 | (mml1991-cache-passphrase do-cache) | ||
| 551 | (mml2015-cache-passphrase do-cache) | ||
| 552 | (mml-smime-cache-passphrase do-cache) | ||
| 553 | ) | ||
| 554 | (cl-letf (((symbol-function 'read-passwd) | ||
| 555 | (lambda (prompt &optional confirm default) jl-passphrase))) | ||
| 556 | (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail) | ||
| 557 | ))) | ||
| 558 | |||
| 559 | (ert-deftest mml-secure-en-decrypt-1 () | ||
| 560 | "Encrypt message; then decrypt and test for expected result. | ||
| 561 | In this test, the single matching key is chosen automatically." | ||
| 562 | (dolist (method (enc-standards) nil) | ||
| 563 | ;; no-exp@example.org with single encryption key | ||
| 564 | (mml-secure-test-en-decrypt | ||
| 565 | method "no-exp@example.org" "sub@example.org" nil t | ||
| 566 | (list (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))) | ||
| 567 | |||
| 568 | (ert-deftest mml-secure-en-decrypt-2 () | ||
| 569 | "Encrypt message; then decrypt and test for expected result. | ||
| 570 | In this test, the encryption key needs to fixed among multiple ones." | ||
| 571 | ;; sub@example.org with multiple candidate keys, | ||
| 572 | ;; fixture customizes preferred ones. | ||
| 573 | (mml-secure-test-key-fixture | ||
| 574 | (lambda () | ||
| 575 | (dolist (method (enc-standards) nil) | ||
| 576 | (mml-secure-test-en-decrypt | ||
| 577 | method "sub@example.org" "no-exp@example.org" nil t | ||
| 578 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2"))))))) | ||
| 579 | |||
| 580 | (ert-deftest mml-secure-en-decrypt-3 () | ||
| 581 | "Encrypt message; then decrypt and test for expected result. | ||
| 582 | In this test, encrypt-to-self variables are set to t." | ||
| 583 | ;; sub@example.org with multiple candidate keys, | ||
| 584 | ;; fixture customizes preferred ones. | ||
| 585 | (mml-secure-test-key-fixture | ||
| 586 | (lambda () | ||
| 587 | (let ((mml-secure-openpgp-encrypt-to-self t) | ||
| 588 | (mml-secure-smime-encrypt-to-self t)) | ||
| 589 | (dolist (method (enc-standards) nil) | ||
| 590 | (mml-secure-test-en-decrypt | ||
| 591 | method "sub@example.org" "no-exp@example.org" nil t | ||
| 592 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 593 | (cons "02372A42CA6D40FB" "ED7A2135E1582177")))))))) | ||
| 594 | |||
| 595 | (ert-deftest mml-secure-en-decrypt-4 () | ||
| 596 | "Encrypt message; then decrypt and test for expected result. | ||
| 597 | In this test, encrypt-to-self variables are set to lists." | ||
| 598 | ;; Send from sub@example.org, which has two keys; encrypt to both. | ||
| 599 | (let ((mml-secure-openpgp-encrypt-to-self | ||
| 600 | '("C3999CF1268DBEA2" "F7E79AB7AE31D471")) | ||
| 601 | (mml-secure-smime-encrypt-to-self | ||
| 602 | '("EF25402B479DC6E2" "4035D59B5F88E9FC"))) | ||
| 603 | (dolist (method (enc-standards) nil) | ||
| 604 | (mml-secure-test-en-decrypt | ||
| 605 | method "no-exp@example.org" "sub@example.org" nil t | ||
| 606 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 607 | (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC")))))) | ||
| 608 | |||
| 609 | (ert-deftest mml-secure-en-decrypt-sign-1 () | ||
| 610 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 611 | In this test, just multiple encryption and signing keys may be available." | ||
| 612 | (mml-secure-test-key-fixture | ||
| 613 | (lambda () | ||
| 614 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 615 | (mml-secure-smime-sign-with-sender t)) | ||
| 616 | (dolist (method (enc-sign-standards) nil) | ||
| 617 | ;; no-exp with just one key | ||
| 618 | (mml-secure-test-en-decrypt | ||
| 619 | method "no-exp@example.org" "no-exp@example.org" 1 t) | ||
| 620 | ;; customized choice for encryption key | ||
| 621 | (mml-secure-test-en-decrypt | ||
| 622 | method "sub@example.org" "no-exp@example.org" 1 t) | ||
| 623 | ;; customized choice for signing key | ||
| 624 | (mml-secure-test-en-decrypt | ||
| 625 | method "no-exp@example.org" "sub@example.org" 1 t) | ||
| 626 | ;; customized choice for both keys | ||
| 627 | (mml-secure-test-en-decrypt | ||
| 628 | method "sub@example.org" "sub@example.org" 1 t) | ||
| 629 | ) | ||
| 630 | |||
| 631 | ;; Now use both keys to sign. The customized one via sign-with-sender, | ||
| 632 | ;; the other one via the following setting. | ||
| 633 | (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471")) | ||
| 634 | (mml-secure-smime-signers '("0x5F88E9FC"))) | ||
| 635 | (dolist (method (enc-sign-standards) nil) | ||
| 636 | (mml-secure-test-en-decrypt | ||
| 637 | method "no-exp@example.org" "sub@example.org" 2 t) | ||
| 638 | ))) | ||
| 639 | |||
| 640 | ;; Now use both keys for sub@example.org to sign an e-mail from | ||
| 641 | ;; a different address (without associated keys). | ||
| 642 | (let ((mml-secure-openpgp-sign-with-sender nil) | ||
| 643 | (mml-secure-smime-sign-with-sender nil) | ||
| 644 | (mml-secure-openpgp-signers | ||
| 645 | '("F7E79AB7AE31D471" "C3999CF1268DBEA2")) | ||
| 646 | (mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2"))) | ||
| 647 | (dolist (method (enc-sign-standards) nil) | ||
| 648 | (mml-secure-test-en-decrypt | ||
| 649 | method "no-exp@example.org" "no-keys@example.org" 2 t) | ||
| 650 | ))))) | ||
| 651 | |||
| 652 | (ert-deftest mml-secure-en-decrypt-sign-2 () | ||
| 653 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 654 | In this test, lists of encryption and signing keys are customized." | ||
| 655 | (mml-secure-test-key-fixture | ||
| 656 | (lambda () | ||
| 657 | (let ((mml-secure-key-preferences | ||
| 658 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 659 | (pcontext (epg-make-context 'OpenPGP)) | ||
| 660 | (scontext (epg-make-context 'CMS)) | ||
| 661 | (mml-secure-openpgp-sign-with-sender t) | ||
| 662 | (mml-secure-smime-sign-with-sender t)) | ||
| 663 | (dolist (key '("F7E79AB7AE31D471" "C3999CF1268DBEA2") nil) | ||
| 664 | (mml-secure-cust-record-keys | ||
| 665 | pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key)) | ||
| 666 | (mml-secure-cust-record-keys | ||
| 667 | pcontext 'sign "sub@example.org" (epg-list-keys pcontext key t))) | ||
| 668 | (dolist (key '("0x5F88E9FC" "0x479DC6E2") nil) | ||
| 669 | (mml-secure-cust-record-keys | ||
| 670 | scontext 'encrypt "sub@example.org" (epg-list-keys scontext key)) | ||
| 671 | (mml-secure-cust-record-keys | ||
| 672 | scontext 'sign "sub@example.org" (epg-list-keys scontext key t))) | ||
| 673 | (dolist (method (enc-sign-standards) nil) | ||
| 674 | ;; customized choice for encryption key | ||
| 675 | (mml-secure-test-en-decrypt | ||
| 676 | method "sub@example.org" "no-exp@example.org" 1 t) | ||
| 677 | ;; customized choice for signing key | ||
| 678 | (mml-secure-test-en-decrypt | ||
| 679 | method "no-exp@example.org" "sub@example.org" 2 t) | ||
| 680 | ;; customized choice for both keys | ||
| 681 | (mml-secure-test-en-decrypt | ||
| 682 | method "sub@example.org" "sub@example.org" 2 t) | ||
| 683 | ))))) | ||
| 684 | |||
| 685 | (ert-deftest mml-secure-en-decrypt-sign-3 () | ||
| 686 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 687 | Use sign-with-sender and encrypt-to-self." | ||
| 688 | (mml-secure-test-key-fixture | ||
| 689 | (lambda () | ||
| 690 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 691 | (mml-secure-openpgp-encrypt-to-self t) | ||
| 692 | (mml-secure-smime-sign-with-sender t) | ||
| 693 | (mml-secure-smime-encrypt-to-self t)) | ||
| 694 | (dolist (method (enc-sign-standards) nil) | ||
| 695 | (mml-secure-test-en-decrypt | ||
| 696 | method "sub@example.org" "no-exp@example.org" 1 t | ||
| 697 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 698 | (cons "02372A42CA6D40FB" "ED7A2135E1582177")))) | ||
| 699 | )))) | ||
| 700 | |||
| 701 | (ert-deftest mml-secure-sign-verify-1 () | ||
| 702 | "Sign message with sender; then verify and test for expected result." | ||
| 703 | (mml-secure-test-key-fixture | ||
| 704 | (lambda () | ||
| 705 | (dolist (method (sign-standards) nil) | ||
| 706 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 707 | (mml-secure-smime-sign-with-sender t)) | ||
| 708 | ;; A single signing key for sender sub@example.org is customized | ||
| 709 | ;; in the fixture. | ||
| 710 | (mml-secure-test-en-decrypt | ||
| 711 | method "uid1@example.org" "sub@example.org" 1 nil) | ||
| 712 | |||
| 713 | ;; From sub@example.org, sign with two keys; | ||
| 714 | ;; sign-with-sender and one from signers-variable: | ||
| 715 | (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB")) | ||
| 716 | (mml-secure-smime-signers | ||
| 717 | '("D06AA118653CC38E9D0CAF56ED7A2135E1582177"))) | ||
| 718 | (mml-secure-test-en-decrypt | ||
| 719 | method "no-exp@example.org" "sub@example.org" 2 nil)) | ||
| 720 | ))))) | ||
| 721 | |||
| 722 | (ert-deftest mml-secure-sign-verify-2 () | ||
| 723 | "Sign message without sender; then verify and test for expected result." | ||
| 724 | (mml-secure-test-key-fixture | ||
| 725 | (lambda () | ||
| 726 | (dolist (method (sign-standards) nil) | ||
| 727 | (let ((mml-secure-openpgp-sign-with-sender nil) | ||
| 728 | (mml-secure-smime-sign-with-sender nil)) | ||
| 729 | ;; A single signing key for sender sub@example.org is customized | ||
| 730 | ;; in the fixture, but not used here. | ||
| 731 | ;; By default, gpg uses the first secret key in the keyring, which | ||
| 732 | ;; is 02372A42CA6D40FB (OpenPGP) or | ||
| 733 | ;; 0E58229B80EE33959FF718FEEF25402B479DC6E2 (S/MIME) here. | ||
| 734 | (mml-secure-test-en-decrypt | ||
| 735 | method "uid1@example.org" "sub@example.org" 0 nil) | ||
| 736 | |||
| 737 | ;; From sub@example.org, sign with specified key: | ||
| 738 | (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB")) | ||
| 739 | (mml-secure-smime-signers | ||
| 740 | '("D06AA118653CC38E9D0CAF56ED7A2135E1582177"))) | ||
| 741 | (mml-secure-test-en-decrypt | ||
| 742 | method "no-exp@example.org" "sub@example.org" 1 nil)) | ||
| 743 | |||
| 744 | ;; From sub@example.org, sign with different specified key: | ||
| 745 | (let ((mml-secure-openpgp-signers '("C3999CF1268DBEA2")) | ||
| 746 | (mml-secure-smime-signers | ||
| 747 | '("0E58229B80EE33959FF718FEEF25402B479DC6E2"))) | ||
| 748 | (mml-secure-test-en-decrypt | ||
| 749 | method "no-exp@example.org" "sub@example.org" 1 nil)) | ||
| 750 | ))))) | ||
| 751 | |||
| 752 | (ert-deftest mml-secure-sign-verify-3 () | ||
| 753 | "Try to sign message with expired OpenPGP subkey, which raises an error. | ||
| 754 | With Ma Gnus v0.14 and earlier a signature would be created with a wrong key." | ||
| 755 | (should-error | ||
| 756 | (mml-secure-test-key-fixture | ||
| 757 | (lambda () | ||
| 758 | (let ((with-smime nil) | ||
| 759 | (mml-secure-openpgp-sign-with-sender nil) | ||
| 760 | (mml-secure-openpgp-signers '("501FFD98"))) | ||
| 761 | (dolist (method (sign-standards) nil) | ||
| 762 | (mml-secure-test-en-decrypt | ||
| 763 | method "no-exp@example.org" "sign@example.org" 1 nil) | ||
| 764 | )))))) | ||
| 765 | |||
| 766 | ;; TODO Passphrase passing and caching in Emacs does not seem to work | ||
| 767 | ;; with gpgsm at all. | ||
| 768 | ;; Independently of caching settings, a pinentry dialogue is displayed. | ||
| 769 | ;; Thus, the following tests require the user to enter the correct gpgsm | ||
| 770 | ;; passphrases at the correct points in time. (Either empty string or | ||
| 771 | ;; "Passphrase".) | ||
| 772 | (ert-deftest mml-secure-en-decrypt-passphrase-cache () | ||
| 773 | "Encrypt message; then decrypt and test for expected result. | ||
| 774 | In this test, a key is used that requires the passphrase \"Passphrase\". | ||
| 775 | In the first decryption this passphrase is hardcoded, in the second one it | ||
| 776 | is taken from a cache." | ||
| 777 | (ert-skip "Requires passphrase") | ||
| 778 | (mml-secure-test-key-fixture | ||
| 779 | (lambda () | ||
| 780 | (dolist (method (enc-standards) nil) | ||
| 781 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 782 | method "uid1@example.org" "sub@example.org" nil | ||
| 783 | ;; Beware! For passphrases copy-sequence is necessary, as they may | ||
| 784 | ;; be erased, which actually changes the function's code and causes | ||
| 785 | ;; multiple invokations to fail. I was surprised... | ||
| 786 | (copy-sequence "Passphrase") t) | ||
| 787 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 788 | method "uid1@example.org" "sub@example.org" nil | ||
| 789 | (copy-sequence "Incorrect") t))))) | ||
| 790 | |||
| 791 | (defun mml-secure-en-decrypt-passphrase-no-cache (method) | ||
| 792 | "Encrypt message with METHOD; then decrypt and test for expected result. | ||
| 793 | In this test, a key is used that requires the passphrase \"Passphrase\". | ||
| 794 | In the first decryption this passphrase is hardcoded, but caching disabled. | ||
| 795 | So the second decryption fails." | ||
| 796 | (mml-secure-test-key-fixture | ||
| 797 | (lambda () | ||
| 798 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 799 | method "uid1@example.org" "sub@example.org" nil | ||
| 800 | (copy-sequence "Passphrase") nil) | ||
| 801 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 802 | method "uid1@example.org" "sub@example.org" nil | ||
| 803 | (copy-sequence "Incorrect") nil nil t)))) | ||
| 804 | |||
| 805 | (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-openpgp-todo () | ||
| 806 | "Passphrase caching with OpenPGP only for GnuPG 1.x." | ||
| 807 | (skip-unless (string< (cdr (assq 'version (epg-configuration))) "2")) | ||
| 808 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp) | ||
| 809 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp-mime)) | ||
| 810 | |||
| 811 | (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-smime-todo () | ||
| 812 | "Passphrase caching does not work with S/MIME (and gpgsm)." | ||
| 813 | :expected-result :failed | ||
| 814 | (if with-smime | ||
| 815 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-smime) | ||
| 816 | (should nil))) | ||
| 817 | |||
| 818 | |||
| 819 | ;; Test truncation of question in y-or-n-p. | ||
| 820 | (defun mml-secure-select-preferred-keys-todo () | ||
| 821 | "Manual customization with truncated question." | ||
| 822 | (mml-secure-test-key-fixture | ||
| 823 | (lambda () | ||
| 824 | (mml-secure-test-en-decrypt | ||
| 825 | 'enc-pgp-mime | ||
| 826 | "jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de" | ||
| 827 | "no-exp@example.org" nil t nil nil t)))) | ||
| 828 | |||
| 829 | (defun mml-secure-select-preferred-keys-ok () | ||
| 830 | "Manual customization with entire question." | ||
| 831 | (mml-secure-test-fixture | ||
| 832 | (lambda () | ||
| 833 | (mml-secure-select-preferred-keys | ||
| 834 | (epg-make-context 'OpenPGP) | ||
| 835 | '("jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de") | ||
| 836 | 'encrypt)) | ||
| 837 | t)) | ||
| 838 | |||
| 839 | |||
| 840 | ;; ERT entry points | ||
| 841 | (defun mml-secure-run-tests () | ||
| 842 | "Run all tests with defaults." | ||
| 843 | (ert-run-tests-batch)) | ||
| 844 | |||
| 845 | (defun mml-secure-run-tests-with-gpg2 () | ||
| 846 | "Run all tests with gpg2 instead of gpg." | ||
| 847 | (let* ((epg-gpg-program "gpg2"); ~/local/gnupg-2.1.9/PLAY/inst/bin/gpg2 | ||
| 848 | (gpg-version (cdr (assq 'version (epg-configuration)))) | ||
| 849 | ;; Empty passphrases do not seem to work with gpgsm in 2.1.x: | ||
| 850 | ;; https://lists.gnupg.org/pipermail/gnupg-users/2015-October/054575.html | ||
| 851 | (with-smime (string< gpg-version "2.1"))) | ||
| 852 | (ert-run-tests-batch))) | ||
| 853 | |||
| 854 | (defun mml-secure-run-tests-without-smime () | ||
| 855 | "Skip S/MIME tests (as they require manual passphrase entry)." | ||
| 856 | (let ((with-smime nil)) | ||
| 857 | (ert-run-tests-batch))) | ||
| 858 | |||
| 859 | ;;; gnustest-mml-sec.el ends here | ||