From 5213ded9aab68d83c306aa2f4880c8a1abd3608c Mon Sep 17 00:00:00 2001 From: Jens Lechtenboerger Date: Sun, 3 Jan 2016 01:10:34 +0000 Subject: [PATCH] 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 . 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. --- doc/misc/message.texi | 195 ++++++++++++-- lisp/gnus/gnus-util.el | 25 ++ lisp/gnus/mml-sec.el | 579 ++++++++++++++++++++++++++++++++++++++++- lisp/gnus/mml-smime.el | 273 +++++-------------- lisp/gnus/mml1991.el | 203 ++------------- 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. @cindex encrypt @cindex secure -Using the @acronym{MML} language, Message is able to create digitally -signed and digitally encrypted messages. Message (or rather -@acronym{MML}) currently support @acronym{PGP} (RFC 1991), -@acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}. +By default, e-mails are transmitted without any protection around the +Internet, which implies that they can be read and changed by lots of +different parties. In particular, they are analyzed under bulk +surveillance, which violates basic human rights. To defend those +rights, digital self-defense is necessary (in addition to legal +changes), and encryption and digital signatures are powerful +techniques for self-defense. In essence, encryption ensures that +only the intended recipient will be able to read a message, while +digital signatures make sure that modifications to messages can be +detected by the recipient. + +Nowadays, there are two major incompatible e-mail encryption +standards, namely @acronym{OpenPGP} and @acronym{S/MIME}. Both of +these standards are implemented by the @uref{https://www.gnupg.org/, +GNU Privacy Guard (GnuPG)}, which needs to be installed as external +software in addition to GNU Emacs. Before you can start to encrypt, +decrypt, and sign messages, you need to create a so-called key-pair, +which consists of a private key and a public key. Your @emph{public} key +(also known as @emph{certificate}, in particular with @acronym{S/MIME}), is +used by others (a) to encrypt messages intended for you and (b) to verify +digital signatures created by you. In contrast, you use your @emph{private} +key (a) to decrypt messages and (b) to sign messages. (You may want to +think of your public key as an open safe that you offer to others such +that they can deposit messages and lock the door, while your private +key corresponds to the opening combination for the safe.) + +Thus, you need to perform the following steps for e-mail encryption, +typically outside Emacs. See, for example, the +@uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy +Handbook} for details covering the standard @acronym{OpenPGP} with +@acronym{GnuPG}. +@enumerate +@item +Install GnuPG. +@item +Create a key-pair for your own e-mail address. +@item +Distribute your public key, e.g., via upload to key servers. +@item +Import the public keys for the recipients to which you want to send +encrypted e-mails. +@end enumerate + +Whether to use the standard @acronym{OpenPGP} or @acronym{S/MIME} is +beyond the scope of this documentation. Actually, you can use one +standard for one set of recipients and the other standard for +different recipients (depending their preferences or capabilities). + +In case you are not familiar with all those acronyms: The standard +@acronym{OpenPGP} is also called @acronym{PGP} (Pretty Good Privacy). +The command line tools offered by @acronym{GnuPG} for +@acronym{OpenPGP} are called @command{gpg} and @command{gpg2}, while +the one for @acronym{S/MIME} is called @command{gpgsm}. An +alternative, but discouraged, tool for @acronym{S/MIME} is +@command{openssl}. To make matters worse, e-mail messages can be +formed in two different ways with @acronym{OpenPGP}, namely +@acronym{PGP} (RFC 1991/4880) and @acronym{PGP/MIME} (RFC 2015/3156). + +The good news, however, is the following: In GNU Emacs, Message +supports all those variants, comes with reasonable defaults that can +be customized according to your needs, and invokes the proper command +line tools behind the scenes for encryption, decryption, as well as +creation and verification of digital signatures. + +Message uses the @acronym{MML} language for the creation of signed +and/or encrypted messages as explained in the following. + @menu * Signing and encryption:: Signing and encrypting commands. * Using S/MIME:: Using S/MIME -* Using PGP/MIME:: Using PGP/MIME +* Using OpenPGP:: Using OpenPGP +* Passphrase caching:: How to cache passphrases * PGP Compatibility:: Compatibility with older implementations +* Encrypt-to-self:: Reading your own encrypted messages +* Bcc Warning:: Do not use encryption with Bcc headers @end menu @node Signing and encryption @@ -1041,11 +1107,45 @@ programs are required to make things work, and some small general hints. @node Using S/MIME @subsection Using S/MIME -@emph{Note!} This section assume you have a basic familiarity with -modern cryptography, @acronym{S/MIME}, various PKCS standards, OpenSSL and -so on. +@acronym{S/MIME} requires an external implementation, such as +@uref{https://www.gnupg.org/, GNU Privacy Guard} or +@uref{https://www.openssl.org/, OpenSSL}. The default Emacs interface +to the S/MIME implementation is EasyPG (@pxref{Top,,EasyPG Assistant +User's Manual, epa, EasyPG Assistant User's Manual}), which has been +included in Emacs since version 23 and which relies on the command +line tool @command{gpgsm} provided by @acronym{GnuPG}. That tool +implements certificate management, including certificate revocation +and expiry, while such tasks need to be performed manually, if OpenSSL +is used. + +The choice between EasyPG and OpenSSL is controlled by the variable +@code{mml-smime-use}, which needs to be set to the value @code{epg} +for EasyPG. Depending on your version of Emacs that value may be the +default; if not, you can either customize that variable or place the +following line in your @file{.emacs} file (that line needs to be +placed above other code related to message/gnus/encryption): + +@lisp +(require 'epg) +@end lisp + +Moreover, you may want to customize the variables +@code{mml-default-encrypt-method} and +@code{mml-default-sign-method} to the string @code{"smime"}. + +That's all if you want to use S/MIME with EasyPG, and that's the +recommended way of using S/MIME with Message. + +If you think about using OpenSSL instead of EasyPG, please read the +BUGS section in the manual for the @command{smime} command coming with +OpenSSL first. If you still want to use OpenSSL, the following +applies. + +@emph{Note!} The remainder of this section assumes you have a basic +familiarity with modern cryptography, @acronym{S/MIME}, various PKCS +standards, OpenSSL and so on. -The @acronym{S/MIME} support in Message (and @acronym{MML}) require +The @acronym{S/MIME} support in Message (and @acronym{MML}) can use OpenSSL@. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt operations. OpenSSL can be found at @uref{http://www.openssl.org/}. 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 you are on a secure single user machine) simply press @code{RET} at the passphrase prompt. -@node Using PGP/MIME -@subsection Using PGP/MIME +@node Using OpenPGP +@subsection Using OpenPGP -@acronym{PGP/MIME} requires an external OpenPGP implementation, such -as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP +Use of OpenPGP requires an external software, such +as @uref{https://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP implementations such as PGP 2.x and PGP 5.x are also supported. The default Emacs interface to the PGP implementation is EasyPG (@pxref{Top,,EasyPG Assistant User's Manual, epa, EasyPG Assistant User's Manual}), but PGG (@pxref{Top, ,PGG, pgg, PGG Manual}) and Mailcrypt are also supported. @xref{PGP Compatibility}. +As stated earlier, messages encrypted with OpenPGP can be formatted +according to two different standards, namely @acronym{PGP} or +@acronym{PGP/MIME}. The variables +@code{mml-default-encrypt-method} and +@code{mml-default-sign-method} determine which variant to prefer, +@acronym{PGP/MIME} by default. + +@node Passphrase caching +@subsection Passphrase caching + @cindex gpg-agent -Message internally calls GnuPG (the @command{gpg} command) to perform +Message with EasyPG internally calls GnuPG (the @command{gpg} or +@command{gpgsm} command) to perform data encryption, and in certain cases (decrypting or signing for -example), @command{gpg} requires user's passphrase. Currently the -recommended way to supply your passphrase to @command{gpg} is to use the +example), @command{gpg}/@command{gpgsm} requires user's passphrase. +Currently the recommended way to supply your passphrase is to use the @command{gpg-agent} program. -To use @command{gpg-agent} in Emacs, you need to run the following -command from the shell before starting Emacs. +In particular, the @command{gpg-agent} program supports passphrase +caching so that you do not need to enter your passphrase for every +decryption/sign operation. @xref{Agent Options, , , gnupg, Using the +GNU Privacy Guard}. + +How to use @command{gpg-agent} in Emacs depends on your version of +GnuPG. With GnuPG version 2.1, @command{gpg-agent} is started +automatically if necessary. With older versions you may need to run +the following command from the shell before starting Emacs. @example eval `gpg-agent --daemon` @@ -1135,11 +1253,10 @@ GNU Privacy Guard}. Once your @command{gpg-agent} is set up, it will ask you for a passphrase as needed for @command{gpg}. Under the X Window System, you will see a new passphrase input dialog appear. The dialog is -provided by PIN Entry (the @command{pinentry} command), and as of -version 0.7.2, @command{pinentry} cannot cooperate with Emacs on a -single tty. So, if you are using a text console, you may need to put -a passphrase into gpg-agent's cache beforehand. The following command -does the trick. +provided by PIN Entry (the @command{pinentry} command), reasonably +recent versions of which can also cooperate with Emacs on a text +console. If that does not work, you may need to put a passphrase into +gpg-agent's cache beforehand. The following command does the trick. @example gpg --use-agent --sign < /dev/null > /dev/null @@ -1181,6 +1298,38 @@ message that can be understood by PGP version 2. (Refer to @uref{http://www.gnupg.org/gph/en/pgp2x.html} for more information about the problem.) +@node Encrypt-to-self +@subsection Encrypt-to-self + +By default, messages are encrypted to all recipients (@code{To}, +@code{Cc}, @code{Bcc} headers). Thus, you will not be able to decrypt +your own messages. To make sure that messages are also encrypted to +your own key(s), several alternative solutions exist: +@enumerate +@item +Use the @code{encrypt-to} option in the file @file{gpg.conf} (for +OpenPGP) or @file{gpgsm.conf} (for @acronym{S/MIME} with EasyPG). +@xref{Invoking GPG, , , gnupg, Using the GNU Privacy Guard}, or +@xref{Invoking GPGSM, , , gnupg, Using the GNU Privacy Guard}. +@item +Include your own e-mail address (for which you created a key-pair) +among the recipients. +@item +Customize the variable @code{mml-secure-openpgp-encrypt-to-self} (for +OpenPGP) or @code{mml-secure-smime-encrypt-to-self} (for +@acronym{S/MIME} with EasyPG). +@end enumerate + +@node Bcc Warning +@subsection Bcc Warning + +The @code{Bcc} header is meant to hide recipients of messages. +However, when encrypted messages are used, the e-mail addresses of all +@code{Bcc}-headers are given away to all recipients without +warning, which is a bug, see +@uref{https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718}. + + @node Various Commands @section Various Commands 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." (defun gnus-timer--function (timer) (elt timer 5))) +(defun gnus-test-list (list predicate) + "To each element of LIST apply PREDICATE. +Return nil if LIST is no list or is empty or some test returns nil; +otherwise, return t." + (when (and list (listp list)) + (let ((result (mapcar predicate list))) + (not (memq nil result))))) + +(defun gnus-subsetp (list1 list2) + "Return t if LIST1 is a subset of LIST2. +Similar to `subsetp' but use member for element test so that this works for +lists of strings." + (when (and (listp list1) (listp list2)) + (if list1 + (and (member (car list1) list2) + (gnus-subsetp (cdr list1) list2)) + t))) + +(defun gnus-setdiff (list1 list2) + "Return member-based set difference of LIST1 and LIST2." + (when (and list1 (listp list1) (listp list2)) + (if (member (car list1) list2) + (gnus-setdiff (cdr list1) list2) + (cons (car list1) (gnus-setdiff (cdr list1) list2))))) + (provide 'gnus-util) ;;; 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 @@ (eval-when-compile (require 'cl)) -(autoload 'gnus-subsetp "gnus-util") +(require 'gnus-util) +(require 'epg) + (autoload 'mail-strip-quoted-names "mail-utils") (autoload 'mml2015-sign "mml2015") (autoload 'mml2015-encrypt "mml2015") @@ -40,6 +42,7 @@ (autoload 'mml-smime-encrypt-query "mml-smime") (autoload 'mml-smime-verify "mml-smime") (autoload 'mml-smime-verify-test "mml-smime") +(autoload 'epa--select-keys "epa") (defvar mml-sign-alist '(("smime" mml-smime-sign-buffer mml-smime-sign-query) @@ -91,7 +94,7 @@ signs and encrypt the message in one step. Note that the output generated by using a `combined' mode is NOT understood by all PGP implementations, in particular PGP version -2 does not support it! See Info node `(message)Security' for +2 does not support it! See Info node `(message) Security' for details." :version "22.1" :group 'message @@ -111,7 +114,9 @@ details." (if (boundp 'password-cache) password-cache t) - "If t, cache passphrase." + "If t, cache OpenPGP or S/MIME passphrases inside Emacs. +Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead. +See Info node `(message) Security'." :group 'message :type 'boolean) @@ -125,6 +130,21 @@ Whether the passphrase is cached at all is controlled by :group 'message :type 'integer) +(defcustom mml-secure-safe-bcc-list nil + "List of e-mail addresses that are safe to use in Bcc headers. +EasyPG encrypts e-mails to Bcc addresses, and the encrypted e-mail +by default identifies the used encryption keys, giving away the +Bcc'ed identities. Clearly, this contradicts the original goal of +*blind* copies. +For an academic paper explaining the problem, see URL +`http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'. +Use this variable to specify e-mail addresses whose owners do not +mind if they are identifiable as recipients. This may be useful if +you use Bcc headers to encrypt e-mails to yourself." + :version "25.1" + :group 'message + :type '(repeat string)) + ;;; Configuration/helper functions (defun mml-signencrypt-style (method &optional style) @@ -275,6 +295,36 @@ Use METHOD if given. Else use `mml-secure-method' or (interactive) (mml-secure-part "smime")) +(defun mml-secure-is-encrypted-p () + "Check whether secure encrypt tag is present." + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n" + "<#secure[^>]+encrypt") + nil t))) + +(defun mml-secure-bcc-is-safe () + "Check whether usage of Bcc is safe (or absent). +Bcc usage is safe in two cases: first, if the current message does +not contain an MML secure encrypt tag; +second, if the Bcc addresses are a subset of `mml-secure-safe-bcc-list'. +In all other cases, ask the user whether Bcc usage is safe. +Raise error if user answers no. +Note that this function does not produce a meaningful return value: +either an error is raised or not." + (when (mml-secure-is-encrypted-p) + (let ((bcc (mail-strip-quoted-names (message-fetch-field "bcc")))) + (when bcc + (let ((bcc-list (mapcar #'cadr + (mail-extract-address-components bcc t)))) + (unless (gnus-subsetp bcc-list mml-secure-safe-bcc-list) + (unless (yes-or-no-p "Message for encryption contains Bcc header.\ + This may give away all Bcc'ed identities to all recipients.\ + Are you sure that this is safe?\ + (Customize `mml-secure-safe-bcc-list' to avoid this warning.) ") + (error "Aborted")))))))) + ;; defuns that add the proper <#secure ...> tag to the top of the message body (defun mml-secure-message (method &optional modesym) (let ((mode (prin1-to-string modesym)) @@ -380,6 +430,529 @@ If called with a prefix argument, only encrypt (do NOT sign)." (interactive "P") (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) +;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el + +(define-obsolete-variable-alias 'mml1991-signers 'mml-secure-openpgp-signers) +(define-obsolete-variable-alias 'mml2015-signers 'mml-secure-openpgp-signers) +(defcustom mml-secure-openpgp-signers nil + "A list of your own key ID(s) which will be used to sign OpenPGP messages. +If set, it is added to the setting of `mml-secure-openpgp-sign-with-sender'." + :group 'mime-security + :type '(repeat (string :tag "Key ID"))) + +(define-obsolete-variable-alias 'mml-smime-signers 'mml-secure-smime-signers) +(defcustom mml-secure-smime-signers nil + "A list of your own key ID(s) which will be used to sign S/MIME messages. +If set, it is added to the setting of `mml-secure-smime-sign-with-sender'." + :group 'mime-security + :type '(repeat (string :tag "Key ID"))) + +(define-obsolete-variable-alias + 'mml1991-encrypt-to-self 'mml-secure-openpgp-encrypt-to-self) +(define-obsolete-variable-alias + 'mml2015-encrypt-to-self 'mml-secure-openpgp-encrypt-to-self) +(defcustom mml-secure-openpgp-encrypt-to-self nil + "List of own key ID(s) or t; determines additional recipients with OpenPGP. +If t, also encrypt to key for message sender; if list, encrypt to those keys. +With this variable, you can ensure that you can decrypt your own messages. +Alternatives to this variable include Bcc'ing the message to yourself or +using the encrypt-to or hidden-encrypt-to option in gpg.conf (see man gpg(1)). +Note that this variable and the encrypt-to option give away your identity +for *every* encryption without warning, which is not what you want if you are +using, e.g., remailers. +Also, use of Bcc gives away your identity for *every* encryption without +warning, which is a bug, see: +https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718" + :group 'mime-security + :type '(choice (const :tag "None" nil) + (const :tag "From address" t) + (repeat (string :tag "Key ID")))) + +(define-obsolete-variable-alias + 'mml-smime-encrypt-to-self 'mml-secure-smime-encrypt-to-self) +(defcustom mml-secure-smime-encrypt-to-self nil + "List of own key ID(s) or t; determines additional recipients with S/MIME. +If t, also encrypt to key for message sender; if list, encrypt to those keys. +With this variable, you can ensure that you can decrypt your own messages. +Alternatives to this variable include Bcc'ing the message to yourself or +using the encrypt-to option in gpgsm.conf (see man gpgsm(1)). +Note that this variable and the encrypt-to option give away your identity +for *every* encryption without warning, which is not what you want if you are +using, e.g., remailers. +Also, use of Bcc gives away your identity for *every* encryption without +warning, which is a bug, see: +https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18718" + :group 'mime-security + :type '(choice (const :tag "None" nil) + (const :tag "From address" t) + (repeat (string :tag "Key ID")))) + +(define-obsolete-variable-alias + 'mml2015-sign-with-sender 'mml-secure-openpgp-sign-with-sender) +;mml1991-sign-with-sender did never exist. +(defcustom mml-secure-openpgp-sign-with-sender nil + "If t, use message sender to find an OpenPGP key to sign with." + :group 'mime-security + :type 'boolean) + +(define-obsolete-variable-alias + 'mml-smime-sign-with-sender 'mml-secure-smime-sign-with-sender) +(defcustom mml-secure-smime-sign-with-sender nil + "If t, use message sender to find an S/MIME key to sign with." + :group 'mime-security + :type 'boolean) + +(define-obsolete-variable-alias + 'mml2015-always-trust 'mml-secure-openpgp-always-trust) +;mml1991-always-trust did never exist. +(defcustom mml-secure-openpgp-always-trust t + "If t, skip key validation of GnuPG on encryption." + :group 'mime-security + :type 'boolean) + +(defcustom mml-secure-fail-when-key-problem nil + "If t, raise an error if some key is missing or several keys exist. +Otherwise, ask the user." + :group 'mime-security + :type 'boolean) + +(defcustom mml-secure-key-preferences + '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))) + "Protocol- and usage-specific fingerprints of preferred keys. +This variable is only relevant if a recipient owns multiple key pairs (for +encryption) or you own multiple key pairs (for signing). In such cases, +you will be asked which key(s) should be used, and your choice can be +customized in this variable." + :group 'mime-security + :type '(alist :key-type (symbol :tag "Protocol") :value-type + (alist :key-type (symbol :tag "Usage") :value-type + (alist :key-type (string :tag "Name") :value-type + (repeat (string :tag "Fingerprint")))))) + +(defun mml-secure-cust-usage-lookup (context usage) + "Return preferences for CONTEXT and USAGE." + (let* ((protocol (epg-context-protocol context)) + (protocol-prefs (cdr (assoc protocol mml-secure-key-preferences)))) + (assoc usage protocol-prefs))) + +(defun mml-secure-cust-fpr-lookup (context usage name) + "Return fingerprints of preferred keys for CONTEXT, USAGE, and NAME." + (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage)) + (fprs (assoc name (cdr usage-prefs)))) + (when fprs + (cdr fprs)))) + +(defun mml-secure-cust-record-keys (context usage name keys &optional save) + "For CONTEXT, USAGE, and NAME record fingerprint(s) of KEYS. +If optional SAVE is not nil, save customized fingerprints. +Return keys." + (assert keys) + (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage)) + (curr-fprs (cdr (assoc name (cdr usage-prefs)))) + (key-fprs (mapcar 'mml-secure-fingerprint keys)) + (new-fprs (gnus-union curr-fprs key-fprs :test 'equal))) + (if curr-fprs + (setcdr (assoc name (cdr usage-prefs)) new-fprs) + (setcdr usage-prefs (cons (cons name new-fprs) (cdr usage-prefs)))) + (when save + (customize-save-variable + 'mml-secure-key-preferences mml-secure-key-preferences)) + keys)) + +(defun mml-secure-cust-remove-keys (context usage name) + "Remove keys for CONTEXT, USAGE, and NAME. +Return t if a customization for NAME was present (and has been removed)." + (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage)) + (current (assoc name usage-prefs))) + (when current + (setcdr usage-prefs (remove current (cdr usage-prefs))) + t))) + +(defvar mml-secure-secret-key-id-list nil) + +(defun mml-secure-add-secret-key-id (key-id) + "Record KEY-ID in list of secret keys." + (add-to-list 'mml-secure-secret-key-id-list key-id)) + +(defun mml-secure-clear-secret-key-id-list () + "Remove passwords from cache and clear list of secret keys." + ;; Loosely based on code inside mml2015-epg-encrypt, + ;; mml2015-epg-clear-decrypt, and mml2015-epg-decrypt + (dolist (key-id mml-secure-secret-key-id-list nil) + (password-cache-remove key-id)) + (setq mml-secure-secret-key-id-list nil)) + +(defvar mml1991-cache-passphrase) +(defvar mml1991-passphrase-cache-expiry) + +(defun mml-secure-cache-passphrase-p (protocol) + "Return t if OpenPGP or S/MIME passphrases should be cached for PROTOCOL. +Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead." + (or (and (eq 'OpenPGP protocol) + (or mml-secure-cache-passphrase + (and (boundp 'mml2015-cache-passphrase) + mml2015-cache-passphrase) + (and (boundp 'mml1991-cache-passphrase) + mml1991-cache-passphrase))) + (and (eq 'CMS protocol) + (or mml-secure-cache-passphrase + (and (boundp 'mml-smime-cache-passphrase) + mml-smime-cache-passphrase))))) + +(defun mml-secure-cache-expiry-interval (protocol) + "Return time in seconds to cache passphrases for PROTOCOL. +Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead." + (or (and (eq 'OpenPGP protocol) + (or (and (boundp 'mml2015-passphrase-cache-expiry) + mml2015-passphrase-cache-expiry) + (and (boundp 'mml1991-passphrase-cache-expiry) + mml1991-passphrase-cache-expiry) + mml-secure-passphrase-cache-expiry)) + (and (eq 'CMS protocol) + (or (and (boundp 'mml-smime-passphrase-cache-expiry) + mml-smime-passphrase-cache-expiry) + mml-secure-passphrase-cache-expiry)))) + +(defun mml-secure-passphrase-callback (context key-id standard) + "Ask for passphrase in CONTEXT for KEY-ID for STANDARD. +The passphrase is read and cached." + ;; Based on mml2015-epg-passphrase-callback. + (if (eq key-id 'SYM) + (epg-passphrase-callback-function context key-id nil) + (let* ((password-cache-key-id + (if (eq key-id 'PIN) + "PIN" + key-id)) + (entry (assoc key-id epg-user-id-alist)) + (passphrase + (password-read + (if (eq key-id 'PIN) + "Passphrase for PIN: " + (if entry + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))) + ;; TODO: With mml-smime.el, password-cache-key-id is not passed + ;; as argument to password-read. + ;; Is that on purpose? If so, the following needs to be placed + ;; inside an if statement. + password-cache-key-id))) + (when passphrase + (let ((password-cache-expiry (mml-secure-cache-expiry-interval + (epg-context-protocol context)))) + (password-cache-add password-cache-key-id passphrase)) + (mml-secure-add-secret-key-id password-cache-key-id) + (copy-sequence passphrase))))) + +(defun mml-secure-check-user-id (key recipient) + "Check whether KEY has a non-revoked, non-expired UID for RECIPIENT." + ;; Based on mml2015-epg-check-user-id. + (let ((uids (epg-key-user-id-list key))) + (catch 'break + (dolist (uid uids nil) + (if (and (stringp (epg-user-id-string uid)) + (equal (car (mail-header-parse-address + (epg-user-id-string uid))) + (car (mail-header-parse-address + recipient))) + (not (memq (epg-user-id-validity uid) + '(revoked expired)))) + (throw 'break t)))))) + +(defun mml-secure-secret-key-exists-p (context subkey) + "Return t if keyring for CONTEXT contains secret key for public SUBKEY." + (let* ((fpr (epg-sub-key-fingerprint subkey)) + (candidates (epg-list-keys context fpr 'secret)) + (candno (length candidates))) + ;; If two or more subkeys with the same fingerprint exist, something is + ;; terribly wrong. + (when (>= candno 2) + (error "Found %d secret keys with same fingerprint %s" candno fpr)) + (= 1 candno))) + +(defun mml-secure-check-sub-key (context key usage &optional fingerprint) + "Check whether in CONTEXT the public KEY has a usable subkey for USAGE. +This is the case if KEY is not disabled, and there is a subkey for +USAGE that is neither revoked nor expired. Additionally, if optional +FINGERPRINT is present and if it is not the primary key's fingerprint, then +the returned subkey must have that FINGERPRINT. FINGERPRINT must consist of +hexadecimal digits only (no leading \"0x\" allowed). +If USAGE is not `encrypt', then additionally an appropriate secret key must +be present in the keyring." + ;; Based on mml2015-epg-check-sub-key, extended by + ;; - check for secret keys if usage is not 'encrypt and + ;; - check for new argument FINGERPRINT. + (let* ((subkeys (epg-key-sub-key-list key)) + (primary (car subkeys)) + (fpr (epg-sub-key-fingerprint primary))) + ;; The primary key will be marked as disabled, when the entire + ;; key is disabled (see 12 Field, Format of colon listings, in + ;; gnupg/doc/DETAILS) + (unless (memq 'disabled (epg-sub-key-capability primary)) + (catch 'break + (dolist (subkey subkeys nil) + (if (and (memq usage (epg-sub-key-capability subkey)) + (not (memq (epg-sub-key-validity subkey) + '(revoked expired))) + (or (eq 'encrypt usage) ; Encryption works with public key. + ;; In contrast, signing requires secret key. + (mml-secure-secret-key-exists-p context subkey)) + (or (not fingerprint) + (gnus-string-match-p (concat fingerprint "$") fpr) + (gnus-string-match-p (concat fingerprint "$") + (epg-sub-key-fingerprint subkey)))) + (throw 'break t))))))) + +(defun mml-secure-find-usable-keys (context name usage &optional justone) + "In CONTEXT return a list of keys for NAME and USAGE. +If USAGE is `encrypt' public keys are returned, otherwise secret ones. +Only non-revoked and non-expired keys are returned whose primary key is +not disabled. +NAME can be an e-mail address or a key ID. +If NAME just consists of hexadecimal digits (possibly prefixed by \"0x\"), it +is treated as key ID for which at most one key must exist in the keyring. +Otherwise, NAME is treated as user ID, for which no keys are returned if it +is expired or revoked. +If optional JUSTONE is not nil, return the first key instead of a list." + (let* ((keys (epg-list-keys context name)) + (iskeyid (string-match "\\(0x\\)?\\([0-9a-fA-F]\\{8,\\}\\)" name)) + (fingerprint (match-string 2 name)) + result) + (when (and iskeyid (>= (length keys) 2)) + (error + "Name %s (for %s) looks like a key ID but multiple keys found" + name usage)) + (catch 'break + (dolist (key keys result) + (if (and (or iskeyid + (mml-secure-check-user-id key name)) + (mml-secure-check-sub-key context key usage fingerprint)) + (if justone + (throw 'break key) + (push key result))))))) + +(defun mml-secure-select-preferred-keys (context names usage) + "Return list of preferred keys in CONTEXT for NAMES and USAGE. +This inspects the keyrings to find keys for each name in NAMES. If several +keys are found for a name, `mml-secure-select-keys' is used to look for +customized preferences or have the user select preferable ones. +When `mml-secure-fail-when-key-problem' is t, fail with an error in +case of missing, outdated, or multiple keys." + ;; Loosely based on code appearing inside mml2015-epg-sign and + ;; mml2015-epg-encrypt. + (apply + #'nconc + (mapcar + (lambda (name) + (let* ((keys (mml-secure-find-usable-keys context name usage)) + (keyno (length keys))) + (cond ((= 0 keyno) + (when (or mml-secure-fail-when-key-problem + (not (y-or-n-p + (format "No %s key for %s; skip it? " + usage name)))) + (error "No %s key for %s" usage name))) + ((= 1 keyno) keys) + (t (mml-secure-select-keys context name keys usage))))) + names))) + +(defun mml-secure-fingerprint (key) + "Return fingerprint for public KEY." + (epg-sub-key-fingerprint (car (epg-key-sub-key-list key)))) + +(defun mml-secure-filter-keys (keys fprs) + "Filter KEYS to subset with fingerprints in FPRS." + (when keys + (if (member (mml-secure-fingerprint (car keys)) fprs) + (cons (car keys) (mml-secure-filter-keys (cdr keys) fprs)) + (mml-secure-filter-keys (cdr keys) fprs)))) + +(defun mml-secure-normalize-cust-name (name) + "Normalize NAME to be used for customization. +Currently, remove ankle brackets." + (if (string-match "^<\\(.*\\)>$" name) + (match-string 1 name) + name)) + +(defun mml-secure-select-keys (context name keys usage) + "In CONTEXT for NAME select among KEYS for USAGE. +KEYS should be a list with multiple entries. +NAME is normalized first as customized keys are inspected. +When `mml-secure-fail-when-key-problem' is t, fail with an error in case of +outdated or multiple keys." + (let* ((nname (mml-secure-normalize-cust-name name)) + (fprs (mml-secure-cust-fpr-lookup context usage nname)) + (usable-fprs (mapcar 'mml-secure-fingerprint keys))) + (if fprs + (if (gnus-subsetp fprs usable-fprs) + (mml-secure-filter-keys keys fprs) + (mml-secure-cust-remove-keys context usage nname) + (let ((diff (gnus-setdiff fprs usable-fprs))) + (if mml-secure-fail-when-key-problem + (error "Customization of %s keys for %s outdated" usage nname) + (mml-secure-select-keys-1 + context nname keys usage (format "\ +Customized keys + (%s) +for %s not available any more. +Select anew. " + diff nname))))) + (if mml-secure-fail-when-key-problem + (error "Multiple %s keys for %s" usage nname) + (mml-secure-select-keys-1 + context nname keys usage (format "\ +Multiple %s keys for: + %s +Select preferred one(s). " + usage nname)))))) + +(defun mml-secure-select-keys-1 (context name keys usage message) + "In CONTEXT for NAME let user select among KEYS for USAGE, showing MESSAGE. +Return selected keys." + (let* ((selected (epa--select-keys message keys)) + (selno (length selected)) + ;; TODO: y-or-n-p does not always resize the echo area but may + ;; truncate the message. Why? The following does not help. + ;; yes-or-no-p shows full message, though. + (message-truncate-lines nil)) + (if selected + (if (y-or-n-p + (format "%d %s key(s) selected. Store for %s? " + selno usage name)) + (mml-secure-cust-record-keys context usage name selected 'save) + selected) + (unless (y-or-n-p + (format "No %s key for %s; skip it? " usage name)) + (error "No %s key for %s" usage name))))) + +(defun mml-secure-signer-names (protocol sender) + "Determine signer names for PROTOCOL and message from SENDER. +Returned names may be e-mail addresses or key IDs and are determined based +on `mml-secure-openpgp-signers' and `mml-secure-openpgp-sign-with-sender' with +OpenPGP or `mml-secure-smime-signers' and `mml-secure-smime-sign-with-sender' +with S/MIME." + (if (eq 'OpenPGP protocol) + (append mml-secure-openpgp-signers + (if (and mml-secure-openpgp-sign-with-sender sender) + (list (concat "<" sender ">")))) + (append mml-secure-smime-signers + (if (and mml-secure-smime-sign-with-sender sender) + (list (concat "<" sender ">")))))) + +(defun mml-secure-signers (context signer-names) + "Determine signing keys in CONTEXT from SIGNER-NAMES. +If `mm-sign-option' is `guided', the user is asked to choose. +Otherwise, `mml-secure-select-preferred-keys' is used." + ;; Based on code appearing inside mml2015-epg-sign and + ;; mml2015-epg-encrypt. + (if (eq mm-sign-option 'guided) + (epa-select-keys context "\ +Select keys for signing. +If no one is selected, default secret key is used. " + signer-names t) + (mml-secure-select-preferred-keys context signer-names 'sign))) + +(defun mml-secure-self-recipients (protocol sender) + "Determine additional recipients based on encrypt-to-self variables. +PROTOCOL specifies OpenPGP or S/MIME for a message from SENDER." + (let ((encrypt-to-self + (if (eq 'OpenPGP protocol) + mml-secure-openpgp-encrypt-to-self + mml-secure-smime-encrypt-to-self))) + (when encrypt-to-self + (if (listp encrypt-to-self) + encrypt-to-self + (list sender))))) + +(defun mml-secure-recipients (protocol context config sender) + "Determine encryption recipients. +PROTOCOL specifies OpenPGP or S/MIME with matching CONTEXT and CONFIG +for a message from SENDER." + ;; Based on code appearing inside mml2015-epg-encrypt. + (let ((recipients + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list (concat "<" recipient ">")))) + (split-string + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+"))))) + (nconc recipients (mml-secure-self-recipients protocol sender)) + (if (eq mm-encrypt-option 'guided) + (setq recipients + (epa-select-keys context "\ +Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients)) + (setq recipients + (mml-secure-select-preferred-keys context recipients 'encrypt)) + (unless recipients + (error "No recipient specified"))) + recipients)) + +(defun mml-secure-epg-encrypt (protocol cont &optional sign) + ;; Based on code appearing inside mml2015-epg-encrypt. + (let* ((context (epg-make-context protocol)) + (config (epg-configuration)) + (sender (message-options-get 'message-sender)) + (recipients (mml-secure-recipients protocol context config sender)) + (signer-names (mml-secure-signer-names protocol sender)) + cipher signers) + (when sign + (setq signers (mml-secure-signers context signer-names)) + (epg-context-set-signers context signers)) + (when (eq 'OpenPGP protocol) + (epg-context-set-armor context t) + (epg-context-set-textmode context t)) + (when (mml-secure-cache-passphrase-p protocol) + (epg-context-set-passphrase-callback + context + (cons 'mml-secure-passphrase-callback protocol))) + (condition-case error + (setq cipher + (if (eq 'OpenPGP protocol) + (epg-encrypt-string context (buffer-string) recipients sign + mml-secure-openpgp-always-trust) + (epg-encrypt-string context (buffer-string) recipients)) + mml-secure-secret-key-id-list nil) + (error + (mml-secure-clear-secret-key-id-list) + (signal (car error) (cdr error)))) + cipher)) + +(defun mml-secure-epg-sign (protocol mode) + ;; Based on code appearing inside mml2015-epg-sign. + (let* ((context (epg-make-context protocol)) + (sender (message-options-get 'message-sender)) + (signer-names (mml-secure-signer-names protocol sender)) + (signers (mml-secure-signers context signer-names)) + signature micalg) + (when (eq 'OpenPGP protocol) + (epg-context-set-armor context t) + (epg-context-set-textmode context t)) + (epg-context-set-signers context signers) + (when (mml-secure-cache-passphrase-p protocol) + (epg-context-set-passphrase-callback + context + (cons 'mml-secure-passphrase-callback protocol))) + (condition-case error + (setq signature + (if (eq 'OpenPGP protocol) + (epg-sign-string context (buffer-string) mode) + (epg-sign-string context + (mm-replace-in-string (buffer-string) + "\n" "\r\n") t)) + mml-secure-secret-key-id-list nil) + (error + (mml-secure-clear-secret-key-id-list) + (signal (car error) (cdr error)))) + (if (epg-context-result-for context 'sign) + (setq micalg (epg-new-signature-digest-algorithm + (car (epg-context-result-for context 'sign))))) + (cons signature micalg))) + (provide 'mml-sec) ;;; 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 @@ (autoload 'message-narrow-to-headers "message") (autoload 'message-fetch-field "message") +;; Prefer epg over openssl if it is available as epg uses GnuPG's gpgsm, +;; which features full-fledged certificate management, while openssl requires +;; major manual efforts for certificate revocation and expiry and has bugs +;; as documented under man smime(1). +(ignore-errors (require 'epg)) + (defcustom mml-smime-use (if (featurep 'epg) 'epg 'openssl) - "Whether to use OpenSSL or EPG to decrypt S/MIME messages. -Defaults to EPG if it's loaded." + "Whether to use OpenSSL or EasyPG (EPG) to handle S/MIME messages. +Defaults to EPG if it's available. +If you think about using OpenSSL, please read the BUGS section in the manual +for the `smime' command coming with OpenSSL first. EasyPG is recommended." :group 'mime-security :type '(choice (const :tag "EPG" epg) (const :tag "OpenSSL" openssl))) @@ -57,6 +65,9 @@ Defaults to EPG if it's loaded." "If t, cache passphrase." :group 'mime-security :type 'boolean) +(make-obsolete-variable 'mml-smime-cache-passphrase + 'mml-secure-cache-passphrase + "25.1") (defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry "How many seconds the passphrase is cached. @@ -64,6 +75,9 @@ Whether the passphrase is cached at all is controlled by `mml-smime-cache-passphrase'." :group 'mime-security :type 'integer) +(make-obsolete-variable 'mml-smime-passphrase-cache-expiry + 'mml-secure-passphrase-cache-expiry + "25.1") (defcustom mml-smime-signers nil "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 ""))))) (if (setq cert (smime-cert-by-dns who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (gnus-format-message "`%s' not found. " who)))) + (setq bad (format "`%s' not found. " who)))) (quit)) result)) @@ -221,7 +235,7 @@ Whether the passphrase is cached at all is controlled by ""))))) (if (setq cert (smime-cert-by-ldap who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (gnus-format-message "`%s' not found. " who)))) + (setq bad (format "`%s' not found. " who)))) (quit)) result)) @@ -317,82 +331,28 @@ Whether the passphrase is cached at all is controlled by (defvar inhibit-redisplay) (defvar password-cache-expiry) -(autoload 'epg-make-context "epg") -(autoload 'epg-passphrase-callback-function "epg") -(declare-function epg-context-set-signers "epg" (context signers)) -(declare-function epg-context-result-for "epg" (context name)) -(declare-function epg-new-signature-digest-algorithm "epg" (cl-x) t) -(declare-function epg-verify-result-to-string "epg" (verify-result)) -(declare-function epg-list-keys "epg" (context &optional name mode)) -(declare-function epg-verify-string "epg" - (context signature &optional signed-text)) -(declare-function epg-sign-string "epg" (context plain &optional mode)) -(declare-function epg-encrypt-string "epg" - (context plain recipients &optional sign always-trust)) -(declare-function epg-context-set-passphrase-callback "epg" - (context passphrase-callback)) -(declare-function epg-sub-key-fingerprint "epg" (cl-x) t) -(declare-function epg-configuration "epg-config" ()) -(declare-function epg-expand-group "epg-config" (config group)) -(declare-function epa-select-keys "epa" - (context prompt &optional names secret)) - -(defvar mml-smime-epg-secret-key-id-list nil) - -(defun mml-smime-epg-passphrase-callback (context key-id ignore) - (if (eq key-id 'SYM) - (epg-passphrase-callback-function context key-id nil) - (let* (entry - (passphrase - (password-read - (if (eq key-id 'PIN) - "Passphrase for PIN: " - (if (setq entry (assoc key-id epg-user-id-alist)) - (format "Passphrase for %s %s: " key-id (cdr entry)) - (format "Passphrase for %s: " key-id))) - (if (eq key-id 'PIN) - "PIN" - key-id)))) - (when passphrase - (let ((password-cache-expiry mml-smime-passphrase-cache-expiry)) - (password-cache-add key-id passphrase)) - (setq mml-smime-epg-secret-key-id-list - (cons key-id mml-smime-epg-secret-key-id-list)) - (copy-sequence passphrase))))) - -(declare-function epg-key-sub-key-list "epg" (key) t) -(declare-function epg-sub-key-capability "epg" (sub-key) t) -(declare-function epg-sub-key-validity "epg" (sub-key) t) - -(defun mml-smime-epg-find-usable-key (keys usage) - (catch 'found - (while keys - (let ((pointer (epg-key-sub-key-list (car keys)))) - (while pointer - (if (and (memq usage (epg-sub-key-capability (car pointer))) - (not (memq (epg-sub-key-validity (car pointer)) - '(revoked expired)))) - (throw 'found (car keys))) - (setq pointer (cdr pointer)))) - (setq keys (cdr keys))))) - -;; XXX: since gpg --list-secret-keys does not return validity of each -;; key, `mml-smime-epg-find-usable-key' defined above is not enough for -;; secret keys. The function `mml-smime-epg-find-usable-secret-key' -;; below looks at appropriate public keys to check usability. -(defun mml-smime-epg-find-usable-secret-key (context name usage) - (let ((secret-keys (epg-list-keys context name t)) - secret-key) - (while (and (not secret-key) secret-keys) - (if (mml-smime-epg-find-usable-key - (epg-list-keys context (epg-sub-key-fingerprint - (car (epg-key-sub-key-list - (car secret-keys))))) - usage) - (setq secret-key (car secret-keys) - secret-keys nil) - (setq secret-keys (cdr secret-keys)))) - secret-key)) +(eval-when-compile + (autoload 'epg-make-context "epg") + (autoload 'epg-context-set-armor "epg") + (autoload 'epg-context-set-signers "epg") + (autoload 'epg-context-result-for "epg") + (autoload 'epg-new-signature-digest-algorithm "epg") + (autoload 'epg-verify-result-to-string "epg") + (autoload 'epg-list-keys "epg") + (autoload 'epg-decrypt-string "epg") + (autoload 'epg-verify-string "epg") + (autoload 'epg-sign-string "epg") + (autoload 'epg-encrypt-string "epg") + (autoload 'epg-passphrase-callback-function "epg") + (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-sub-key-fingerprint "epg") + (autoload 'epg-configuration "epg-config") + (autoload 'epg-expand-group "epg-config") + (autoload 'epa-select-keys "epa")) + +(declare-function epg-key-sub-key-list "ext:epg" (key)) +(declare-function epg-sub-key-capability "ext:epg" (sub-key)) +(declare-function epg-sub-key-validity "ext:epg" (sub-key)) (autoload 'mml-compute-boundary "mml") @@ -401,146 +361,37 @@ Whether the passphrase is cached at all is controlled by (declare-function message-options-set "message" (symbol value)) (defun mml-smime-epg-sign (cont) - (let* ((inhibit-redisplay t) - (context (epg-make-context 'CMS)) - (boundary (mml-compute-boundary cont)) - (sender (message-options-get 'message-sender)) - (signer-names (or mml-smime-signers - (if (and mml-smime-sign-with-sender sender) - (list (concat "<" sender ">"))))) - signer-key - (signers - (or (message-options-get 'mml-smime-epg-signers) - (message-options-set - 'mml-smime-epg-signers - (if (eq mm-sign-option 'guided) - (epa-select-keys context "\ -Select keys for signing. -If no one is selected, default secret key is used. " - signer-names - t) - (if (or sender mml-smime-signers) - (delq nil - (mapcar - (lambda (signer) - (setq signer-key - (mml-smime-epg-find-usable-secret-key - context signer 'sign)) - (unless (or signer-key - (y-or-n-p - (format - "No secret key for %s; skip it? " - signer))) - (error "No secret key for %s" signer)) - signer-key) - signer-names))))))) - signature micalg) - (epg-context-set-signers context signers) - (if mml-smime-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml-smime-epg-passphrase-callback)) - (condition-case error - (setq signature (epg-sign-string context - (mm-replace-in-string (buffer-string) - "\n" "\r\n") - t) - mml-smime-epg-secret-key-id-list nil) - (error - (while mml-smime-epg-secret-key-id-list - (password-cache-remove (car mml-smime-epg-secret-key-id-list)) - (setq mml-smime-epg-secret-key-id-list - (cdr mml-smime-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) - (if (epg-context-result-for context 'sign) - (setq micalg (epg-new-signature-digest-algorithm - (car (epg-context-result-for context 'sign))))) + (let ((inhibit-redisplay t) + (boundary (mml-compute-boundary cont))) (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - (if micalg - (insert (format "\tmicalg=%s; " - (downcase - (cdr (assq micalg - epg-digest-algorithm-alist)))))) - (insert "protocol=\"application/pkcs7-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pkcs7-signature; name=smime.p7s + (let* ((pair (mml-secure-epg-sign 'CMS cont)) + (signature (car pair)) + (micalg (cdr pair))) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (if micalg + (insert (format "\tmicalg=%s; " + (downcase + (cdr (assq micalg + epg-digest-algorithm-alist)))))) + (insert "protocol=\"application/pkcs7-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pkcs7-signature; name=smime.p7s Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename=smime.p7s ") - (insert (base64-encode-string signature) "\n") - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) + (insert (base64-encode-string signature) "\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max))))) (defun mml-smime-epg-encrypt (cont) (let* ((inhibit-redisplay t) - (context (epg-make-context 'CMS)) - (config (epg-configuration)) - (recipients (message-options-get 'mml-smime-epg-recipients)) - cipher signers - (sender (message-options-get 'message-sender)) - (signer-names (or mml-smime-signers - (if (and mml-smime-sign-with-sender sender) - (list (concat "<" sender ">"))))) (boundary (mml-compute-boundary cont)) - recipient-key) - (unless recipients - (setq recipients - (apply #'nconc - (mapcar - (lambda (recipient) - (or (epg-expand-group config recipient) - (list recipient))) - (split-string - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+")))) - (when mml-smime-encrypt-to-self - (unless signer-names - (error "Neither message sender nor mml-smime-signers are set")) - (setq recipients (nconc recipients signer-names))) - (if (eq mm-encrypt-option 'guided) - (setq recipients - (epa-select-keys context "\ -Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - recipients)) - (setq recipients - (mapcar - (lambda (recipient) - (setq recipient-key (mml-smime-epg-find-usable-key - (epg-list-keys context recipient) - 'encrypt)) - (unless (or recipient-key - (y-or-n-p - (format "No public key for %s; skip it? " - recipient))) - (error "No public key for %s" recipient)) - recipient-key) - recipients)) - (unless recipients - (error "No recipient specified"))) - (message-options-set 'mml-smime-epg-recipients recipients)) - (if mml-smime-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml-smime-epg-passphrase-callback)) - (condition-case error - (setq cipher - (epg-encrypt-string context (buffer-string) recipients) - mml-smime-epg-secret-key-id-list nil) - (error - (while mml-smime-epg-secret-key-id-list - (password-cache-remove (car mml-smime-epg-secret-key-id-list)) - (setq mml-smime-epg-secret-key-id-list - (cdr mml-smime-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) + (cipher (mml-secure-epg-encrypt 'CMS cont))) (delete-region (point-min) (point-max)) (goto-char (point-min)) (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 @@ (defvar mml1991-cache-passphrase mml-secure-cache-passphrase "If t, cache passphrase.") +(make-obsolete-variable 'mml1991-cache-passphrase + 'mml-secure-cache-passphrase + "25.1") (defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry "How many seconds the passphrase is cached. Whether the passphrase is cached at all is controlled by `mml1991-cache-passphrase'.") +(make-obsolete-variable 'mml1991-passphrase-cache-expiry + 'mml-secure-passphrase-cache-expiry + "25.1") (defvar mml1991-signers nil "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 (defvar mml1991-encrypt-to-self nil "If t, add your own key ID to recipient list when encryption.") + ;;; mailcrypt wrapper (autoload 'mc-sign-generic "mc-toplev") @@ -255,91 +262,9 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") -(defvar mml1991-epg-secret-key-id-list nil) - -(defun mml1991-epg-passphrase-callback (context key-id ignore) - (if (eq key-id 'SYM) - (epg-passphrase-callback-function context key-id nil) - (let* ((entry (assoc key-id epg-user-id-alist)) - (passphrase - (password-read - (format "GnuPG passphrase for %s: " - (if entry - (cdr entry) - key-id)) - (if (eq key-id 'PIN) - "PIN" - key-id)))) - (when passphrase - (let ((password-cache-expiry mml1991-passphrase-cache-expiry)) - (password-cache-add key-id passphrase)) - (setq mml1991-epg-secret-key-id-list - (cons key-id mml1991-epg-secret-key-id-list)) - (copy-sequence passphrase))))) - -(defun mml1991-epg-find-usable-key (keys usage) - (catch 'found - (while keys - (let ((pointer (epg-key-sub-key-list (car keys)))) - ;; The primary key will be marked as disabled, when the entire - ;; key is disabled (see 12 Field, Format of colon listings, in - ;; gnupg/doc/DETAILS) - (unless (memq 'disabled (epg-sub-key-capability (car pointer))) - (while pointer - (if (and (memq usage (epg-sub-key-capability (car pointer))) - (not (memq (epg-sub-key-validity (car pointer)) - '(revoked expired)))) - (throw 'found (car keys))) - (setq pointer (cdr pointer))))) - (setq keys (cdr keys))))) - -;; XXX: since gpg --list-secret-keys does not return validity of each -;; key, `mml1991-epg-find-usable-key' defined above is not enough for -;; secret keys. The function `mml1991-epg-find-usable-secret-key' -;; below looks at appropriate public keys to check usability. -(defun mml1991-epg-find-usable-secret-key (context name usage) - (let ((secret-keys (epg-list-keys context name t)) - secret-key) - (while (and (not secret-key) secret-keys) - (if (mml1991-epg-find-usable-key - (epg-list-keys context (epg-sub-key-fingerprint - (car (epg-key-sub-key-list - (car secret-keys))))) - usage) - (setq secret-key (car secret-keys) - secret-keys nil) - (setq secret-keys (cdr secret-keys)))) - secret-key)) - (defun mml1991-epg-sign (cont) - (let ((context (epg-make-context)) - headers cte signer-key signers signature) - (if (eq mm-sign-option 'guided) - (setq signers (epa-select-keys context "Select keys for signing. -If no one is selected, default secret key is used. " - mml1991-signers t)) - (if mml1991-signers - (setq signers (delq nil - (mapcar - (lambda (name) - (setq signer-key - (mml1991-epg-find-usable-secret-key - context name 'sign)) - (unless (or signer-key - (y-or-n-p - (format - "No secret key for %s; skip it? " - name))) - (error "No secret key for %s" name)) - signer-key) - mml1991-signers))))) - (epg-context-set-armor context t) - (epg-context-set-textmode context t) - (epg-context-set-signers context signers) - (if mml1991-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml1991-epg-passphrase-callback)) + (let ((inhibit-redisplay t) + headers cte) ;; Don't sign headers. (goto-char (point-min)) (when (re-search-forward "^$" nil t) @@ -352,28 +277,21 @@ If no one is selected, default secret key is used. " (when cte (setq cte (intern (downcase cte))) (mm-decode-content-transfer-encoding cte))) - (condition-case error - (setq signature (epg-sign-string context (buffer-string) 'clear) - mml1991-epg-secret-key-id-list nil) - (error - (while mml1991-epg-secret-key-id-list - (password-cache-remove (car mml1991-epg-secret-key-id-list)) - (setq mml1991-epg-secret-key-id-list - (cdr mml1991-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) - (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert signature) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) - t)) + (let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear)) + (signature (car pair))) + (delete-region (point-min) (point-max)) + (mm-with-unibyte-current-buffer + (insert signature) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n")) + t))) (defun mml1991-epg-encrypt (cont &optional sign) (goto-char (point-min)) @@ -386,78 +304,7 @@ If no one is selected, default secret key is used. " (delete-region (point-min) (point)) (when cte (mm-decode-content-transfer-encoding (intern (downcase cte)))))) - (let ((context (epg-make-context)) - (recipients - (if (message-options-get 'message-recipients) - (split-string - (message-options-get 'message-recipients) - "[ \f\t\n\r\v,]+"))) - recipient-key signer-key cipher signers config) - (when mml1991-encrypt-to-self - (unless mml1991-signers - (error "mml1991-signers is not set")) - (setq recipients (nconc recipients mml1991-signers))) - ;; We should remove this check if epg-0.0.6 is released. - (if (and (condition-case nil - (require 'epg-config) - (error)) - (functionp #'epg-expand-group)) - (setq config (epg-configuration) - recipients - (apply #'nconc - (mapcar (lambda (recipient) - (or (epg-expand-group config recipient) - (list recipient))) - recipients)))) - (if (eq mm-encrypt-option 'guided) - (setq recipients - (epa-select-keys context "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - recipients)) - (setq recipients - (delq nil (mapcar - (lambda (name) - (setq recipient-key (mml1991-epg-find-usable-key - (epg-list-keys context name) - 'encrypt)) - (unless (or recipient-key - (y-or-n-p - (format "No public key for %s; skip it? " - name))) - (error "No public key for %s" name)) - recipient-key) - recipients))) - (unless recipients - (error "No recipient specified"))) - (when sign - (if (eq mm-sign-option 'guided) - (setq signers (epa-select-keys context "Select keys for signing. -If no one is selected, default secret key is used. " - mml1991-signers t)) - (if mml1991-signers - (setq signers (delq nil - (mapcar - (lambda (name) - (mml1991-epg-find-usable-secret-key - context name 'sign)) - mml1991-signers))))) - (epg-context-set-signers context signers)) - (epg-context-set-armor context t) - (epg-context-set-textmode context t) - (if mml1991-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml1991-epg-passphrase-callback)) - (condition-case error - (setq cipher - (epg-encrypt-string context (buffer-string) recipients sign) - mml1991-epg-secret-key-id-list nil) - (error - (while mml1991-epg-secret-key-id-list - (password-cache-remove (car mml1991-epg-secret-key-id-list)) - (setq mml1991-epg-secret-key-id-list - (cdr mml1991-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) + (let ((cipher (mml-secure-epg-encrypt 'OpenPGP cont sign))) (delete-region (point-min) (point-max)) (insert "\n" cipher)) 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'.") "If t, cache passphrase." :group 'mime-security :type 'boolean) +(make-obsolete-variable 'mml2015-cache-passphrase + 'mml-secure-cache-passphrase + "25.1") (defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry "How many seconds the passphrase is cached. @@ -118,6 +121,9 @@ Whether the passphrase is cached at all is controlled by `mml2015-cache-passphrase'." :group 'mime-security :type 'integer) +(make-obsolete-variable 'mml2015-passphrase-cache-expiry + 'mml-secure-passphrase-cache-expiry + "25.1") (defcustom mml2015-signers nil "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'." (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa") -(defvar mml2015-epg-secret-key-id-list nil) - -(defun mml2015-epg-passphrase-callback (context key-id ignore) - (if (eq key-id 'SYM) - (epg-passphrase-callback-function context key-id nil) - (let* ((password-cache-key-id - (if (eq key-id 'PIN) - "PIN" - key-id)) - entry - (passphrase - (password-read - (if (eq key-id 'PIN) - "Passphrase for PIN: " - (if (setq entry (assoc key-id epg-user-id-alist)) - (format "Passphrase for %s %s: " key-id (cdr entry)) - (format "Passphrase for %s: " key-id))) - password-cache-key-id))) - (when passphrase - (let ((password-cache-expiry mml2015-passphrase-cache-expiry)) - (password-cache-add password-cache-key-id passphrase)) - (setq mml2015-epg-secret-key-id-list - (cons password-cache-key-id mml2015-epg-secret-key-id-list)) - (copy-sequence passphrase))))) - -(defun mml2015-epg-check-user-id (key recipient) - (let ((pointer (epg-key-user-id-list key)) - result) - (while pointer - (if (and (equal (car (mail-header-parse-address - (epg-user-id-string (car pointer)))) - (car (mail-header-parse-address - recipient))) - (not (memq (epg-user-id-validity (car pointer)) - '(revoked expired)))) - (setq result t - pointer nil) - (setq pointer (cdr pointer)))) - result)) - -(defun mml2015-epg-check-sub-key (key usage) - (let ((pointer (epg-key-sub-key-list key)) - result) - ;; The primary key will be marked as disabled, when the entire - ;; key is disabled (see 12 Field, Format of colon listings, in - ;; gnupg/doc/DETAILS) - (unless (memq 'disabled (epg-sub-key-capability (car pointer))) - (while pointer - (if (and (memq usage (epg-sub-key-capability (car pointer))) - (not (memq (epg-sub-key-validity (car pointer)) - '(revoked expired)))) - (setq result t - pointer nil) - (setq pointer (cdr pointer))))) - result)) - -(defun mml2015-epg-find-usable-key (context name usage - &optional name-is-key-id) - (let ((keys (epg-list-keys context name)) - key) - (while keys - (if (and (or name-is-key-id - ;; Non email user-id can be supplied through - ;; mml2015-signers if mml2015-encrypt-to-self is set. - ;; Treat it as valid, as it is user's intention. - (not (string-match "\\`<" name)) - (mml2015-epg-check-user-id (car keys) name)) - (mml2015-epg-check-sub-key (car keys) usage)) - (setq key (car keys) - keys nil) - (setq keys (cdr keys)))) - key)) - -;; XXX: since gpg --list-secret-keys does not return validity of each -;; key, `mml2015-epg-find-usable-key' defined above is not enough for -;; secret keys. The function `mml2015-epg-find-usable-secret-key' -;; below looks at appropriate public keys to check usability. -(defun mml2015-epg-find-usable-secret-key (context name usage) - (let ((secret-keys (epg-list-keys context name t)) - secret-key) - (while (and (not secret-key) secret-keys) - (if (mml2015-epg-find-usable-key - context - (epg-sub-key-fingerprint - (car (epg-key-sub-key-list - (car secret-keys)))) - usage - t) - (setq secret-key (car secret-keys) - secret-keys nil) - (setq secret-keys (cdr secret-keys)))) - secret-key)) - (autoload 'gnus-create-image "gnus-ems") (defun mml2015-epg-key-image (key-id) @@ -921,18 +834,15 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) (setq context (epg-make-context)) - (if mml2015-cache-passphrase + (if (or mml2015-cache-passphrase mml-secure-cache-passphrase) (epg-context-set-passphrase-callback context - #'mml2015-epg-passphrase-callback)) + (cons 'mml-secure-passphrase-callback 'OpenPGP))) (condition-case error (setq plain (epg-decrypt-string context (mm-get-part child)) - mml2015-epg-secret-key-id-list nil) + mml-secure-secret-key-id-list nil) (error - (while mml2015-epg-secret-key-id-list - (password-cache-remove (car mml2015-epg-secret-key-id-list)) - (setq mml2015-epg-secret-key-id-list - (cdr mml2015-epg-secret-key-id-list))) + (mml-secure-clear-secret-key-id-list) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (if (eq (car error) 'quit) @@ -968,18 +878,15 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (let ((inhibit-redisplay t) (context (epg-make-context)) plain) - (if mml2015-cache-passphrase + (if (or mml2015-cache-passphrase mml-secure-cache-passphrase) (epg-context-set-passphrase-callback context - #'mml2015-epg-passphrase-callback)) + (cons 'mml-secure-passphrase-callback 'OpenPGP))) (condition-case error (setq plain (epg-decrypt-string context (buffer-string)) - mml2015-epg-secret-key-id-list nil) + mml-secure-secret-key-id-list nil) (error - (while mml2015-epg-secret-key-id-list - (password-cache-remove (car mml2015-epg-secret-key-id-list)) - (setq mml2015-epg-secret-key-id-list - (cdr mml2015-epg-secret-key-id-list))) + (mml-secure-clear-secret-key-id-list) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (if (eq (car error) 'quit) @@ -1065,176 +972,37 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) - (let* ((inhibit-redisplay t) - (context (epg-make-context)) - (boundary (mml-compute-boundary cont)) - (sender (message-options-get 'message-sender)) - (signer-names (or mml2015-signers - (if (and mml2015-sign-with-sender sender) - (list (concat "<" sender ">"))))) - signer-key - (signers - (or (message-options-get 'mml2015-epg-signers) - (message-options-set - 'mml2015-epg-signers - (if (eq mm-sign-option 'guided) - (epa-select-keys context "\ -Select keys for signing. -If no one is selected, default secret key is used. " - signer-names - t) - (if (or sender mml2015-signers) - (delq nil - (mapcar - (lambda (signer) - (setq signer-key - (mml2015-epg-find-usable-secret-key - context signer 'sign)) - (unless (or signer-key - (y-or-n-p - (format - "No secret key for %s; skip it? " - signer))) - (error "No secret key for %s" signer)) - signer-key) - signer-names))))))) - signature micalg) - (epg-context-set-armor context t) - (epg-context-set-textmode context t) - (epg-context-set-signers context signers) - (if mml2015-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml2015-epg-passphrase-callback)) + (let ((inhibit-redisplay t) + (boundary (mml-compute-boundary cont))) ;; Signed data must end with a newline (RFC 3156, 5). (goto-char (point-max)) (unless (bolp) (insert "\n")) - (condition-case error - (setq signature (epg-sign-string context (buffer-string) t) - mml2015-epg-secret-key-id-list nil) - (error - (while mml2015-epg-secret-key-id-list - (password-cache-remove (car mml2015-epg-secret-key-id-list)) - (setq mml2015-epg-secret-key-id-list - (cdr mml2015-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) - (if (epg-context-result-for context 'sign) - (setq micalg (epg-new-signature-digest-algorithm - (car (epg-context-result-for context 'sign))))) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - (if micalg - (insert (format "\tmicalg=pgp-%s; " - (downcase - (cdr (assq micalg - epg-digest-algorithm-alist)))))) - (insert "protocol=\"application/pgp-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature; name=\"signature.asc\"\n\n") - (insert signature) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) + (let* ((pair (mml-secure-epg-sign 'OpenPGP t)) + (signature (car pair)) + (micalg (cdr pair))) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (if micalg + (insert (format "\tmicalg=pgp-%s; " + (downcase + (cdr (assq micalg + epg-digest-algorithm-alist)))))) + (insert "protocol=\"application/pgp-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature; name=\"signature.asc\"\n\n") + (insert signature) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max))))) (defun mml2015-epg-encrypt (cont &optional sign) (let* ((inhibit-redisplay t) - (context (epg-make-context)) (boundary (mml-compute-boundary cont)) - (config (epg-configuration)) - (recipients (message-options-get 'mml2015-epg-recipients)) - cipher - (sender (message-options-get 'message-sender)) - (signer-names (or mml2015-signers - (if (and mml2015-sign-with-sender sender) - (list (concat "<" sender ">"))))) - signers - recipient-key signer-key) - (unless recipients - (setq recipients - (apply #'nconc - (mapcar - (lambda (recipient) - (or (epg-expand-group config recipient) - (list (concat "<" recipient ">")))) - (split-string - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+")))) - (when mml2015-encrypt-to-self - (unless signer-names - (error "Neither message sender nor mml2015-signers are set")) - (setq recipients (nconc recipients signer-names))) - (if (eq mm-encrypt-option 'guided) - (setq recipients - (epa-select-keys context "\ -Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - recipients)) - (setq recipients - (delq nil - (mapcar - (lambda (recipient) - (setq recipient-key (mml2015-epg-find-usable-key - context recipient 'encrypt)) - (unless (or recipient-key - (y-or-n-p - (format "No public key for %s; skip it? " - recipient))) - (error "No public key for %s" recipient)) - recipient-key) - recipients))) - (unless recipients - (error "No recipient specified"))) - (message-options-set 'mml2015-epg-recipients recipients)) - (when sign - (setq signers - (or (message-options-get 'mml2015-epg-signers) - (message-options-set - 'mml2015-epg-signers - (if (eq mm-sign-option 'guided) - (epa-select-keys context "\ -Select keys for signing. -If no one is selected, default secret key is used. " - signer-names - t) - (if (or sender mml2015-signers) - (delq nil - (mapcar - (lambda (signer) - (setq signer-key - (mml2015-epg-find-usable-secret-key - context signer 'sign)) - (unless (or signer-key - (y-or-n-p - (format - "No secret key for %s; skip it? " - signer))) - (error "No secret key for %s" signer)) - signer-key) - signer-names))))))) - (epg-context-set-signers context signers)) - (epg-context-set-armor context t) - (epg-context-set-textmode context t) - (if mml2015-cache-passphrase - (epg-context-set-passphrase-callback - context - #'mml2015-epg-passphrase-callback)) - (condition-case error - (setq cipher - (epg-encrypt-string context (buffer-string) recipients sign - mml2015-always-trust) - mml2015-epg-secret-key-id-list nil) - (error - (while mml2015-epg-secret-key-id-list - (password-cache-remove (car mml2015-epg-secret-key-id-list)) - (setq mml2015-epg-secret-key-id-list - (cdr mml2015-epg-secret-key-id-list))) - (signal (car error) (cdr error)))) + (cipher (mml-secure-epg-encrypt 'OpenPGP cont sign))) (delete-region (point-min) (point-max)) (goto-char (point-min)) (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" -- 2.39.2