aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJens Lechtenboerger2016-01-03 01:10:34 +0000
committerKatsumi Yamaoka2016-01-03 01:10:34 +0000
commit5213ded9aab68d83c306aa2f4880c8a1abd3608c (patch)
tree67bf83af8552079df3a2f559174a02e58fdd739e
parent43662a240b682de94299e797452ba56d01a04883 (diff)
downloademacs-5213ded9aab68d83c306aa2f4880c8a1abd3608c.tar.gz
emacs-5213ded9aab68d83c306aa2f4880c8a1abd3608c.zip
Refactor mml-smime.el, mml1991.el, mml2015.el
(Maybe this is the last merge from Gnus git to Emacs git) Cf. discussion on ding mailing list, messages in <http://thread.gmane.org/gmane.emacs.gnus.general/86228>. Common code from the three files mml-smime.el, mml1991.el, and mml2015.el is moved to mml-sec.el. Auxiliary functions are added to gnus-util.el. The code is supported by test cases with necessary test keys. Documentation in message.texi is updated. * doc/misc/message.texi (Security, Using S/MIME): Update for refactoring mml-smime.el, mml1991.el, mml2015.el. (Using OpenPGP): Rename from "Using PGP/MIME"; update contents. (Passphrase caching, Encrypt-to-self, Bcc Warning): New sections. * lisp/gnus/gnus-util.el (gnus-test-list, gnus-subsetp, gnus-setdiff): New functions. * lisp/gnus/mml-sec.el: Require gnus-util and epg. (epa--select-keys): Autoload. (mml-signencrypt-style-alist, mml-secure-cache-passphrase): Doc fix. (mml-secure-openpgp-signers): New user option; make mml1991-signers and mml2015-signers obsolete aliases to it. (mml-secure-smime-signers): New user option; make mml-smime-signers an obsolete alias to it. (mml-secure-openpgp-encrypt-to-self): New user option; make mml1991-encrypt-to-self and mml2015-encrypt-to-self obsolete aliases to it. (mml-secure-smime-encrypt-to-self): New user option; make mml-smime-encrypt-to-self an obsolete alias to it. (mml-secure-openpgp-sign-with-sender): New user option; make mml2015-sign-with-sender an obsolete alias to it. (mml-secure-smime-sign-with-sender): New user option; make mml-smime-sign-with-sender an obsolete alias to it. (mml-secure-openpgp-always-trust): New user option; make mml2015-always-trust an obsolete alias to it. (mml-secure-fail-when-key-problem, mml-secure-key-preferences): New user options. (mml-secure-cust-usage-lookup, mml-secure-cust-fpr-lookup) (mml-secure-cust-record-keys, mml-secure-cust-remove-keys) (mml-secure-add-secret-key-id, mml-secure-clear-secret-key-id-list) (mml-secure-cache-passphrase-p, mml-secure-cache-expiry-interval) (mml-secure-passphrase-callback, mml-secure-check-user-id) (mml-secure-secret-key-exists-p, mml-secure-check-sub-key) (mml-secure-find-usable-keys, mml-secure-select-preferred-keys) (mml-secure-fingerprint, mml-secure-filter-keys) (mml-secure-normalize-cust-name, mml-secure-select-keys) (mml-secure-select-keys-1, mml-secure-signer-names, mml-secure-signers) (mml-secure-self-recipients, mml-secure-recipients) (mml-secure-epg-encrypt, mml-secure-epg-sign): New functions. * lisp/gnus/mml-smime.el: Require epg; refactor declaration and autoloading of epg functions. (mml-smime-use): Doc fix. (mml-smime-cache-passphrase, mml-smime-passphrase-cache-expiry): Obsolete. (mml-smime-get-dns-cert, mml-smime-get-ldap-cert): Use format instead of gnus-format-message. (mml-smime-epg-secret-key-id-list): Remove variable. (mml-smime-epg-passphrase-callback, mml-smime-epg-find-usable-key) (mml-smime-epg-find-usable-secret-key): Remove functions. (mml-smime-epg-sign, mml-smime-epg-encrypt): Refactor. * lisp/gnus/mml1991.el (mml1991-cache-passphrase) (mml1991-passphrase-cache-expiry): Obsolete. (mml1991-epg-secret-key-id-list): Remove variable. (mml1991-epg-passphrase-callback, mml1991-epg-find-usable-key) (mml1991-epg-find-usable-secret-key): Remove functions. (mml1991-epg-sign, mml1991-epg-encrypt): Refactor. * lisp/gnus/mml2015.el (mml2015-cache-passphrase) (mml2015-passphrase-cache-expiry): Obsolete. (mml2015-epg-secret-key-id-list): Remove variable. (mml2015-epg-passphrase-callback, mml2015-epg-check-user-id) (mml2015-epg-check-sub-key, mml2015-epg-find-usable-key) (mml2015-epg-find-usable-secret-key): Remove functions. (mml2015-epg-decrypt, mml2015-epg-clear-decrypt, mml2015-epg-sign) (mml2015-epg-encrypt): Refactor.
-rw-r--r--doc/misc/message.texi195
-rw-r--r--lisp/gnus/gnus-util.el25
-rw-r--r--lisp/gnus/mml-sec.el579
-rw-r--r--lisp/gnus/mml-smime.el273
-rw-r--r--lisp/gnus/mml1991.el203
-rw-r--r--lisp/gnus/mml2015.el306
6 files changed, 897 insertions, 684 deletions
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index dbc77592a03..761fb772f46 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -938,16 +938,82 @@ Libidn} installed in order to use this functionality.
938@cindex encrypt 938@cindex encrypt
939@cindex secure 939@cindex secure
940 940
941Using the @acronym{MML} language, Message is able to create digitally 941By default, e-mails are transmitted without any protection around the
942signed and digitally encrypted messages. Message (or rather 942Internet, which implies that they can be read and changed by lots of
943@acronym{MML}) currently support @acronym{PGP} (RFC 1991), 943different parties. In particular, they are analyzed under bulk
944@acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}. 944surveillance, which violates basic human rights. To defend those
945rights, digital self-defense is necessary (in addition to legal
946changes), and encryption and digital signatures are powerful
947techniques for self-defense. In essence, encryption ensures that
948only the intended recipient will be able to read a message, while
949digital signatures make sure that modifications to messages can be
950detected by the recipient.
951
952Nowadays, there are two major incompatible e-mail encryption
953standards, namely @acronym{OpenPGP} and @acronym{S/MIME}. Both of
954these standards are implemented by the @uref{https://www.gnupg.org/,
955GNU Privacy Guard (GnuPG)}, which needs to be installed as external
956software in addition to GNU Emacs. Before you can start to encrypt,
957decrypt, and sign messages, you need to create a so-called key-pair,
958which consists of a private key and a public key. Your @emph{public} key
959(also known as @emph{certificate}, in particular with @acronym{S/MIME}), is
960used by others (a) to encrypt messages intended for you and (b) to verify
961digital signatures created by you. In contrast, you use your @emph{private}
962key (a) to decrypt messages and (b) to sign messages. (You may want to
963think of your public key as an open safe that you offer to others such
964that they can deposit messages and lock the door, while your private
965key corresponds to the opening combination for the safe.)
966
967Thus, you need to perform the following steps for e-mail encryption,
968typically outside Emacs. See, for example, the
969@uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy
970Handbook} for details covering the standard @acronym{OpenPGP} with
971@acronym{GnuPG}.
972@enumerate
973@item
974Install GnuPG.
975@item
976Create a key-pair for your own e-mail address.
977@item
978Distribute your public key, e.g., via upload to key servers.
979@item
980Import the public keys for the recipients to which you want to send
981encrypted e-mails.
982@end enumerate
983
984Whether to use the standard @acronym{OpenPGP} or @acronym{S/MIME} is
985beyond the scope of this documentation. Actually, you can use one
986standard for one set of recipients and the other standard for
987different recipients (depending their preferences or capabilities).
988
989In case you are not familiar with all those acronyms: The standard
990@acronym{OpenPGP} is also called @acronym{PGP} (Pretty Good Privacy).
991The command line tools offered by @acronym{GnuPG} for
992@acronym{OpenPGP} are called @command{gpg} and @command{gpg2}, while
993the one for @acronym{S/MIME} is called @command{gpgsm}. An
994alternative, but discouraged, tool for @acronym{S/MIME} is
995@command{openssl}. To make matters worse, e-mail messages can be
996formed in two different ways with @acronym{OpenPGP}, namely
997@acronym{PGP} (RFC 1991/4880) and @acronym{PGP/MIME} (RFC 2015/3156).
998
999The good news, however, is the following: In GNU Emacs, Message
1000supports all those variants, comes with reasonable defaults that can
1001be customized according to your needs, and invokes the proper command
1002line tools behind the scenes for encryption, decryption, as well as
1003creation and verification of digital signatures.
1004
1005Message uses the @acronym{MML} language for the creation of signed
1006and/or encrypted messages as explained in the following.
1007
945 1008
946@menu 1009@menu
947* Signing and encryption:: Signing and encrypting commands. 1010* Signing and encryption:: Signing and encrypting commands.
948* Using S/MIME:: Using S/MIME 1011* Using S/MIME:: Using S/MIME
949* Using PGP/MIME:: Using PGP/MIME 1012* Using OpenPGP:: Using OpenPGP
1013* Passphrase caching:: How to cache passphrases
950* PGP Compatibility:: Compatibility with older implementations 1014* PGP Compatibility:: Compatibility with older implementations
1015* Encrypt-to-self:: Reading your own encrypted messages
1016* Bcc Warning:: Do not use encryption with Bcc headers
951@end menu 1017@end menu
952 1018
953@node Signing and encryption 1019@node Signing and encryption
@@ -1041,11 +1107,45 @@ programs are required to make things work, and some small general hints.
1041@node Using S/MIME 1107@node Using S/MIME
1042@subsection Using S/MIME 1108@subsection Using S/MIME
1043 1109
1044@emph{Note!} This section assume you have a basic familiarity with 1110@acronym{S/MIME} requires an external implementation, such as
1045modern cryptography, @acronym{S/MIME}, various PKCS standards, OpenSSL and 1111@uref{https://www.gnupg.org/, GNU Privacy Guard} or
1046so on. 1112@uref{https://www.openssl.org/, OpenSSL}. The default Emacs interface
1113to the S/MIME implementation is EasyPG (@pxref{Top,,EasyPG Assistant
1114User's Manual, epa, EasyPG Assistant User's Manual}), which has been
1115included in Emacs since version 23 and which relies on the command
1116line tool @command{gpgsm} provided by @acronym{GnuPG}. That tool
1117implements certificate management, including certificate revocation
1118and expiry, while such tasks need to be performed manually, if OpenSSL
1119is used.
1120
1121The choice between EasyPG and OpenSSL is controlled by the variable
1122@code{mml-smime-use}, which needs to be set to the value @code{epg}
1123for EasyPG. Depending on your version of Emacs that value may be the
1124default; if not, you can either customize that variable or place the
1125following line in your @file{.emacs} file (that line needs to be
1126placed above other code related to message/gnus/encryption):
1127
1128@lisp
1129(require 'epg)
1130@end lisp
1131
1132Moreover, you may want to customize the variables
1133@code{mml-default-encrypt-method} and
1134@code{mml-default-sign-method} to the string @code{"smime"}.
1135
1136That's all if you want to use S/MIME with EasyPG, and that's the
1137recommended way of using S/MIME with Message.
1138
1139If you think about using OpenSSL instead of EasyPG, please read the
1140BUGS section in the manual for the @command{smime} command coming with
1141OpenSSL first. If you still want to use OpenSSL, the following
1142applies.
1143
1144@emph{Note!} The remainder of this section assumes you have a basic
1145familiarity with modern cryptography, @acronym{S/MIME}, various PKCS
1146standards, OpenSSL and so on.
1047 1147
1048The @acronym{S/MIME} support in Message (and @acronym{MML}) require 1148The @acronym{S/MIME} support in Message (and @acronym{MML}) can use
1049OpenSSL@. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt 1149OpenSSL@. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt
1050operations. OpenSSL can be found at @uref{http://www.openssl.org/}. 1150operations. OpenSSL can be found at @uref{http://www.openssl.org/}.
1051OpenSSL 0.9.6 and later should work. Version 0.9.5a cannot extract mail 1151OpenSSL 0.9.6 and later should work. Version 0.9.5a cannot extract mail
@@ -1101,26 +1201,44 @@ you use unencrypted keys (e.g., if they are on a secure storage, or if
1101you are on a secure single user machine) simply press @code{RET} at 1201you are on a secure single user machine) simply press @code{RET} at
1102the passphrase prompt. 1202the passphrase prompt.
1103 1203
1104@node Using PGP/MIME 1204@node Using OpenPGP
1105@subsection Using PGP/MIME 1205@subsection Using OpenPGP
1106 1206
1107@acronym{PGP/MIME} requires an external OpenPGP implementation, such 1207Use of OpenPGP requires an external software, such
1108as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP 1208as @uref{https://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP
1109implementations such as PGP 2.x and PGP 5.x are also supported. The 1209implementations such as PGP 2.x and PGP 5.x are also supported. The
1110default Emacs interface to the PGP implementation is EasyPG 1210default Emacs interface to the PGP implementation is EasyPG
1111(@pxref{Top,,EasyPG Assistant User's Manual, epa, EasyPG Assistant 1211(@pxref{Top,,EasyPG Assistant User's Manual, epa, EasyPG Assistant
1112User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and 1212User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and
1113Mailcrypt are also supported. @xref{PGP Compatibility}. 1213Mailcrypt are also supported. @xref{PGP Compatibility}.
1114 1214
1215As stated earlier, messages encrypted with OpenPGP can be formatted
1216according to two different standards, namely @acronym{PGP} or
1217@acronym{PGP/MIME}. The variables
1218@code{mml-default-encrypt-method} and
1219@code{mml-default-sign-method} determine which variant to prefer,
1220@acronym{PGP/MIME} by default.
1221
1222@node Passphrase caching
1223@subsection Passphrase caching
1224
1115@cindex gpg-agent 1225@cindex gpg-agent
1116Message internally calls GnuPG (the @command{gpg} command) to perform 1226Message with EasyPG internally calls GnuPG (the @command{gpg} or
1227@command{gpgsm} command) to perform
1117data encryption, and in certain cases (decrypting or signing for 1228data encryption, and in certain cases (decrypting or signing for
1118example), @command{gpg} requires user's passphrase. Currently the 1229example), @command{gpg}/@command{gpgsm} requires user's passphrase.
1119recommended way to supply your passphrase to @command{gpg} is to use the 1230Currently the recommended way to supply your passphrase is to use the
1120@command{gpg-agent} program. 1231@command{gpg-agent} program.
1121 1232
1122To use @command{gpg-agent} in Emacs, you need to run the following 1233In particular, the @command{gpg-agent} program supports passphrase
1123command from the shell before starting Emacs. 1234caching so that you do not need to enter your passphrase for every
1235decryption/sign operation. @xref{Agent Options, , , gnupg, Using the
1236GNU Privacy Guard}.
1237
1238How to use @command{gpg-agent} in Emacs depends on your version of
1239GnuPG. With GnuPG version 2.1, @command{gpg-agent} is started
1240automatically if necessary. With older versions you may need to run
1241the following command from the shell before starting Emacs.
1124 1242
1125@example 1243@example
1126eval `gpg-agent --daemon` 1244eval `gpg-agent --daemon`
@@ -1135,11 +1253,10 @@ GNU Privacy Guard}.
1135Once your @command{gpg-agent} is set up, it will ask you for a 1253Once your @command{gpg-agent} is set up, it will ask you for a
1136passphrase as needed for @command{gpg}. Under the X Window System, 1254passphrase as needed for @command{gpg}. Under the X Window System,
1137you will see a new passphrase input dialog appear. The dialog is 1255you will see a new passphrase input dialog appear. The dialog is
1138provided by PIN Entry (the @command{pinentry} command), and as of 1256provided by PIN Entry (the @command{pinentry} command), reasonably
1139version 0.7.2, @command{pinentry} cannot cooperate with Emacs on a 1257recent versions of which can also cooperate with Emacs on a text
1140single tty. So, if you are using a text console, you may need to put 1258console. If that does not work, you may need to put a passphrase into
1141a passphrase into gpg-agent's cache beforehand. The following command 1259gpg-agent's cache beforehand. The following command does the trick.
1142does the trick.
1143 1260
1144@example 1261@example
1145gpg --use-agent --sign < /dev/null > /dev/null 1262gpg --use-agent --sign < /dev/null > /dev/null
@@ -1181,6 +1298,38 @@ message that can be understood by PGP version 2.
1181(Refer to @uref{http://www.gnupg.org/gph/en/pgp2x.html} for more 1298(Refer to @uref{http://www.gnupg.org/gph/en/pgp2x.html} for more
1182information about the problem.) 1299information about the problem.)
1183 1300
1301@node Encrypt-to-self
1302@subsection Encrypt-to-self
1303
1304By default, messages are encrypted to all recipients (@code{To},
1305@code{Cc}, @code{Bcc} headers). Thus, you will not be able to decrypt
1306your own messages. To make sure that messages are also encrypted to
1307your own key(s), several alternative solutions exist:
1308@enumerate
1309@item
1310Use the @code{encrypt-to} option in the file @file{gpg.conf} (for
1311OpenPGP) or @file{gpgsm.conf} (for @acronym{S/MIME} with EasyPG).
1312@xref{Invoking GPG, , , gnupg, Using the GNU Privacy Guard}, or
1313@xref{Invoking GPGSM, , , gnupg, Using the GNU Privacy Guard}.
1314@item
1315Include your own e-mail address (for which you created a key-pair)
1316among the recipients.
1317@item
1318Customize the variable @code{mml-secure-openpgp-encrypt-to-self} (for
1319OpenPGP) or @code{mml-secure-smime-encrypt-to-self} (for
1320@acronym{S/MIME} with EasyPG).
1321@end enumerate
1322
1323@node Bcc Warning
1324@subsection Bcc Warning
1325
1326The @code{Bcc} header is meant to hide recipients of messages.
1327However, when encrypted messages are used, the e-mail addresses of all
1328@code{Bcc}-headers are given away to all recipients without
1329warning, which is a bug, see
1330@uref{https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718}.
1331
1332
1184@node Various Commands 1333@node Various Commands
1185@section Various Commands 1334@section Various Commands
1186 1335
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 82a267c9e11..31645fcd315 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1996,6 +1996,31 @@ to case differences."
1996 (defun gnus-timer--function (timer) 1996 (defun gnus-timer--function (timer)
1997 (elt timer 5))) 1997 (elt timer 5)))
1998 1998
1999(defun gnus-test-list (list predicate)
2000 "To each element of LIST apply PREDICATE.
2001Return nil if LIST is no list or is empty or some test returns nil;
2002otherwise, return t."
2003 (when (and list (listp list))
2004 (let ((result (mapcar predicate list)))
2005 (not (memq nil result)))))
2006
2007(defun gnus-subsetp (list1 list2)
2008 "Return t if LIST1 is a subset of LIST2.
2009Similar to `subsetp' but use member for element test so that this works for
2010lists of strings."
2011 (when (and (listp list1) (listp list2))
2012 (if list1
2013 (and (member (car list1) list2)
2014 (gnus-subsetp (cdr list1) list2))
2015 t)))
2016
2017(defun gnus-setdiff (list1 list2)
2018 "Return member-based set difference of LIST1 and LIST2."
2019 (when (and list1 (listp list1) (listp list2))
2020 (if (member (car list1) list2)
2021 (gnus-setdiff (cdr list1) list2)
2022 (cons (car list1) (gnus-setdiff (cdr list1) list2)))))
2023
1999(provide 'gnus-util) 2024(provide 'gnus-util)
2000 2025
2001;;; gnus-util.el ends here 2026;;; gnus-util.el ends here
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index e4c90956788..0a5f472079d 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -25,7 +25,9 @@
25 25
26(eval-when-compile (require 'cl)) 26(eval-when-compile (require 'cl))
27 27
28(autoload 'gnus-subsetp "gnus-util") 28(require 'gnus-util)
29(require 'epg)
30
29(autoload 'mail-strip-quoted-names "mail-utils") 31(autoload 'mail-strip-quoted-names "mail-utils")
30(autoload 'mml2015-sign "mml2015") 32(autoload 'mml2015-sign "mml2015")
31(autoload 'mml2015-encrypt "mml2015") 33(autoload 'mml2015-encrypt "mml2015")
@@ -40,6 +42,7 @@
40(autoload 'mml-smime-encrypt-query "mml-smime") 42(autoload 'mml-smime-encrypt-query "mml-smime")
41(autoload 'mml-smime-verify "mml-smime") 43(autoload 'mml-smime-verify "mml-smime")
42(autoload 'mml-smime-verify-test "mml-smime") 44(autoload 'mml-smime-verify-test "mml-smime")
45(autoload 'epa--select-keys "epa")
43 46
44(defvar mml-sign-alist 47(defvar mml-sign-alist
45 '(("smime" mml-smime-sign-buffer mml-smime-sign-query) 48 '(("smime" mml-smime-sign-buffer mml-smime-sign-query)
@@ -91,7 +94,7 @@ signs and encrypt the message in one step.
91 94
92Note that the output generated by using a `combined' mode is NOT 95Note that the output generated by using a `combined' mode is NOT
93understood by all PGP implementations, in particular PGP version 96understood by all PGP implementations, in particular PGP version
942 does not support it! See Info node `(message)Security' for 972 does not support it! See Info node `(message) Security' for
95details." 98details."
96 :version "22.1" 99 :version "22.1"
97 :group 'message 100 :group 'message
@@ -111,7 +114,9 @@ details."
111 (if (boundp 'password-cache) 114 (if (boundp 'password-cache)
112 password-cache 115 password-cache
113 t) 116 t)
114 "If t, cache passphrase." 117 "If t, cache OpenPGP or S/MIME passphrases inside Emacs.
118Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead.
119See Info node `(message) Security'."
115 :group 'message 120 :group 'message
116 :type 'boolean) 121 :type 'boolean)
117 122
@@ -125,6 +130,21 @@ Whether the passphrase is cached at all is controlled by
125 :group 'message 130 :group 'message
126 :type 'integer) 131 :type 'integer)
127 132
133(defcustom mml-secure-safe-bcc-list nil
134 "List of e-mail addresses that are safe to use in Bcc headers.
135EasyPG encrypts e-mails to Bcc addresses, and the encrypted e-mail
136by default identifies the used encryption keys, giving away the
137Bcc'ed identities. Clearly, this contradicts the original goal of
138*blind* copies.
139For an academic paper explaining the problem, see URL
140`http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'.
141Use this variable to specify e-mail addresses whose owners do not
142mind if they are identifiable as recipients. This may be useful if
143you use Bcc headers to encrypt e-mails to yourself."
144 :version "25.1"
145 :group 'message
146 :type '(repeat string))
147
128;;; Configuration/helper functions 148;;; Configuration/helper functions
129 149
130(defun mml-signencrypt-style (method &optional style) 150(defun mml-signencrypt-style (method &optional style)
@@ -275,6 +295,36 @@ Use METHOD if given. Else use `mml-secure-method' or
275 (interactive) 295 (interactive)
276 (mml-secure-part "smime")) 296 (mml-secure-part "smime"))
277 297
298(defun mml-secure-is-encrypted-p ()
299 "Check whether secure encrypt tag is present."
300 (save-excursion
301 (goto-char (point-min))
302 (re-search-forward
303 (concat "^" (regexp-quote mail-header-separator) "\n"
304 "<#secure[^>]+encrypt")
305 nil t)))
306
307(defun mml-secure-bcc-is-safe ()
308 "Check whether usage of Bcc is safe (or absent).
309Bcc usage is safe in two cases: first, if the current message does
310not contain an MML secure encrypt tag;
311second, if the Bcc addresses are a subset of `mml-secure-safe-bcc-list'.
312In all other cases, ask the user whether Bcc usage is safe.
313Raise error if user answers no.
314Note that this function does not produce a meaningful return value:
315either an error is raised or not."
316 (when (mml-secure-is-encrypted-p)
317 (let ((bcc (mail-strip-quoted-names (message-fetch-field "bcc"))))
318 (when bcc
319 (let ((bcc-list (mapcar #'cadr
320 (mail-extract-address-components bcc t))))
321 (unless (gnus-subsetp bcc-list mml-secure-safe-bcc-list)
322 (unless (yes-or-no-p "Message for encryption contains Bcc header.\
323 This may give away all Bcc'ed identities to all recipients.\
324 Are you sure that this is safe?\
325 (Customize `mml-secure-safe-bcc-list' to avoid this warning.) ")
326 (error "Aborted"))))))))
327
278;; defuns that add the proper <#secure ...> tag to the top of the message body 328;; defuns that add the proper <#secure ...> tag to the top of the message body
279(defun mml-secure-message (method &optional modesym) 329(defun mml-secure-message (method &optional modesym)
280 (let ((mode (prin1-to-string modesym)) 330 (let ((mode (prin1-to-string modesym))
@@ -380,6 +430,529 @@ If called with a prefix argument, only encrypt (do NOT sign)."
380 (interactive "P") 430 (interactive "P")
381 (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) 431 (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
382 432
433;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el
434
435(define-obsolete-variable-alias 'mml1991-signers 'mml-secure-openpgp-signers)
436(define-obsolete-variable-alias 'mml2015-signers 'mml-secure-openpgp-signers)
437(defcustom mml-secure-openpgp-signers nil
438 "A list of your own key ID(s) which will be used to sign OpenPGP messages.
439If set, it is added to the setting of `mml-secure-openpgp-sign-with-sender'."
440 :group 'mime-security
441 :type '(repeat (string :tag "Key ID")))
442
443(define-obsolete-variable-alias 'mml-smime-signers 'mml-secure-smime-signers)
444(defcustom mml-secure-smime-signers nil
445 "A list of your own key ID(s) which will be used to sign S/MIME messages.
446If set, it is added to the setting of `mml-secure-smime-sign-with-sender'."
447 :group 'mime-security
448 :type '(repeat (string :tag "Key ID")))
449
450(define-obsolete-variable-alias
451 'mml1991-encrypt-to-self 'mml-secure-openpgp-encrypt-to-self)
452(define-obsolete-variable-alias
453 'mml2015-encrypt-to-self 'mml-secure-openpgp-encrypt-to-self)
454(defcustom mml-secure-openpgp-encrypt-to-self nil
455 "List of own key ID(s) or t; determines additional recipients with OpenPGP.
456If t, also encrypt to key for message sender; if list, encrypt to those keys.
457With this variable, you can ensure that you can decrypt your own messages.
458Alternatives to this variable include Bcc'ing the message to yourself or
459using the encrypt-to or hidden-encrypt-to option in gpg.conf (see man gpg(1)).
460Note that this variable and the encrypt-to option give away your identity
461for *every* encryption without warning, which is not what you want if you are
462using, e.g., remailers.
463Also, use of Bcc gives away your identity for *every* encryption without
464warning, which is a bug, see:
465https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718"
466 :group 'mime-security
467 :type '(choice (const :tag "None" nil)
468 (const :tag "From address" t)
469 (repeat (string :tag "Key ID"))))
470
471(define-obsolete-variable-alias
472 'mml-smime-encrypt-to-self 'mml-secure-smime-encrypt-to-self)
473(defcustom mml-secure-smime-encrypt-to-self nil
474 "List of own key ID(s) or t; determines additional recipients with S/MIME.
475If t, also encrypt to key for message sender; if list, encrypt to those keys.
476With this variable, you can ensure that you can decrypt your own messages.
477Alternatives to this variable include Bcc'ing the message to yourself or
478using the encrypt-to option in gpgsm.conf (see man gpgsm(1)).
479Note that this variable and the encrypt-to option give away your identity
480for *every* encryption without warning, which is not what you want if you are
481using, e.g., remailers.
482Also, use of Bcc gives away your identity for *every* encryption without
483warning, which is a bug, see:
484https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718"
485 :group 'mime-security
486 :type '(choice (const :tag "None" nil)
487 (const :tag "From address" t)
488 (repeat (string :tag "Key ID"))))
489
490(define-obsolete-variable-alias
491 'mml2015-sign-with-sender 'mml-secure-openpgp-sign-with-sender)
492;mml1991-sign-with-sender did never exist.
493(defcustom mml-secure-openpgp-sign-with-sender nil
494 "If t, use message sender to find an OpenPGP key to sign with."
495 :group 'mime-security
496 :type 'boolean)
497
498(define-obsolete-variable-alias
499 'mml-smime-sign-with-sender 'mml-secure-smime-sign-with-sender)
500(defcustom mml-secure-smime-sign-with-sender nil
501 "If t, use message sender to find an S/MIME key to sign with."
502 :group 'mime-security
503 :type 'boolean)
504
505(define-obsolete-variable-alias
506 'mml2015-always-trust 'mml-secure-openpgp-always-trust)
507;mml1991-always-trust did never exist.
508(defcustom mml-secure-openpgp-always-trust t
509 "If t, skip key validation of GnuPG on encryption."
510 :group 'mime-security
511 :type 'boolean)
512
513(defcustom mml-secure-fail-when-key-problem nil
514 "If t, raise an error if some key is missing or several keys exist.
515Otherwise, ask the user."
516 :group 'mime-security
517 :type 'boolean)
518
519(defcustom mml-secure-key-preferences
520 '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))
521 "Protocol- and usage-specific fingerprints of preferred keys.
522This variable is only relevant if a recipient owns multiple key pairs (for
523encryption) or you own multiple key pairs (for signing). In such cases,
524you will be asked which key(s) should be used, and your choice can be
525customized in this variable."
526 :group 'mime-security
527 :type '(alist :key-type (symbol :tag "Protocol") :value-type
528 (alist :key-type (symbol :tag "Usage") :value-type
529 (alist :key-type (string :tag "Name") :value-type
530 (repeat (string :tag "Fingerprint"))))))
531
532(defun mml-secure-cust-usage-lookup (context usage)
533 "Return preferences for CONTEXT and USAGE."
534 (let* ((protocol (epg-context-protocol context))
535 (protocol-prefs (cdr (assoc protocol mml-secure-key-preferences))))
536 (assoc usage protocol-prefs)))
537
538(defun mml-secure-cust-fpr-lookup (context usage name)
539 "Return fingerprints of preferred keys for CONTEXT, USAGE, and NAME."
540 (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage))
541 (fprs (assoc name (cdr usage-prefs))))
542 (when fprs
543 (cdr fprs))))
544
545(defun mml-secure-cust-record-keys (context usage name keys &optional save)
546 "For CONTEXT, USAGE, and NAME record fingerprint(s) of KEYS.
547If optional SAVE is not nil, save customized fingerprints.
548Return keys."
549 (assert keys)
550 (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage))
551 (curr-fprs (cdr (assoc name (cdr usage-prefs))))
552 (key-fprs (mapcar 'mml-secure-fingerprint keys))
553 (new-fprs (gnus-union curr-fprs key-fprs :test 'equal)))
554 (if curr-fprs
555 (setcdr (assoc name (cdr usage-prefs)) new-fprs)
556 (setcdr usage-prefs (cons (cons name new-fprs) (cdr usage-prefs))))
557 (when save
558 (customize-save-variable
559 'mml-secure-key-preferences mml-secure-key-preferences))
560 keys))
561
562(defun mml-secure-cust-remove-keys (context usage name)
563 "Remove keys for CONTEXT, USAGE, and NAME.
564Return t if a customization for NAME was present (and has been removed)."
565 (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage))
566 (current (assoc name usage-prefs)))
567 (when current
568 (setcdr usage-prefs (remove current (cdr usage-prefs)))
569 t)))
570
571(defvar mml-secure-secret-key-id-list nil)
572
573(defun mml-secure-add-secret-key-id (key-id)
574 "Record KEY-ID in list of secret keys."
575 (add-to-list 'mml-secure-secret-key-id-list key-id))
576
577(defun mml-secure-clear-secret-key-id-list ()
578 "Remove passwords from cache and clear list of secret keys."
579 ;; Loosely based on code inside mml2015-epg-encrypt,
580 ;; mml2015-epg-clear-decrypt, and mml2015-epg-decrypt
581 (dolist (key-id mml-secure-secret-key-id-list nil)
582 (password-cache-remove key-id))
583 (setq mml-secure-secret-key-id-list nil))
584
585(defvar mml1991-cache-passphrase)
586(defvar mml1991-passphrase-cache-expiry)
587
588(defun mml-secure-cache-passphrase-p (protocol)
589 "Return t if OpenPGP or S/MIME passphrases should be cached for PROTOCOL.
590Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead."
591 (or (and (eq 'OpenPGP protocol)
592 (or mml-secure-cache-passphrase
593 (and (boundp 'mml2015-cache-passphrase)
594 mml2015-cache-passphrase)
595 (and (boundp 'mml1991-cache-passphrase)
596 mml1991-cache-passphrase)))
597 (and (eq 'CMS protocol)
598 (or mml-secure-cache-passphrase
599 (and (boundp 'mml-smime-cache-passphrase)
600 mml-smime-cache-passphrase)))))
601
602(defun mml-secure-cache-expiry-interval (protocol)
603 "Return time in seconds to cache passphrases for PROTOCOL.
604Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead."
605 (or (and (eq 'OpenPGP protocol)
606 (or (and (boundp 'mml2015-passphrase-cache-expiry)
607 mml2015-passphrase-cache-expiry)
608 (and (boundp 'mml1991-passphrase-cache-expiry)
609 mml1991-passphrase-cache-expiry)
610 mml-secure-passphrase-cache-expiry))
611 (and (eq 'CMS protocol)
612 (or (and (boundp 'mml-smime-passphrase-cache-expiry)
613 mml-smime-passphrase-cache-expiry)
614 mml-secure-passphrase-cache-expiry))))
615
616(defun mml-secure-passphrase-callback (context key-id standard)
617 "Ask for passphrase in CONTEXT for KEY-ID for STANDARD.
618The passphrase is read and cached."
619 ;; Based on mml2015-epg-passphrase-callback.
620 (if (eq key-id 'SYM)
621 (epg-passphrase-callback-function context key-id nil)
622 (let* ((password-cache-key-id
623 (if (eq key-id 'PIN)
624 "PIN"
625 key-id))
626 (entry (assoc key-id epg-user-id-alist))
627 (passphrase
628 (password-read
629 (if (eq key-id 'PIN)
630 "Passphrase for PIN: "
631 (if entry
632 (format "Passphrase for %s %s: " key-id (cdr entry))
633 (format "Passphrase for %s: " key-id)))
634 ;; TODO: With mml-smime.el, password-cache-key-id is not passed
635 ;; as argument to password-read.
636 ;; Is that on purpose? If so, the following needs to be placed
637 ;; inside an if statement.
638 password-cache-key-id)))
639 (when passphrase
640 (let ((password-cache-expiry (mml-secure-cache-expiry-interval
641 (epg-context-protocol context))))
642 (password-cache-add password-cache-key-id passphrase))
643 (mml-secure-add-secret-key-id password-cache-key-id)
644 (copy-sequence passphrase)))))
645
646(defun mml-secure-check-user-id (key recipient)
647 "Check whether KEY has a non-revoked, non-expired UID for RECIPIENT."
648 ;; Based on mml2015-epg-check-user-id.
649 (let ((uids (epg-key-user-id-list key)))
650 (catch 'break
651 (dolist (uid uids nil)
652 (if (and (stringp (epg-user-id-string uid))
653 (equal (car (mail-header-parse-address
654 (epg-user-id-string uid)))
655 (car (mail-header-parse-address
656 recipient)))
657 (not (memq (epg-user-id-validity uid)
658 '(revoked expired))))
659 (throw 'break t))))))
660
661(defun mml-secure-secret-key-exists-p (context subkey)
662 "Return t if keyring for CONTEXT contains secret key for public SUBKEY."
663 (let* ((fpr (epg-sub-key-fingerprint subkey))
664 (candidates (epg-list-keys context fpr 'secret))
665 (candno (length candidates)))
666 ;; If two or more subkeys with the same fingerprint exist, something is
667 ;; terribly wrong.
668 (when (>= candno 2)
669 (error "Found %d secret keys with same fingerprint %s" candno fpr))
670 (= 1 candno)))
671
672(defun mml-secure-check-sub-key (context key usage &optional fingerprint)
673 "Check whether in CONTEXT the public KEY has a usable subkey for USAGE.
674This is the case if KEY is not disabled, and there is a subkey for
675USAGE that is neither revoked nor expired. Additionally, if optional
676FINGERPRINT is present and if it is not the primary key's fingerprint, then
677the returned subkey must have that FINGERPRINT. FINGERPRINT must consist of
678hexadecimal digits only (no leading \"0x\" allowed).
679If USAGE is not `encrypt', then additionally an appropriate secret key must
680be present in the keyring."
681 ;; Based on mml2015-epg-check-sub-key, extended by
682 ;; - check for secret keys if usage is not 'encrypt and
683 ;; - check for new argument FINGERPRINT.
684 (let* ((subkeys (epg-key-sub-key-list key))
685 (primary (car subkeys))
686 (fpr (epg-sub-key-fingerprint primary)))
687 ;; The primary key will be marked as disabled, when the entire
688 ;; key is disabled (see 12 Field, Format of colon listings, in
689 ;; gnupg/doc/DETAILS)
690 (unless (memq 'disabled (epg-sub-key-capability primary))
691 (catch 'break
692 (dolist (subkey subkeys nil)
693 (if (and (memq usage (epg-sub-key-capability subkey))
694 (not (memq (epg-sub-key-validity subkey)
695 '(revoked expired)))
696 (or (eq 'encrypt usage) ; Encryption works with public key.
697 ;; In contrast, signing requires secret key.
698 (mml-secure-secret-key-exists-p context subkey))
699 (or (not fingerprint)
700 (gnus-string-match-p (concat fingerprint "$") fpr)
701 (gnus-string-match-p (concat fingerprint "$")
702 (epg-sub-key-fingerprint subkey))))
703 (throw 'break t)))))))
704
705(defun mml-secure-find-usable-keys (context name usage &optional justone)
706 "In CONTEXT return a list of keys for NAME and USAGE.
707If USAGE is `encrypt' public keys are returned, otherwise secret ones.
708Only non-revoked and non-expired keys are returned whose primary key is
709not disabled.
710NAME can be an e-mail address or a key ID.
711If NAME just consists of hexadecimal digits (possibly prefixed by \"0x\"), it
712is treated as key ID for which at most one key must exist in the keyring.
713Otherwise, NAME is treated as user ID, for which no keys are returned if it
714is expired or revoked.
715If optional JUSTONE is not nil, return the first key instead of a list."
716 (let* ((keys (epg-list-keys context name))
717 (iskeyid (string-match "\\(0x\\)?\\([0-9a-fA-F]\\{8,\\}\\)" name))
718 (fingerprint (match-string 2 name))
719 result)
720 (when (and iskeyid (>= (length keys) 2))
721 (error
722 "Name %s (for %s) looks like a key ID but multiple keys found"
723 name usage))
724 (catch 'break
725 (dolist (key keys result)
726 (if (and (or iskeyid
727 (mml-secure-check-user-id key name))
728 (mml-secure-check-sub-key context key usage fingerprint))
729 (if justone
730 (throw 'break key)
731 (push key result)))))))
732
733(defun mml-secure-select-preferred-keys (context names usage)
734 "Return list of preferred keys in CONTEXT for NAMES and USAGE.
735This inspects the keyrings to find keys for each name in NAMES. If several
736keys are found for a name, `mml-secure-select-keys' is used to look for
737customized preferences or have the user select preferable ones.
738When `mml-secure-fail-when-key-problem' is t, fail with an error in
739case of missing, outdated, or multiple keys."
740 ;; Loosely based on code appearing inside mml2015-epg-sign and
741 ;; mml2015-epg-encrypt.
742 (apply
743 #'nconc
744 (mapcar
745 (lambda (name)
746 (let* ((keys (mml-secure-find-usable-keys context name usage))
747 (keyno (length keys)))
748 (cond ((= 0 keyno)
749 (when (or mml-secure-fail-when-key-problem
750 (not (y-or-n-p
751 (format "No %s key for %s; skip it? "
752 usage name))))
753 (error "No %s key for %s" usage name)))
754 ((= 1 keyno) keys)
755 (t (mml-secure-select-keys context name keys usage)))))
756 names)))
757
758(defun mml-secure-fingerprint (key)
759 "Return fingerprint for public KEY."
760 (epg-sub-key-fingerprint (car (epg-key-sub-key-list key))))
761
762(defun mml-secure-filter-keys (keys fprs)
763 "Filter KEYS to subset with fingerprints in FPRS."
764 (when keys
765 (if (member (mml-secure-fingerprint (car keys)) fprs)
766 (cons (car keys) (mml-secure-filter-keys (cdr keys) fprs))
767 (mml-secure-filter-keys (cdr keys) fprs))))
768
769(defun mml-secure-normalize-cust-name (name)
770 "Normalize NAME to be used for customization.
771Currently, remove ankle brackets."
772 (if (string-match "^<\\(.*\\)>$" name)
773 (match-string 1 name)
774 name))
775
776(defun mml-secure-select-keys (context name keys usage)
777 "In CONTEXT for NAME select among KEYS for USAGE.
778KEYS should be a list with multiple entries.
779NAME is normalized first as customized keys are inspected.
780When `mml-secure-fail-when-key-problem' is t, fail with an error in case of
781outdated or multiple keys."
782 (let* ((nname (mml-secure-normalize-cust-name name))
783 (fprs (mml-secure-cust-fpr-lookup context usage nname))
784 (usable-fprs (mapcar 'mml-secure-fingerprint keys)))
785 (if fprs
786 (if (gnus-subsetp fprs usable-fprs)
787 (mml-secure-filter-keys keys fprs)
788 (mml-secure-cust-remove-keys context usage nname)
789 (let ((diff (gnus-setdiff fprs usable-fprs)))
790 (if mml-secure-fail-when-key-problem
791 (error "Customization of %s keys for %s outdated" usage nname)
792 (mml-secure-select-keys-1
793 context nname keys usage (format "\
794Customized keys
795 (%s)
796for %s not available any more.
797Select anew. "
798 diff nname)))))
799 (if mml-secure-fail-when-key-problem
800 (error "Multiple %s keys for %s" usage nname)
801 (mml-secure-select-keys-1
802 context nname keys usage (format "\
803Multiple %s keys for:
804 %s
805Select preferred one(s). "
806 usage nname))))))
807
808(defun mml-secure-select-keys-1 (context name keys usage message)
809 "In CONTEXT for NAME let user select among KEYS for USAGE, showing MESSAGE.
810Return selected keys."
811 (let* ((selected (epa--select-keys message keys))
812 (selno (length selected))
813 ;; TODO: y-or-n-p does not always resize the echo area but may
814 ;; truncate the message. Why? The following does not help.
815 ;; yes-or-no-p shows full message, though.
816 (message-truncate-lines nil))
817 (if selected
818 (if (y-or-n-p
819 (format "%d %s key(s) selected. Store for %s? "
820 selno usage name))
821 (mml-secure-cust-record-keys context usage name selected 'save)
822 selected)
823 (unless (y-or-n-p
824 (format "No %s key for %s; skip it? " usage name))
825 (error "No %s key for %s" usage name)))))
826
827(defun mml-secure-signer-names (protocol sender)
828 "Determine signer names for PROTOCOL and message from SENDER.
829Returned names may be e-mail addresses or key IDs and are determined based
830on `mml-secure-openpgp-signers' and `mml-secure-openpgp-sign-with-sender' with
831OpenPGP or `mml-secure-smime-signers' and `mml-secure-smime-sign-with-sender'
832with S/MIME."
833 (if (eq 'OpenPGP protocol)
834 (append mml-secure-openpgp-signers
835 (if (and mml-secure-openpgp-sign-with-sender sender)
836 (list (concat "<" sender ">"))))
837 (append mml-secure-smime-signers
838 (if (and mml-secure-smime-sign-with-sender sender)
839 (list (concat "<" sender ">"))))))
840
841(defun mml-secure-signers (context signer-names)
842 "Determine signing keys in CONTEXT from SIGNER-NAMES.
843If `mm-sign-option' is `guided', the user is asked to choose.
844Otherwise, `mml-secure-select-preferred-keys' is used."
845 ;; Based on code appearing inside mml2015-epg-sign and
846 ;; mml2015-epg-encrypt.
847 (if (eq mm-sign-option 'guided)
848 (epa-select-keys context "\
849Select keys for signing.
850If no one is selected, default secret key is used. "
851 signer-names t)
852 (mml-secure-select-preferred-keys context signer-names 'sign)))
853
854(defun mml-secure-self-recipients (protocol sender)
855 "Determine additional recipients based on encrypt-to-self variables.
856PROTOCOL specifies OpenPGP or S/MIME for a message from SENDER."
857 (let ((encrypt-to-self
858 (if (eq 'OpenPGP protocol)
859 mml-secure-openpgp-encrypt-to-self
860 mml-secure-smime-encrypt-to-self)))
861 (when encrypt-to-self
862 (if (listp encrypt-to-self)
863 encrypt-to-self
864 (list sender)))))
865
866(defun mml-secure-recipients (protocol context config sender)
867 "Determine encryption recipients.
868PROTOCOL specifies OpenPGP or S/MIME with matching CONTEXT and CONFIG
869for a message from SENDER."
870 ;; Based on code appearing inside mml2015-epg-encrypt.
871 (let ((recipients
872 (apply #'nconc
873 (mapcar
874 (lambda (recipient)
875 (or (epg-expand-group config recipient)
876 (list (concat "<" recipient ">"))))
877 (split-string
878 (or (message-options-get 'message-recipients)
879 (message-options-set 'message-recipients
880 (read-string "Recipients: ")))
881 "[ \f\t\n\r\v,]+")))))
882 (nconc recipients (mml-secure-self-recipients protocol sender))
883 (if (eq mm-encrypt-option 'guided)
884 (setq recipients
885 (epa-select-keys context "\
886Select recipients for encryption.
887If no one is selected, symmetric encryption will be performed. "
888 recipients))
889 (setq recipients
890 (mml-secure-select-preferred-keys context recipients 'encrypt))
891 (unless recipients
892 (error "No recipient specified")))
893 recipients))
894
895(defun mml-secure-epg-encrypt (protocol cont &optional sign)
896 ;; Based on code appearing inside mml2015-epg-encrypt.
897 (let* ((context (epg-make-context protocol))
898 (config (epg-configuration))
899 (sender (message-options-get 'message-sender))
900 (recipients (mml-secure-recipients protocol context config sender))
901 (signer-names (mml-secure-signer-names protocol sender))
902 cipher signers)
903 (when sign
904 (setq signers (mml-secure-signers context signer-names))
905 (epg-context-set-signers context signers))
906 (when (eq 'OpenPGP protocol)
907 (epg-context-set-armor context t)
908 (epg-context-set-textmode context t))
909 (when (mml-secure-cache-passphrase-p protocol)
910 (epg-context-set-passphrase-callback
911 context
912 (cons 'mml-secure-passphrase-callback protocol)))
913 (condition-case error
914 (setq cipher
915 (if (eq 'OpenPGP protocol)
916 (epg-encrypt-string context (buffer-string) recipients sign
917 mml-secure-openpgp-always-trust)
918 (epg-encrypt-string context (buffer-string) recipients))
919 mml-secure-secret-key-id-list nil)
920 (error
921 (mml-secure-clear-secret-key-id-list)
922 (signal (car error) (cdr error))))
923 cipher))
924
925(defun mml-secure-epg-sign (protocol mode)
926 ;; Based on code appearing inside mml2015-epg-sign.
927 (let* ((context (epg-make-context protocol))
928 (sender (message-options-get 'message-sender))
929 (signer-names (mml-secure-signer-names protocol sender))
930 (signers (mml-secure-signers context signer-names))
931 signature micalg)
932 (when (eq 'OpenPGP protocol)
933 (epg-context-set-armor context t)
934 (epg-context-set-textmode context t))
935 (epg-context-set-signers context signers)
936 (when (mml-secure-cache-passphrase-p protocol)
937 (epg-context-set-passphrase-callback
938 context
939 (cons 'mml-secure-passphrase-callback protocol)))
940 (condition-case error
941 (setq signature
942 (if (eq 'OpenPGP protocol)
943 (epg-sign-string context (buffer-string) mode)
944 (epg-sign-string context
945 (mm-replace-in-string (buffer-string)
946 "\n" "\r\n") t))
947 mml-secure-secret-key-id-list nil)
948 (error
949 (mml-secure-clear-secret-key-id-list)
950 (signal (car error) (cdr error))))
951 (if (epg-context-result-for context 'sign)
952 (setq micalg (epg-new-signature-digest-algorithm
953 (car (epg-context-result-for context 'sign)))))
954 (cons signature micalg)))
955
383(provide 'mml-sec) 956(provide 'mml-sec)
384 957
385;;; mml-sec.el ends here 958;;; mml-sec.el ends here
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index b19c9e89ba9..a40595ecbd5 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -32,9 +32,17 @@
32(autoload 'message-narrow-to-headers "message") 32(autoload 'message-narrow-to-headers "message")
33(autoload 'message-fetch-field "message") 33(autoload 'message-fetch-field "message")
34 34
35;; Prefer epg over openssl if it is available as epg uses GnuPG's gpgsm,
36;; which features full-fledged certificate management, while openssl requires
37;; major manual efforts for certificate revocation and expiry and has bugs
38;; as documented under man smime(1).
39(ignore-errors (require 'epg))
40
35(defcustom mml-smime-use (if (featurep 'epg) 'epg 'openssl) 41(defcustom mml-smime-use (if (featurep 'epg) 'epg 'openssl)
36 "Whether to use OpenSSL or EPG to decrypt S/MIME messages. 42 "Whether to use OpenSSL or EasyPG (EPG) to handle S/MIME messages.
37Defaults to EPG if it's loaded." 43Defaults to EPG if it's available.
44If you think about using OpenSSL, please read the BUGS section in the manual
45for the `smime' command coming with OpenSSL first. EasyPG is recommended."
38 :group 'mime-security 46 :group 'mime-security
39 :type '(choice (const :tag "EPG" epg) 47 :type '(choice (const :tag "EPG" epg)
40 (const :tag "OpenSSL" openssl))) 48 (const :tag "OpenSSL" openssl)))
@@ -57,6 +65,9 @@ Defaults to EPG if it's loaded."
57 "If t, cache passphrase." 65 "If t, cache passphrase."
58 :group 'mime-security 66 :group 'mime-security
59 :type 'boolean) 67 :type 'boolean)
68(make-obsolete-variable 'mml-smime-cache-passphrase
69 'mml-secure-cache-passphrase
70 "25.1")
60 71
61(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry 72(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
62 "How many seconds the passphrase is cached. 73 "How many seconds the passphrase is cached.
@@ -64,6 +75,9 @@ Whether the passphrase is cached at all is controlled by
64`mml-smime-cache-passphrase'." 75`mml-smime-cache-passphrase'."
65 :group 'mime-security 76 :group 'mime-security
66 :type 'integer) 77 :type 'integer)
78(make-obsolete-variable 'mml-smime-passphrase-cache-expiry
79 'mml-secure-passphrase-cache-expiry
80 "25.1")
67 81
68(defcustom mml-smime-signers nil 82(defcustom mml-smime-signers nil
69 "A list of your own key ID which will be used to sign a message." 83 "A list of your own key ID which will be used to sign a message."
@@ -202,7 +216,7 @@ Whether the passphrase is cached at all is controlled by
202 ""))))) 216 "")))))
203 (if (setq cert (smime-cert-by-dns who)) 217 (if (setq cert (smime-cert-by-dns who))
204 (setq result (list 'certfile (buffer-name cert))) 218 (setq result (list 'certfile (buffer-name cert)))
205 (setq bad (gnus-format-message "`%s' not found. " who)))) 219 (setq bad (format "`%s' not found. " who))))
206 (quit)) 220 (quit))
207 result)) 221 result))
208 222
@@ -221,7 +235,7 @@ Whether the passphrase is cached at all is controlled by
221 ""))))) 235 "")))))
222 (if (setq cert (smime-cert-by-ldap who)) 236 (if (setq cert (smime-cert-by-ldap who))
223 (setq result (list 'certfile (buffer-name cert))) 237 (setq result (list 'certfile (buffer-name cert)))
224 (setq bad (gnus-format-message "`%s' not found. " who)))) 238 (setq bad (format "`%s' not found. " who))))
225 (quit)) 239 (quit))
226 result)) 240 result))
227 241
@@ -317,82 +331,28 @@ Whether the passphrase is cached at all is controlled by
317(defvar inhibit-redisplay) 331(defvar inhibit-redisplay)
318(defvar password-cache-expiry) 332(defvar password-cache-expiry)
319 333
320(autoload 'epg-make-context "epg") 334(eval-when-compile
321(autoload 'epg-passphrase-callback-function "epg") 335 (autoload 'epg-make-context "epg")
322(declare-function epg-context-set-signers "epg" (context signers)) 336 (autoload 'epg-context-set-armor "epg")
323(declare-function epg-context-result-for "epg" (context name)) 337 (autoload 'epg-context-set-signers "epg")
324(declare-function epg-new-signature-digest-algorithm "epg" (cl-x) t) 338 (autoload 'epg-context-result-for "epg")
325(declare-function epg-verify-result-to-string "epg" (verify-result)) 339 (autoload 'epg-new-signature-digest-algorithm "epg")
326(declare-function epg-list-keys "epg" (context &optional name mode)) 340 (autoload 'epg-verify-result-to-string "epg")
327(declare-function epg-verify-string "epg" 341 (autoload 'epg-list-keys "epg")
328 (context signature &optional signed-text)) 342 (autoload 'epg-decrypt-string "epg")
329(declare-function epg-sign-string "epg" (context plain &optional mode)) 343 (autoload 'epg-verify-string "epg")
330(declare-function epg-encrypt-string "epg" 344 (autoload 'epg-sign-string "epg")
331 (context plain recipients &optional sign always-trust)) 345 (autoload 'epg-encrypt-string "epg")
332(declare-function epg-context-set-passphrase-callback "epg" 346 (autoload 'epg-passphrase-callback-function "epg")
333 (context passphrase-callback)) 347 (autoload 'epg-context-set-passphrase-callback "epg")
334(declare-function epg-sub-key-fingerprint "epg" (cl-x) t) 348 (autoload 'epg-sub-key-fingerprint "epg")
335(declare-function epg-configuration "epg-config" ()) 349 (autoload 'epg-configuration "epg-config")
336(declare-function epg-expand-group "epg-config" (config group)) 350 (autoload 'epg-expand-group "epg-config")
337(declare-function epa-select-keys "epa" 351 (autoload 'epa-select-keys "epa"))
338 (context prompt &optional names secret)) 352
339 353(declare-function epg-key-sub-key-list "ext:epg" (key))
340(defvar mml-smime-epg-secret-key-id-list nil) 354(declare-function epg-sub-key-capability "ext:epg" (sub-key))
341 355(declare-function epg-sub-key-validity "ext:epg" (sub-key))
342(defun mml-smime-epg-passphrase-callback (context key-id ignore)
343 (if (eq key-id 'SYM)
344 (epg-passphrase-callback-function context key-id nil)
345 (let* (entry
346 (passphrase
347 (password-read
348 (if (eq key-id 'PIN)
349 "Passphrase for PIN: "
350 (if (setq entry (assoc key-id epg-user-id-alist))
351 (format "Passphrase for %s %s: " key-id (cdr entry))
352 (format "Passphrase for %s: " key-id)))
353 (if (eq key-id 'PIN)
354 "PIN"
355 key-id))))
356 (when passphrase
357 (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
358 (password-cache-add key-id passphrase))
359 (setq mml-smime-epg-secret-key-id-list
360 (cons key-id mml-smime-epg-secret-key-id-list))
361 (copy-sequence passphrase)))))
362
363(declare-function epg-key-sub-key-list "epg" (key) t)
364(declare-function epg-sub-key-capability "epg" (sub-key) t)
365(declare-function epg-sub-key-validity "epg" (sub-key) t)
366
367(defun mml-smime-epg-find-usable-key (keys usage)
368 (catch 'found
369 (while keys
370 (let ((pointer (epg-key-sub-key-list (car keys))))
371 (while pointer
372 (if (and (memq usage (epg-sub-key-capability (car pointer)))
373 (not (memq (epg-sub-key-validity (car pointer))
374 '(revoked expired))))
375 (throw 'found (car keys)))
376 (setq pointer (cdr pointer))))
377 (setq keys (cdr keys)))))
378
379;; XXX: since gpg --list-secret-keys does not return validity of each
380;; key, `mml-smime-epg-find-usable-key' defined above is not enough for
381;; secret keys. The function `mml-smime-epg-find-usable-secret-key'
382;; below looks at appropriate public keys to check usability.
383(defun mml-smime-epg-find-usable-secret-key (context name usage)
384 (let ((secret-keys (epg-list-keys context name t))
385 secret-key)
386 (while (and (not secret-key) secret-keys)
387 (if (mml-smime-epg-find-usable-key
388 (epg-list-keys context (epg-sub-key-fingerprint
389 (car (epg-key-sub-key-list
390 (car secret-keys)))))
391 usage)
392 (setq secret-key (car secret-keys)
393 secret-keys nil)
394 (setq secret-keys (cdr secret-keys))))
395 secret-key))
396 356
397(autoload 'mml-compute-boundary "mml") 357(autoload 'mml-compute-boundary "mml")
398 358
@@ -401,146 +361,37 @@ Whether the passphrase is cached at all is controlled by
401(declare-function message-options-set "message" (symbol value)) 361(declare-function message-options-set "message" (symbol value))
402 362
403(defun mml-smime-epg-sign (cont) 363(defun mml-smime-epg-sign (cont)
404 (let* ((inhibit-redisplay t) 364 (let ((inhibit-redisplay t)
405 (context (epg-make-context 'CMS)) 365 (boundary (mml-compute-boundary cont)))
406 (boundary (mml-compute-boundary cont))
407 (sender (message-options-get 'message-sender))
408 (signer-names (or mml-smime-signers
409 (if (and mml-smime-sign-with-sender sender)
410 (list (concat "<" sender ">")))))
411 signer-key
412 (signers
413 (or (message-options-get 'mml-smime-epg-signers)
414 (message-options-set
415 'mml-smime-epg-signers
416 (if (eq mm-sign-option 'guided)
417 (epa-select-keys context "\
418Select keys for signing.
419If no one is selected, default secret key is used. "
420 signer-names
421 t)
422 (if (or sender mml-smime-signers)
423 (delq nil
424 (mapcar
425 (lambda (signer)
426 (setq signer-key
427 (mml-smime-epg-find-usable-secret-key
428 context signer 'sign))
429 (unless (or signer-key
430 (y-or-n-p
431 (format
432 "No secret key for %s; skip it? "
433 signer)))
434 (error "No secret key for %s" signer))
435 signer-key)
436 signer-names)))))))
437 signature micalg)
438 (epg-context-set-signers context signers)
439 (if mml-smime-cache-passphrase
440 (epg-context-set-passphrase-callback
441 context
442 #'mml-smime-epg-passphrase-callback))
443 (condition-case error
444 (setq signature (epg-sign-string context
445 (mm-replace-in-string (buffer-string)
446 "\n" "\r\n")
447 t)
448 mml-smime-epg-secret-key-id-list nil)
449 (error
450 (while mml-smime-epg-secret-key-id-list
451 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
452 (setq mml-smime-epg-secret-key-id-list
453 (cdr mml-smime-epg-secret-key-id-list)))
454 (signal (car error) (cdr error))))
455 (if (epg-context-result-for context 'sign)
456 (setq micalg (epg-new-signature-digest-algorithm
457 (car (epg-context-result-for context 'sign)))))
458 (goto-char (point-min)) 366 (goto-char (point-min))
459 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" 367 (let* ((pair (mml-secure-epg-sign 'CMS cont))
460 boundary)) 368 (signature (car pair))
461 (if micalg 369 (micalg (cdr pair)))
462 (insert (format "\tmicalg=%s; " 370 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
463 (downcase 371 boundary))
464 (cdr (assq micalg 372 (if micalg
465 epg-digest-algorithm-alist)))))) 373 (insert (format "\tmicalg=%s; "
466 (insert "protocol=\"application/pkcs7-signature\"\n") 374 (downcase
467 (insert (format "\n--%s\n" boundary)) 375 (cdr (assq micalg
468 (goto-char (point-max)) 376 epg-digest-algorithm-alist))))))
469 (insert (format "\n--%s\n" boundary)) 377 (insert "protocol=\"application/pkcs7-signature\"\n")
470 (insert "Content-Type: application/pkcs7-signature; name=smime.p7s 378 (insert (format "\n--%s\n" boundary))
379 (goto-char (point-max))
380 (insert (format "\n--%s\n" boundary))
381 (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
471Content-Transfer-Encoding: base64 382Content-Transfer-Encoding: base64
472Content-Disposition: attachment; filename=smime.p7s 383Content-Disposition: attachment; filename=smime.p7s
473 384
474") 385")
475 (insert (base64-encode-string signature) "\n") 386 (insert (base64-encode-string signature) "\n")
476 (goto-char (point-max)) 387 (goto-char (point-max))
477 (insert (format "--%s--\n" boundary)) 388 (insert (format "--%s--\n" boundary))
478 (goto-char (point-max)))) 389 (goto-char (point-max)))))
479 390
480(defun mml-smime-epg-encrypt (cont) 391(defun mml-smime-epg-encrypt (cont)
481 (let* ((inhibit-redisplay t) 392 (let* ((inhibit-redisplay t)
482 (context (epg-make-context 'CMS))
483 (config (epg-configuration))
484 (recipients (message-options-get 'mml-smime-epg-recipients))
485 cipher signers
486 (sender (message-options-get 'message-sender))
487 (signer-names (or mml-smime-signers
488 (if (and mml-smime-sign-with-sender sender)
489 (list (concat "<" sender ">")))))
490 (boundary (mml-compute-boundary cont)) 393 (boundary (mml-compute-boundary cont))
491 recipient-key) 394 (cipher (mml-secure-epg-encrypt 'CMS cont)))
492 (unless recipients
493 (setq recipients
494 (apply #'nconc
495 (mapcar
496 (lambda (recipient)
497 (or (epg-expand-group config recipient)
498 (list recipient)))
499 (split-string
500 (or (message-options-get 'message-recipients)
501 (message-options-set 'message-recipients
502 (read-string "Recipients: ")))
503 "[ \f\t\n\r\v,]+"))))
504 (when mml-smime-encrypt-to-self
505 (unless signer-names
506 (error "Neither message sender nor mml-smime-signers are set"))
507 (setq recipients (nconc recipients signer-names)))
508 (if (eq mm-encrypt-option 'guided)
509 (setq recipients
510 (epa-select-keys context "\
511Select recipients for encryption.
512If no one is selected, symmetric encryption will be performed. "
513 recipients))
514 (setq recipients
515 (mapcar
516 (lambda (recipient)
517 (setq recipient-key (mml-smime-epg-find-usable-key
518 (epg-list-keys context recipient)
519 'encrypt))
520 (unless (or recipient-key
521 (y-or-n-p
522 (format "No public key for %s; skip it? "
523 recipient)))
524 (error "No public key for %s" recipient))
525 recipient-key)
526 recipients))
527 (unless recipients
528 (error "No recipient specified")))
529 (message-options-set 'mml-smime-epg-recipients recipients))
530 (if mml-smime-cache-passphrase
531 (epg-context-set-passphrase-callback
532 context
533 #'mml-smime-epg-passphrase-callback))
534 (condition-case error
535 (setq cipher
536 (epg-encrypt-string context (buffer-string) recipients)
537 mml-smime-epg-secret-key-id-list nil)
538 (error
539 (while mml-smime-epg-secret-key-id-list
540 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
541 (setq mml-smime-epg-secret-key-id-list
542 (cdr mml-smime-epg-secret-key-id-list)))
543 (signal (car error) (cdr error))))
544 (delete-region (point-min) (point-max)) 395 (delete-region (point-min) (point-max))
545 (goto-char (point-min)) 396 (goto-char (point-min))
546 (insert "\ 397 (insert "\
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 6469636451f..bb5c940f173 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -63,11 +63,17 @@
63 63
64(defvar mml1991-cache-passphrase mml-secure-cache-passphrase 64(defvar mml1991-cache-passphrase mml-secure-cache-passphrase
65 "If t, cache passphrase.") 65 "If t, cache passphrase.")
66(make-obsolete-variable 'mml1991-cache-passphrase
67 'mml-secure-cache-passphrase
68 "25.1")
66 69
67(defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry 70(defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
68 "How many seconds the passphrase is cached. 71 "How many seconds the passphrase is cached.
69Whether the passphrase is cached at all is controlled by 72Whether the passphrase is cached at all is controlled by
70`mml1991-cache-passphrase'.") 73`mml1991-cache-passphrase'.")
74(make-obsolete-variable 'mml1991-passphrase-cache-expiry
75 'mml-secure-passphrase-cache-expiry
76 "25.1")
71 77
72(defvar mml1991-signers nil 78(defvar mml1991-signers nil
73 "A list of your own key ID which will be used to sign a message.") 79 "A list of your own key ID which will be used to sign a message.")
@@ -75,6 +81,7 @@ Whether the passphrase is cached at all is controlled by
75(defvar mml1991-encrypt-to-self nil 81(defvar mml1991-encrypt-to-self nil
76 "If t, add your own key ID to recipient list when encryption.") 82 "If t, add your own key ID to recipient list when encryption.")
77 83
84
78;;; mailcrypt wrapper 85;;; mailcrypt wrapper
79 86
80(autoload 'mc-sign-generic "mc-toplev") 87(autoload 'mc-sign-generic "mc-toplev")
@@ -255,91 +262,9 @@ Whether the passphrase is cached at all is controlled by
255(autoload 'epg-configuration "epg-config") 262(autoload 'epg-configuration "epg-config")
256(autoload 'epg-expand-group "epg-config") 263(autoload 'epg-expand-group "epg-config")
257 264
258(defvar mml1991-epg-secret-key-id-list nil)
259
260(defun mml1991-epg-passphrase-callback (context key-id ignore)
261 (if (eq key-id 'SYM)
262 (epg-passphrase-callback-function context key-id nil)
263 (let* ((entry (assoc key-id epg-user-id-alist))
264 (passphrase
265 (password-read
266 (format "GnuPG passphrase for %s: "
267 (if entry
268 (cdr entry)
269 key-id))
270 (if (eq key-id 'PIN)
271 "PIN"
272 key-id))))
273 (when passphrase
274 (let ((password-cache-expiry mml1991-passphrase-cache-expiry))
275 (password-cache-add key-id passphrase))
276 (setq mml1991-epg-secret-key-id-list
277 (cons key-id mml1991-epg-secret-key-id-list))
278 (copy-sequence passphrase)))))
279
280(defun mml1991-epg-find-usable-key (keys usage)
281 (catch 'found
282 (while keys
283 (let ((pointer (epg-key-sub-key-list (car keys))))
284 ;; The primary key will be marked as disabled, when the entire
285 ;; key is disabled (see 12 Field, Format of colon listings, in
286 ;; gnupg/doc/DETAILS)
287 (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
288 (while pointer
289 (if (and (memq usage (epg-sub-key-capability (car pointer)))
290 (not (memq (epg-sub-key-validity (car pointer))
291 '(revoked expired))))
292 (throw 'found (car keys)))
293 (setq pointer (cdr pointer)))))
294 (setq keys (cdr keys)))))
295
296;; XXX: since gpg --list-secret-keys does not return validity of each
297;; key, `mml1991-epg-find-usable-key' defined above is not enough for
298;; secret keys. The function `mml1991-epg-find-usable-secret-key'
299;; below looks at appropriate public keys to check usability.
300(defun mml1991-epg-find-usable-secret-key (context name usage)
301 (let ((secret-keys (epg-list-keys context name t))
302 secret-key)
303 (while (and (not secret-key) secret-keys)
304 (if (mml1991-epg-find-usable-key
305 (epg-list-keys context (epg-sub-key-fingerprint
306 (car (epg-key-sub-key-list
307 (car secret-keys)))))
308 usage)
309 (setq secret-key (car secret-keys)
310 secret-keys nil)
311 (setq secret-keys (cdr secret-keys))))
312 secret-key))
313
314(defun mml1991-epg-sign (cont) 265(defun mml1991-epg-sign (cont)
315 (let ((context (epg-make-context)) 266 (let ((inhibit-redisplay t)
316 headers cte signer-key signers signature) 267 headers cte)
317 (if (eq mm-sign-option 'guided)
318 (setq signers (epa-select-keys context "Select keys for signing.
319If no one is selected, default secret key is used. "
320 mml1991-signers t))
321 (if mml1991-signers
322 (setq signers (delq nil
323 (mapcar
324 (lambda (name)
325 (setq signer-key
326 (mml1991-epg-find-usable-secret-key
327 context name 'sign))
328 (unless (or signer-key
329 (y-or-n-p
330 (format
331 "No secret key for %s; skip it? "
332 name)))
333 (error "No secret key for %s" name))
334 signer-key)
335 mml1991-signers)))))
336 (epg-context-set-armor context t)
337 (epg-context-set-textmode context t)
338 (epg-context-set-signers context signers)
339 (if mml1991-cache-passphrase
340 (epg-context-set-passphrase-callback
341 context
342 #'mml1991-epg-passphrase-callback))
343 ;; Don't sign headers. 268 ;; Don't sign headers.
344 (goto-char (point-min)) 269 (goto-char (point-min))
345 (when (re-search-forward "^$" nil t) 270 (when (re-search-forward "^$" nil t)
@@ -352,28 +277,21 @@ If no one is selected, default secret key is used. "
352 (when cte 277 (when cte
353 (setq cte (intern (downcase cte))) 278 (setq cte (intern (downcase cte)))
354 (mm-decode-content-transfer-encoding cte))) 279 (mm-decode-content-transfer-encoding cte)))
355 (condition-case error 280 (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear))
356 (setq signature (epg-sign-string context (buffer-string) 'clear) 281 (signature (car pair)))
357 mml1991-epg-secret-key-id-list nil) 282 (delete-region (point-min) (point-max))
358 (error 283 (mm-with-unibyte-current-buffer
359 (while mml1991-epg-secret-key-id-list 284 (insert signature)
360 (password-cache-remove (car mml1991-epg-secret-key-id-list)) 285 (goto-char (point-min))
361 (setq mml1991-epg-secret-key-id-list 286 (while (re-search-forward "\r+$" nil t)
362 (cdr mml1991-epg-secret-key-id-list))) 287 (replace-match "" t t))
363 (signal (car error) (cdr error)))) 288 (when cte
364 (delete-region (point-min) (point-max)) 289 (mm-encode-content-transfer-encoding cte))
365 (mm-with-unibyte-current-buffer 290 (goto-char (point-min))
366 (insert signature) 291 (when headers
367 (goto-char (point-min)) 292 (insert headers))
368 (while (re-search-forward "\r+$" nil t) 293 (insert "\n"))
369 (replace-match "" t t)) 294 t)))
370 (when cte
371 (mm-encode-content-transfer-encoding cte))
372 (goto-char (point-min))
373 (when headers
374 (insert headers))
375 (insert "\n"))
376 t))
377 295
378(defun mml1991-epg-encrypt (cont &optional sign) 296(defun mml1991-epg-encrypt (cont &optional sign)
379 (goto-char (point-min)) 297 (goto-char (point-min))
@@ -386,78 +304,7 @@ If no one is selected, default secret key is used. "
386 (delete-region (point-min) (point)) 304 (delete-region (point-min) (point))
387 (when cte 305 (when cte
388 (mm-decode-content-transfer-encoding (intern (downcase cte)))))) 306 (mm-decode-content-transfer-encoding (intern (downcase cte))))))
389 (let ((context (epg-make-context)) 307 (let ((cipher (mml-secure-epg-encrypt 'OpenPGP cont sign)))
390 (recipients
391 (if (message-options-get 'message-recipients)
392 (split-string
393 (message-options-get 'message-recipients)
394 "[ \f\t\n\r\v,]+")))
395 recipient-key signer-key cipher signers config)
396 (when mml1991-encrypt-to-self
397 (unless mml1991-signers
398 (error "mml1991-signers is not set"))
399 (setq recipients (nconc recipients mml1991-signers)))
400 ;; We should remove this check if epg-0.0.6 is released.
401 (if (and (condition-case nil
402 (require 'epg-config)
403 (error))
404 (functionp #'epg-expand-group))
405 (setq config (epg-configuration)
406 recipients
407 (apply #'nconc
408 (mapcar (lambda (recipient)
409 (or (epg-expand-group config recipient)
410 (list recipient)))
411 recipients))))
412 (if (eq mm-encrypt-option 'guided)
413 (setq recipients
414 (epa-select-keys context "Select recipients for encryption.
415If no one is selected, symmetric encryption will be performed. "
416 recipients))
417 (setq recipients
418 (delq nil (mapcar
419 (lambda (name)
420 (setq recipient-key (mml1991-epg-find-usable-key
421 (epg-list-keys context name)
422 'encrypt))
423 (unless (or recipient-key
424 (y-or-n-p
425 (format "No public key for %s; skip it? "
426 name)))
427 (error "No public key for %s" name))
428 recipient-key)
429 recipients)))
430 (unless recipients
431 (error "No recipient specified")))
432 (when sign
433 (if (eq mm-sign-option 'guided)
434 (setq signers (epa-select-keys context "Select keys for signing.
435If no one is selected, default secret key is used. "
436 mml1991-signers t))
437 (if mml1991-signers
438 (setq signers (delq nil
439 (mapcar
440 (lambda (name)
441 (mml1991-epg-find-usable-secret-key
442 context name 'sign))
443 mml1991-signers)))))
444 (epg-context-set-signers context signers))
445 (epg-context-set-armor context t)
446 (epg-context-set-textmode context t)
447 (if mml1991-cache-passphrase
448 (epg-context-set-passphrase-callback
449 context
450 #'mml1991-epg-passphrase-callback))
451 (condition-case error
452 (setq cipher
453 (epg-encrypt-string context (buffer-string) recipients sign)
454 mml1991-epg-secret-key-id-list nil)
455 (error
456 (while mml1991-epg-secret-key-id-list
457 (password-cache-remove (car mml1991-epg-secret-key-id-list))
458 (setq mml1991-epg-secret-key-id-list
459 (cdr mml1991-epg-secret-key-id-list)))
460 (signal (car error) (cdr error))))
461 (delete-region (point-min) (point-max)) 308 (delete-region (point-min) (point-max))
462 (insert "\n" cipher)) 309 (insert "\n" cipher))
463 t) 310 t)
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 10ba126ae2b..e2e99771801 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -111,6 +111,9 @@ Valid packages include `epg', `pgg' and `mailcrypt'.")
111 "If t, cache passphrase." 111 "If t, cache passphrase."
112 :group 'mime-security 112 :group 'mime-security
113 :type 'boolean) 113 :type 'boolean)
114(make-obsolete-variable 'mml2015-cache-passphrase
115 'mml-secure-cache-passphrase
116 "25.1")
114 117
115(defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry 118(defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
116 "How many seconds the passphrase is cached. 119 "How many seconds the passphrase is cached.
@@ -118,6 +121,9 @@ Whether the passphrase is cached at all is controlled by
118`mml2015-cache-passphrase'." 121`mml2015-cache-passphrase'."
119 :group 'mime-security 122 :group 'mime-security
120 :type 'integer) 123 :type 'integer)
124(make-obsolete-variable 'mml2015-passphrase-cache-expiry
125 'mml-secure-passphrase-cache-expiry
126 "25.1")
121 127
122(defcustom mml2015-signers nil 128(defcustom mml2015-signers nil
123 "A list of your own key ID(s) which will be used to sign a message. 129 "A list of your own key ID(s) which will be used to sign a message.
@@ -774,99 +780,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
774(autoload 'epg-expand-group "epg-config") 780(autoload 'epg-expand-group "epg-config")
775(autoload 'epa-select-keys "epa") 781(autoload 'epa-select-keys "epa")
776 782
777(defvar mml2015-epg-secret-key-id-list nil)
778
779(defun mml2015-epg-passphrase-callback (context key-id ignore)
780 (if (eq key-id 'SYM)
781 (epg-passphrase-callback-function context key-id nil)
782 (let* ((password-cache-key-id
783 (if (eq key-id 'PIN)
784 "PIN"
785 key-id))
786 entry
787 (passphrase
788 (password-read
789 (if (eq key-id 'PIN)
790 "Passphrase for PIN: "
791 (if (setq entry (assoc key-id epg-user-id-alist))
792 (format "Passphrase for %s %s: " key-id (cdr entry))
793 (format "Passphrase for %s: " key-id)))
794 password-cache-key-id)))
795 (when passphrase
796 (let ((password-cache-expiry mml2015-passphrase-cache-expiry))
797 (password-cache-add password-cache-key-id passphrase))
798 (setq mml2015-epg-secret-key-id-list
799 (cons password-cache-key-id mml2015-epg-secret-key-id-list))
800 (copy-sequence passphrase)))))
801
802(defun mml2015-epg-check-user-id (key recipient)
803 (let ((pointer (epg-key-user-id-list key))
804 result)
805 (while pointer
806 (if (and (equal (car (mail-header-parse-address
807 (epg-user-id-string (car pointer))))
808 (car (mail-header-parse-address
809 recipient)))
810 (not (memq (epg-user-id-validity (car pointer))
811 '(revoked expired))))
812 (setq result t
813 pointer nil)
814 (setq pointer (cdr pointer))))
815 result))
816
817(defun mml2015-epg-check-sub-key (key usage)
818 (let ((pointer (epg-key-sub-key-list key))
819 result)
820 ;; The primary key will be marked as disabled, when the entire
821 ;; key is disabled (see 12 Field, Format of colon listings, in
822 ;; gnupg/doc/DETAILS)
823 (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
824 (while pointer
825 (if (and (memq usage (epg-sub-key-capability (car pointer)))
826 (not (memq (epg-sub-key-validity (car pointer))
827 '(revoked expired))))
828 (setq result t
829 pointer nil)
830 (setq pointer (cdr pointer)))))
831 result))
832
833(defun mml2015-epg-find-usable-key (context name usage
834 &optional name-is-key-id)
835 (let ((keys (epg-list-keys context name))
836 key)
837 (while keys
838 (if (and (or name-is-key-id
839 ;; Non email user-id can be supplied through
840 ;; mml2015-signers if mml2015-encrypt-to-self is set.
841 ;; Treat it as valid, as it is user's intention.
842 (not (string-match "\\`<" name))
843 (mml2015-epg-check-user-id (car keys) name))
844 (mml2015-epg-check-sub-key (car keys) usage))
845 (setq key (car keys)
846 keys nil)
847 (setq keys (cdr keys))))
848 key))
849
850;; XXX: since gpg --list-secret-keys does not return validity of each
851;; key, `mml2015-epg-find-usable-key' defined above is not enough for
852;; secret keys. The function `mml2015-epg-find-usable-secret-key'
853;; below looks at appropriate public keys to check usability.
854(defun mml2015-epg-find-usable-secret-key (context name usage)
855 (let ((secret-keys (epg-list-keys context name t))
856 secret-key)
857 (while (and (not secret-key) secret-keys)
858 (if (mml2015-epg-find-usable-key
859 context
860 (epg-sub-key-fingerprint
861 (car (epg-key-sub-key-list
862 (car secret-keys))))
863 usage
864 t)
865 (setq secret-key (car secret-keys)
866 secret-keys nil)
867 (setq secret-keys (cdr secret-keys))))
868 secret-key))
869
870(autoload 'gnus-create-image "gnus-ems") 783(autoload 'gnus-create-image "gnus-ems")
871 784
872(defun mml2015-epg-key-image (key-id) 785(defun mml2015-epg-key-image (key-id)
@@ -921,18 +834,15 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
921 mm-security-handle 'gnus-info "Corrupted") 834 mm-security-handle 'gnus-info "Corrupted")
922 (throw 'error handle)) 835 (throw 'error handle))
923 (setq context (epg-make-context)) 836 (setq context (epg-make-context))
924 (if mml2015-cache-passphrase 837 (if (or mml2015-cache-passphrase mml-secure-cache-passphrase)
925 (epg-context-set-passphrase-callback 838 (epg-context-set-passphrase-callback
926 context 839 context
927 #'mml2015-epg-passphrase-callback)) 840 (cons 'mml-secure-passphrase-callback 'OpenPGP)))
928 (condition-case error 841 (condition-case error
929 (setq plain (epg-decrypt-string context (mm-get-part child)) 842 (setq plain (epg-decrypt-string context (mm-get-part child))
930 mml2015-epg-secret-key-id-list nil) 843 mml-secure-secret-key-id-list nil)
931 (error 844 (error
932 (while mml2015-epg-secret-key-id-list 845 (mml-secure-clear-secret-key-id-list)
933 (password-cache-remove (car mml2015-epg-secret-key-id-list))
934 (setq mml2015-epg-secret-key-id-list
935 (cdr mml2015-epg-secret-key-id-list)))
936 (mm-set-handle-multipart-parameter 846 (mm-set-handle-multipart-parameter
937 mm-security-handle 'gnus-info "Failed") 847 mm-security-handle 'gnus-info "Failed")
938 (if (eq (car error) 'quit) 848 (if (eq (car error) 'quit)
@@ -968,18 +878,15 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
968 (let ((inhibit-redisplay t) 878 (let ((inhibit-redisplay t)
969 (context (epg-make-context)) 879 (context (epg-make-context))
970 plain) 880 plain)
971 (if mml2015-cache-passphrase 881 (if (or mml2015-cache-passphrase mml-secure-cache-passphrase)
972 (epg-context-set-passphrase-callback 882 (epg-context-set-passphrase-callback
973 context 883 context
974 #'mml2015-epg-passphrase-callback)) 884 (cons 'mml-secure-passphrase-callback 'OpenPGP)))
975 (condition-case error 885 (condition-case error
976 (setq plain (epg-decrypt-string context (buffer-string)) 886 (setq plain (epg-decrypt-string context (buffer-string))
977 mml2015-epg-secret-key-id-list nil) 887 mml-secure-secret-key-id-list nil)
978 (error 888 (error
979 (while mml2015-epg-secret-key-id-list 889 (mml-secure-clear-secret-key-id-list)
980 (password-cache-remove (car mml2015-epg-secret-key-id-list))
981 (setq mml2015-epg-secret-key-id-list
982 (cdr mml2015-epg-secret-key-id-list)))
983 (mm-set-handle-multipart-parameter 890 (mm-set-handle-multipart-parameter
984 mm-security-handle 'gnus-info "Failed") 891 mm-security-handle 'gnus-info "Failed")
985 (if (eq (car error) 'quit) 892 (if (eq (car error) 'quit)
@@ -1065,176 +972,37 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
1065 (mml2015-extract-cleartext-signature)))) 972 (mml2015-extract-cleartext-signature))))
1066 973
1067(defun mml2015-epg-sign (cont) 974(defun mml2015-epg-sign (cont)
1068 (let* ((inhibit-redisplay t) 975 (let ((inhibit-redisplay t)
1069 (context (epg-make-context)) 976 (boundary (mml-compute-boundary cont)))
1070 (boundary (mml-compute-boundary cont))
1071 (sender (message-options-get 'message-sender))
1072 (signer-names (or mml2015-signers
1073 (if (and mml2015-sign-with-sender sender)
1074 (list (concat "<" sender ">")))))
1075 signer-key
1076 (signers
1077 (or (message-options-get 'mml2015-epg-signers)
1078 (message-options-set
1079 'mml2015-epg-signers
1080 (if (eq mm-sign-option 'guided)
1081 (epa-select-keys context "\
1082Select keys for signing.
1083If no one is selected, default secret key is used. "
1084 signer-names
1085 t)
1086 (if (or sender mml2015-signers)
1087 (delq nil
1088 (mapcar
1089 (lambda (signer)
1090 (setq signer-key
1091 (mml2015-epg-find-usable-secret-key
1092 context signer 'sign))
1093 (unless (or signer-key
1094 (y-or-n-p
1095 (format
1096 "No secret key for %s; skip it? "
1097 signer)))
1098 (error "No secret key for %s" signer))
1099 signer-key)
1100 signer-names)))))))
1101 signature micalg)
1102 (epg-context-set-armor context t)
1103 (epg-context-set-textmode context t)
1104 (epg-context-set-signers context signers)
1105 (if mml2015-cache-passphrase
1106 (epg-context-set-passphrase-callback
1107 context
1108 #'mml2015-epg-passphrase-callback))
1109 ;; Signed data must end with a newline (RFC 3156, 5). 977 ;; Signed data must end with a newline (RFC 3156, 5).
1110 (goto-char (point-max)) 978 (goto-char (point-max))
1111 (unless (bolp) 979 (unless (bolp)
1112 (insert "\n")) 980 (insert "\n"))
1113 (condition-case error 981 (let* ((pair (mml-secure-epg-sign 'OpenPGP t))
1114 (setq signature (epg-sign-string context (buffer-string) t) 982 (signature (car pair))
1115 mml2015-epg-secret-key-id-list nil) 983 (micalg (cdr pair)))
1116 (error 984 (goto-char (point-min))
1117 (while mml2015-epg-secret-key-id-list 985 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
1118 (password-cache-remove (car mml2015-epg-secret-key-id-list)) 986 boundary))
1119 (setq mml2015-epg-secret-key-id-list 987 (if micalg
1120 (cdr mml2015-epg-secret-key-id-list))) 988 (insert (format "\tmicalg=pgp-%s; "
1121 (signal (car error) (cdr error)))) 989 (downcase
1122 (if (epg-context-result-for context 'sign) 990 (cdr (assq micalg
1123 (setq micalg (epg-new-signature-digest-algorithm 991 epg-digest-algorithm-alist))))))
1124 (car (epg-context-result-for context 'sign))))) 992 (insert "protocol=\"application/pgp-signature\"\n")
1125 (goto-char (point-min)) 993 (insert (format "\n--%s\n" boundary))
1126 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" 994 (goto-char (point-max))
1127 boundary)) 995 (insert (format "\n--%s\n" boundary))
1128 (if micalg 996 (insert "Content-Type: application/pgp-signature; name=\"signature.asc\"\n\n")
1129 (insert (format "\tmicalg=pgp-%s; " 997 (insert signature)
1130 (downcase 998 (goto-char (point-max))
1131 (cdr (assq micalg 999 (insert (format "--%s--\n" boundary))
1132 epg-digest-algorithm-alist)))))) 1000 (goto-char (point-max)))))
1133 (insert "protocol=\"application/pgp-signature\"\n")
1134 (insert (format "\n--%s\n" boundary))
1135 (goto-char (point-max))
1136 (insert (format "\n--%s\n" boundary))
1137 (insert "Content-Type: application/pgp-signature; name=\"signature.asc\"\n\n")
1138 (insert signature)
1139 (goto-char (point-max))
1140 (insert (format "--%s--\n" boundary))
1141 (goto-char (point-max))))
1142 1001
1143(defun mml2015-epg-encrypt (cont &optional sign) 1002(defun mml2015-epg-encrypt (cont &optional sign)
1144 (let* ((inhibit-redisplay t) 1003 (let* ((inhibit-redisplay t)
1145 (context (epg-make-context))
1146 (boundary (mml-compute-boundary cont)) 1004 (boundary (mml-compute-boundary cont))
1147 (config (epg-configuration)) 1005 (cipher (mml-secure-epg-encrypt 'OpenPGP cont sign)))
1148 (recipients (message-options-get 'mml2015-epg-recipients))
1149 cipher
1150 (sender (message-options-get 'message-sender))
1151 (signer-names (or mml2015-signers
1152 (if (and mml2015-sign-with-sender sender)
1153 (list (concat "<" sender ">")))))
1154 signers
1155 recipient-key signer-key)
1156 (unless recipients
1157 (setq recipients
1158 (apply #'nconc
1159 (mapcar
1160 (lambda (recipient)
1161 (or (epg-expand-group config recipient)
1162 (list (concat "<" recipient ">"))))
1163 (split-string
1164 (or (message-options-get 'message-recipients)
1165 (message-options-set 'message-recipients
1166 (read-string "Recipients: ")))
1167 "[ \f\t\n\r\v,]+"))))
1168 (when mml2015-encrypt-to-self
1169 (unless signer-names
1170 (error "Neither message sender nor mml2015-signers are set"))
1171 (setq recipients (nconc recipients signer-names)))
1172 (if (eq mm-encrypt-option 'guided)
1173 (setq recipients
1174 (epa-select-keys context "\
1175Select recipients for encryption.
1176If no one is selected, symmetric encryption will be performed. "
1177 recipients))
1178 (setq recipients
1179 (delq nil
1180 (mapcar
1181 (lambda (recipient)
1182 (setq recipient-key (mml2015-epg-find-usable-key
1183 context recipient 'encrypt))
1184 (unless (or recipient-key
1185 (y-or-n-p
1186 (format "No public key for %s; skip it? "
1187 recipient)))
1188 (error "No public key for %s" recipient))
1189 recipient-key)
1190 recipients)))
1191 (unless recipients
1192 (error "No recipient specified")))
1193 (message-options-set 'mml2015-epg-recipients recipients))
1194 (when sign
1195 (setq signers
1196 (or (message-options-get 'mml2015-epg-signers)
1197 (message-options-set
1198 'mml2015-epg-signers
1199 (if (eq mm-sign-option 'guided)
1200 (epa-select-keys context "\
1201Select keys for signing.
1202If no one is selected, default secret key is used. "
1203 signer-names
1204 t)
1205 (if (or sender mml2015-signers)
1206 (delq nil
1207 (mapcar
1208 (lambda (signer)
1209 (setq signer-key
1210 (mml2015-epg-find-usable-secret-key
1211 context signer 'sign))
1212 (unless (or signer-key
1213 (y-or-n-p
1214 (format
1215 "No secret key for %s; skip it? "
1216 signer)))
1217 (error "No secret key for %s" signer))
1218 signer-key)
1219 signer-names)))))))
1220 (epg-context-set-signers context signers))
1221 (epg-context-set-armor context t)
1222 (epg-context-set-textmode context t)
1223 (if mml2015-cache-passphrase
1224 (epg-context-set-passphrase-callback
1225 context
1226 #'mml2015-epg-passphrase-callback))
1227 (condition-case error
1228 (setq cipher
1229 (epg-encrypt-string context (buffer-string) recipients sign
1230 mml2015-always-trust)
1231 mml2015-epg-secret-key-id-list nil)
1232 (error
1233 (while mml2015-epg-secret-key-id-list
1234 (password-cache-remove (car mml2015-epg-secret-key-id-list))
1235 (setq mml2015-epg-secret-key-id-list
1236 (cdr mml2015-epg-secret-key-id-list)))
1237 (signal (car error) (cdr error))))
1238 (delete-region (point-min) (point-max)) 1006 (delete-region (point-min) (point-max))
1239 (goto-char (point-min)) 1007 (goto-char (point-min))
1240 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" 1008 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"