diff options
| author | Jens Lechtenboerger | 2016-01-03 01:10:34 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2016-01-03 01:10:34 +0000 |
| commit | 5213ded9aab68d83c306aa2f4880c8a1abd3608c (patch) | |
| tree | 67bf83af8552079df3a2f559174a02e58fdd739e | |
| parent | 43662a240b682de94299e797452ba56d01a04883 (diff) | |
| download | emacs-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.texi | 195 | ||||
| -rw-r--r-- | lisp/gnus/gnus-util.el | 25 | ||||
| -rw-r--r-- | lisp/gnus/mml-sec.el | 579 | ||||
| -rw-r--r-- | lisp/gnus/mml-smime.el | 273 | ||||
| -rw-r--r-- | lisp/gnus/mml1991.el | 203 | ||||
| -rw-r--r-- | lisp/gnus/mml2015.el | 306 |
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 | ||
| 941 | Using the @acronym{MML} language, Message is able to create digitally | 941 | By default, e-mails are transmitted without any protection around the |
| 942 | signed and digitally encrypted messages. Message (or rather | 942 | Internet, which implies that they can be read and changed by lots of |
| 943 | @acronym{MML}) currently support @acronym{PGP} (RFC 1991), | 943 | different parties. In particular, they are analyzed under bulk |
| 944 | @acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}. | 944 | surveillance, which violates basic human rights. To defend those |
| 945 | rights, digital self-defense is necessary (in addition to legal | ||
| 946 | changes), and encryption and digital signatures are powerful | ||
| 947 | techniques for self-defense. In essence, encryption ensures that | ||
| 948 | only the intended recipient will be able to read a message, while | ||
| 949 | digital signatures make sure that modifications to messages can be | ||
| 950 | detected by the recipient. | ||
| 951 | |||
| 952 | Nowadays, there are two major incompatible e-mail encryption | ||
| 953 | standards, namely @acronym{OpenPGP} and @acronym{S/MIME}. Both of | ||
| 954 | these standards are implemented by the @uref{https://www.gnupg.org/, | ||
| 955 | GNU Privacy Guard (GnuPG)}, which needs to be installed as external | ||
| 956 | software in addition to GNU Emacs. Before you can start to encrypt, | ||
| 957 | decrypt, and sign messages, you need to create a so-called key-pair, | ||
| 958 | which 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 | ||
| 960 | used by others (a) to encrypt messages intended for you and (b) to verify | ||
| 961 | digital signatures created by you. In contrast, you use your @emph{private} | ||
| 962 | key (a) to decrypt messages and (b) to sign messages. (You may want to | ||
| 963 | think of your public key as an open safe that you offer to others such | ||
| 964 | that they can deposit messages and lock the door, while your private | ||
| 965 | key corresponds to the opening combination for the safe.) | ||
| 966 | |||
| 967 | Thus, you need to perform the following steps for e-mail encryption, | ||
| 968 | typically outside Emacs. See, for example, the | ||
| 969 | @uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy | ||
| 970 | Handbook} for details covering the standard @acronym{OpenPGP} with | ||
| 971 | @acronym{GnuPG}. | ||
| 972 | @enumerate | ||
| 973 | @item | ||
| 974 | Install GnuPG. | ||
| 975 | @item | ||
| 976 | Create a key-pair for your own e-mail address. | ||
| 977 | @item | ||
| 978 | Distribute your public key, e.g., via upload to key servers. | ||
| 979 | @item | ||
| 980 | Import the public keys for the recipients to which you want to send | ||
| 981 | encrypted e-mails. | ||
| 982 | @end enumerate | ||
| 983 | |||
| 984 | Whether to use the standard @acronym{OpenPGP} or @acronym{S/MIME} is | ||
| 985 | beyond the scope of this documentation. Actually, you can use one | ||
| 986 | standard for one set of recipients and the other standard for | ||
| 987 | different recipients (depending their preferences or capabilities). | ||
| 988 | |||
| 989 | In case you are not familiar with all those acronyms: The standard | ||
| 990 | @acronym{OpenPGP} is also called @acronym{PGP} (Pretty Good Privacy). | ||
| 991 | The command line tools offered by @acronym{GnuPG} for | ||
| 992 | @acronym{OpenPGP} are called @command{gpg} and @command{gpg2}, while | ||
| 993 | the one for @acronym{S/MIME} is called @command{gpgsm}. An | ||
| 994 | alternative, but discouraged, tool for @acronym{S/MIME} is | ||
| 995 | @command{openssl}. To make matters worse, e-mail messages can be | ||
| 996 | formed in two different ways with @acronym{OpenPGP}, namely | ||
| 997 | @acronym{PGP} (RFC 1991/4880) and @acronym{PGP/MIME} (RFC 2015/3156). | ||
| 998 | |||
| 999 | The good news, however, is the following: In GNU Emacs, Message | ||
| 1000 | supports all those variants, comes with reasonable defaults that can | ||
| 1001 | be customized according to your needs, and invokes the proper command | ||
| 1002 | line tools behind the scenes for encryption, decryption, as well as | ||
| 1003 | creation and verification of digital signatures. | ||
| 1004 | |||
| 1005 | Message uses the @acronym{MML} language for the creation of signed | ||
| 1006 | and/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 |
| 1045 | modern cryptography, @acronym{S/MIME}, various PKCS standards, OpenSSL and | 1111 | @uref{https://www.gnupg.org/, GNU Privacy Guard} or |
| 1046 | so on. | 1112 | @uref{https://www.openssl.org/, OpenSSL}. The default Emacs interface |
| 1113 | to the S/MIME implementation is EasyPG (@pxref{Top,,EasyPG Assistant | ||
| 1114 | User's Manual, epa, EasyPG Assistant User's Manual}), which has been | ||
| 1115 | included in Emacs since version 23 and which relies on the command | ||
| 1116 | line tool @command{gpgsm} provided by @acronym{GnuPG}. That tool | ||
| 1117 | implements certificate management, including certificate revocation | ||
| 1118 | and expiry, while such tasks need to be performed manually, if OpenSSL | ||
| 1119 | is used. | ||
| 1120 | |||
| 1121 | The 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} | ||
| 1123 | for EasyPG. Depending on your version of Emacs that value may be the | ||
| 1124 | default; if not, you can either customize that variable or place the | ||
| 1125 | following line in your @file{.emacs} file (that line needs to be | ||
| 1126 | placed above other code related to message/gnus/encryption): | ||
| 1127 | |||
| 1128 | @lisp | ||
| 1129 | (require 'epg) | ||
| 1130 | @end lisp | ||
| 1131 | |||
| 1132 | Moreover, 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 | |||
| 1136 | That's all if you want to use S/MIME with EasyPG, and that's the | ||
| 1137 | recommended way of using S/MIME with Message. | ||
| 1138 | |||
| 1139 | If you think about using OpenSSL instead of EasyPG, please read the | ||
| 1140 | BUGS section in the manual for the @command{smime} command coming with | ||
| 1141 | OpenSSL first. If you still want to use OpenSSL, the following | ||
| 1142 | applies. | ||
| 1143 | |||
| 1144 | @emph{Note!} The remainder of this section assumes you have a basic | ||
| 1145 | familiarity with modern cryptography, @acronym{S/MIME}, various PKCS | ||
| 1146 | standards, OpenSSL and so on. | ||
| 1047 | 1147 | ||
| 1048 | The @acronym{S/MIME} support in Message (and @acronym{MML}) require | 1148 | The @acronym{S/MIME} support in Message (and @acronym{MML}) can use |
| 1049 | OpenSSL@. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt | 1149 | OpenSSL@. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt |
| 1050 | operations. OpenSSL can be found at @uref{http://www.openssl.org/}. | 1150 | operations. OpenSSL can be found at @uref{http://www.openssl.org/}. |
| 1051 | OpenSSL 0.9.6 and later should work. Version 0.9.5a cannot extract mail | 1151 | OpenSSL 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 | |||
| 1101 | you are on a secure single user machine) simply press @code{RET} at | 1201 | you are on a secure single user machine) simply press @code{RET} at |
| 1102 | the passphrase prompt. | 1202 | the 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 | 1207 | Use of OpenPGP requires an external software, such |
| 1108 | as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP | 1208 | as @uref{https://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP |
| 1109 | implementations such as PGP 2.x and PGP 5.x are also supported. The | 1209 | implementations such as PGP 2.x and PGP 5.x are also supported. The |
| 1110 | default Emacs interface to the PGP implementation is EasyPG | 1210 | default 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 |
| 1112 | User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and | 1212 | User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and |
| 1113 | Mailcrypt are also supported. @xref{PGP Compatibility}. | 1213 | Mailcrypt are also supported. @xref{PGP Compatibility}. |
| 1114 | 1214 | ||
| 1215 | As stated earlier, messages encrypted with OpenPGP can be formatted | ||
| 1216 | according 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 |
| 1116 | Message internally calls GnuPG (the @command{gpg} command) to perform | 1226 | Message with EasyPG internally calls GnuPG (the @command{gpg} or |
| 1227 | @command{gpgsm} command) to perform | ||
| 1117 | data encryption, and in certain cases (decrypting or signing for | 1228 | data encryption, and in certain cases (decrypting or signing for |
| 1118 | example), @command{gpg} requires user's passphrase. Currently the | 1229 | example), @command{gpg}/@command{gpgsm} requires user's passphrase. |
| 1119 | recommended way to supply your passphrase to @command{gpg} is to use the | 1230 | Currently the recommended way to supply your passphrase is to use the |
| 1120 | @command{gpg-agent} program. | 1231 | @command{gpg-agent} program. |
| 1121 | 1232 | ||
| 1122 | To use @command{gpg-agent} in Emacs, you need to run the following | 1233 | In particular, the @command{gpg-agent} program supports passphrase |
| 1123 | command from the shell before starting Emacs. | 1234 | caching so that you do not need to enter your passphrase for every |
| 1235 | decryption/sign operation. @xref{Agent Options, , , gnupg, Using the | ||
| 1236 | GNU Privacy Guard}. | ||
| 1237 | |||
| 1238 | How to use @command{gpg-agent} in Emacs depends on your version of | ||
| 1239 | GnuPG. With GnuPG version 2.1, @command{gpg-agent} is started | ||
| 1240 | automatically if necessary. With older versions you may need to run | ||
| 1241 | the following command from the shell before starting Emacs. | ||
| 1124 | 1242 | ||
| 1125 | @example | 1243 | @example |
| 1126 | eval `gpg-agent --daemon` | 1244 | eval `gpg-agent --daemon` |
| @@ -1135,11 +1253,10 @@ GNU Privacy Guard}. | |||
| 1135 | Once your @command{gpg-agent} is set up, it will ask you for a | 1253 | Once your @command{gpg-agent} is set up, it will ask you for a |
| 1136 | passphrase as needed for @command{gpg}. Under the X Window System, | 1254 | passphrase as needed for @command{gpg}. Under the X Window System, |
| 1137 | you will see a new passphrase input dialog appear. The dialog is | 1255 | you will see a new passphrase input dialog appear. The dialog is |
| 1138 | provided by PIN Entry (the @command{pinentry} command), and as of | 1256 | provided by PIN Entry (the @command{pinentry} command), reasonably |
| 1139 | version 0.7.2, @command{pinentry} cannot cooperate with Emacs on a | 1257 | recent versions of which can also cooperate with Emacs on a text |
| 1140 | single tty. So, if you are using a text console, you may need to put | 1258 | console. If that does not work, you may need to put a passphrase into |
| 1141 | a passphrase into gpg-agent's cache beforehand. The following command | 1259 | gpg-agent's cache beforehand. The following command does the trick. |
| 1142 | does the trick. | ||
| 1143 | 1260 | ||
| 1144 | @example | 1261 | @example |
| 1145 | gpg --use-agent --sign < /dev/null > /dev/null | 1262 | gpg --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 |
| 1182 | information about the problem.) | 1299 | information about the problem.) |
| 1183 | 1300 | ||
| 1301 | @node Encrypt-to-self | ||
| 1302 | @subsection Encrypt-to-self | ||
| 1303 | |||
| 1304 | By default, messages are encrypted to all recipients (@code{To}, | ||
| 1305 | @code{Cc}, @code{Bcc} headers). Thus, you will not be able to decrypt | ||
| 1306 | your own messages. To make sure that messages are also encrypted to | ||
| 1307 | your own key(s), several alternative solutions exist: | ||
| 1308 | @enumerate | ||
| 1309 | @item | ||
| 1310 | Use the @code{encrypt-to} option in the file @file{gpg.conf} (for | ||
| 1311 | OpenPGP) 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 | ||
| 1315 | Include your own e-mail address (for which you created a key-pair) | ||
| 1316 | among the recipients. | ||
| 1317 | @item | ||
| 1318 | Customize the variable @code{mml-secure-openpgp-encrypt-to-self} (for | ||
| 1319 | OpenPGP) 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 | |||
| 1326 | The @code{Bcc} header is meant to hide recipients of messages. | ||
| 1327 | However, when encrypted messages are used, the e-mail addresses of all | ||
| 1328 | @code{Bcc}-headers are given away to all recipients without | ||
| 1329 | warning, 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. | ||
| 2001 | Return nil if LIST is no list or is empty or some test returns nil; | ||
| 2002 | otherwise, 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. | ||
| 2009 | Similar to `subsetp' but use member for element test so that this works for | ||
| 2010 | lists 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 | ||
| 92 | Note that the output generated by using a `combined' mode is NOT | 95 | Note that the output generated by using a `combined' mode is NOT |
| 93 | understood by all PGP implementations, in particular PGP version | 96 | understood by all PGP implementations, in particular PGP version |
| 94 | 2 does not support it! See Info node `(message)Security' for | 97 | 2 does not support it! See Info node `(message) Security' for |
| 95 | details." | 98 | details." |
| 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. |
| 118 | Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead. | ||
| 119 | See 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. | ||
| 135 | EasyPG encrypts e-mails to Bcc addresses, and the encrypted e-mail | ||
| 136 | by default identifies the used encryption keys, giving away the | ||
| 137 | Bcc'ed identities. Clearly, this contradicts the original goal of | ||
| 138 | *blind* copies. | ||
| 139 | For an academic paper explaining the problem, see URL | ||
| 140 | `http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. | ||
| 141 | Use this variable to specify e-mail addresses whose owners do not | ||
| 142 | mind if they are identifiable as recipients. This may be useful if | ||
| 143 | you 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). | ||
| 309 | Bcc usage is safe in two cases: first, if the current message does | ||
| 310 | not contain an MML secure encrypt tag; | ||
| 311 | second, if the Bcc addresses are a subset of `mml-secure-safe-bcc-list'. | ||
| 312 | In all other cases, ask the user whether Bcc usage is safe. | ||
| 313 | Raise error if user answers no. | ||
| 314 | Note that this function does not produce a meaningful return value: | ||
| 315 | either 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. | ||
| 439 | If 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. | ||
| 446 | If 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. | ||
| 456 | If t, also encrypt to key for message sender; if list, encrypt to those keys. | ||
| 457 | With this variable, you can ensure that you can decrypt your own messages. | ||
| 458 | Alternatives to this variable include Bcc'ing the message to yourself or | ||
| 459 | using the encrypt-to or hidden-encrypt-to option in gpg.conf (see man gpg(1)). | ||
| 460 | Note that this variable and the encrypt-to option give away your identity | ||
| 461 | for *every* encryption without warning, which is not what you want if you are | ||
| 462 | using, e.g., remailers. | ||
| 463 | Also, use of Bcc gives away your identity for *every* encryption without | ||
| 464 | warning, which is a bug, see: | ||
| 465 | https://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. | ||
| 475 | If t, also encrypt to key for message sender; if list, encrypt to those keys. | ||
| 476 | With this variable, you can ensure that you can decrypt your own messages. | ||
| 477 | Alternatives to this variable include Bcc'ing the message to yourself or | ||
| 478 | using the encrypt-to option in gpgsm.conf (see man gpgsm(1)). | ||
| 479 | Note that this variable and the encrypt-to option give away your identity | ||
| 480 | for *every* encryption without warning, which is not what you want if you are | ||
| 481 | using, e.g., remailers. | ||
| 482 | Also, use of Bcc gives away your identity for *every* encryption without | ||
| 483 | warning, which is a bug, see: | ||
| 484 | https://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. | ||
| 515 | Otherwise, 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. | ||
| 522 | This variable is only relevant if a recipient owns multiple key pairs (for | ||
| 523 | encryption) or you own multiple key pairs (for signing). In such cases, | ||
| 524 | you will be asked which key(s) should be used, and your choice can be | ||
| 525 | customized 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. | ||
| 547 | If optional SAVE is not nil, save customized fingerprints. | ||
| 548 | Return 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. | ||
| 564 | Return 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. | ||
| 590 | Passphrase 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. | ||
| 604 | Passphrase 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. | ||
| 618 | The 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. | ||
| 674 | This is the case if KEY is not disabled, and there is a subkey for | ||
| 675 | USAGE that is neither revoked nor expired. Additionally, if optional | ||
| 676 | FINGERPRINT is present and if it is not the primary key's fingerprint, then | ||
| 677 | the returned subkey must have that FINGERPRINT. FINGERPRINT must consist of | ||
| 678 | hexadecimal digits only (no leading \"0x\" allowed). | ||
| 679 | If USAGE is not `encrypt', then additionally an appropriate secret key must | ||
| 680 | be 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. | ||
| 707 | If USAGE is `encrypt' public keys are returned, otherwise secret ones. | ||
| 708 | Only non-revoked and non-expired keys are returned whose primary key is | ||
| 709 | not disabled. | ||
| 710 | NAME can be an e-mail address or a key ID. | ||
| 711 | If NAME just consists of hexadecimal digits (possibly prefixed by \"0x\"), it | ||
| 712 | is treated as key ID for which at most one key must exist in the keyring. | ||
| 713 | Otherwise, NAME is treated as user ID, for which no keys are returned if it | ||
| 714 | is expired or revoked. | ||
| 715 | If 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. | ||
| 735 | This inspects the keyrings to find keys for each name in NAMES. If several | ||
| 736 | keys are found for a name, `mml-secure-select-keys' is used to look for | ||
| 737 | customized preferences or have the user select preferable ones. | ||
| 738 | When `mml-secure-fail-when-key-problem' is t, fail with an error in | ||
| 739 | case 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. | ||
| 771 | Currently, 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. | ||
| 778 | KEYS should be a list with multiple entries. | ||
| 779 | NAME is normalized first as customized keys are inspected. | ||
| 780 | When `mml-secure-fail-when-key-problem' is t, fail with an error in case of | ||
| 781 | outdated 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 "\ | ||
| 794 | Customized keys | ||
| 795 | (%s) | ||
| 796 | for %s not available any more. | ||
| 797 | Select 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 "\ | ||
| 803 | Multiple %s keys for: | ||
| 804 | %s | ||
| 805 | Select 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. | ||
| 810 | Return 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. | ||
| 829 | Returned names may be e-mail addresses or key IDs and are determined based | ||
| 830 | on `mml-secure-openpgp-signers' and `mml-secure-openpgp-sign-with-sender' with | ||
| 831 | OpenPGP or `mml-secure-smime-signers' and `mml-secure-smime-sign-with-sender' | ||
| 832 | with 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. | ||
| 843 | If `mm-sign-option' is `guided', the user is asked to choose. | ||
| 844 | Otherwise, `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 "\ | ||
| 849 | Select keys for signing. | ||
| 850 | If 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. | ||
| 856 | PROTOCOL 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. | ||
| 868 | PROTOCOL specifies OpenPGP or S/MIME with matching CONTEXT and CONFIG | ||
| 869 | for 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 "\ | ||
| 886 | Select recipients for encryption. | ||
| 887 | If 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. |
| 37 | Defaults to EPG if it's loaded." | 43 | Defaults to EPG if it's available. |
| 44 | If you think about using OpenSSL, please read the BUGS section in the manual | ||
| 45 | for 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 "\ | ||
| 418 | Select keys for signing. | ||
| 419 | If 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 | ||
| 471 | Content-Transfer-Encoding: base64 | 382 | Content-Transfer-Encoding: base64 |
| 472 | Content-Disposition: attachment; filename=smime.p7s | 383 | Content-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 "\ | ||
| 511 | Select recipients for encryption. | ||
| 512 | If 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. |
| 69 | Whether the passphrase is cached at all is controlled by | 72 | Whether 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. | ||
| 319 | If 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. | ||
| 415 | If 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. | ||
| 435 | If 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 "\ | ||
| 1082 | Select keys for signing. | ||
| 1083 | If 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 "\ | ||
| 1175 | Select recipients for encryption. | ||
| 1176 | If 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 "\ | ||
| 1201 | Select keys for signing. | ||
| 1202 | If 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" |