summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJens Lechtenboerger <jens.lechtenboerger@fsfe.org>2016-01-03 01:10:34 +0000
committerJohn Wiegley <johnw@newartisans.com>2016-01-18 22:30:14 -0800
commit9e0fc619541f57b71711e8855d2b19c942b107e6 (patch)
tree74e2b43efeeb6edbffe5dedef67d512b9cf8e4f8
parentcd19641ed3236c8d51b882f867c58e719782dbfc (diff)
Refactor mml-smime.el, mml1991.el, mml2015.el
(Maybe this is the last merge from Gnus git to Emacs git) Cf. discussion on ding mailing list, messages in <http://thread.gmane.org/gmane.emacs.gnus.general/86228>. Common code from the three files mml-smime.el, mml1991.el, and mml2015.el is moved to mml-sec.el. Auxiliary functions are added to gnus-util.el. The code is supported by test cases with necessary test keys. Documentation in message.texi is updated. * doc/misc/message.texi (Security, Using S/MIME): Update for refactoring mml-smime.el, mml1991.el, mml2015.el. (Using OpenPGP): Rename from "Using PGP/MIME"; update contents. (Passphrase caching, Encrypt-to-self, Bcc Warning): New sections. * lisp/gnus/gnus-util.el (gnus-test-list, gnus-subsetp, gnus-setdiff): New functions. * lisp/gnus/mml-sec.el: Require gnus-util and epg. (epa--select-keys): Autoload. (mml-signencrypt-style-alist, mml-secure-cache-passphrase): Doc fix. (mml-secure-openpgp-signers): New user option; make mml1991-signers and mml2015-signers obsolete aliases to it. (mml-secure-smime-signers): New user option; make mml-smime-signers an obsolete alias to it. (mml-secure-openpgp-encrypt-to-self): New user option; make mml1991-encrypt-to-self and mml2015-encrypt-to-self obsolete aliases to it. (mml-secure-smime-encrypt-to-self): New user option; make mml-smime-encrypt-to-self an obsolete alias to it. (mml-secure-openpgp-sign-with-sender): New user option; make mml2015-sign-with-sender an obsolete alias to it. (mml-secure-smime-sign-with-sender): New user option; make mml-smime-sign-with-sender an obsolete alias to it. (mml-secure-openpgp-always-trust): New user option; make mml2015-always-trust an obsolete alias to it. (mml-secure-fail-when-key-problem, mml-secure-key-preferences): New user options. (mml-secure-cust-usage-lookup, mml-secure-cust-fpr-lookup) (mml-secure-cust-record-keys, mml-secure-cust-remove-keys) (mml-secure-add-secret-key-id, mml-secure-clear-secret-key-id-list) (mml-secure-cache-passphrase-p, mml-secure-cache-expiry-interval) (mml-secure-passphrase-callback, mml-secure-check-user-id) (mml-secure-secret-key-exists-p, mml-secure-check-sub-key) (mml-secure-find-usable-keys, mml-secure-select-preferred-keys) (mml-secure-fingerprint, mml-secure-filter-keys) (mml-secure-normalize-cust-name, mml-secure-select-keys) (mml-secure-select-keys-1, mml-secure-signer-names, mml-secure-signers) (mml-secure-self-recipients, mml-secure-recipients) (mml-secure-epg-encrypt, mml-secure-epg-sign): New functions. * lisp/gnus/mml-smime.el: Require epg; refactor declaration and autoloading of epg functions. (mml-smime-use): Doc fix. (mml-smime-cache-passphrase, mml-smime-passphrase-cache-expiry): Obsolete. (mml-smime-get-dns-cert, mml-smime-get-ldap-cert): Use format instead of gnus-format-message. (mml-smime-epg-secret-key-id-list): Remove variable. (mml-smime-epg-passphrase-callback, mml-smime-epg-find-usable-key) (mml-smime-epg-find-usable-secret-key): Remove functions. (mml-smime-epg-sign, mml-smime-epg-encrypt): Refactor. * lisp/gnus/mml1991.el (mml1991-cache-passphrase) (mml1991-passphrase-cache-expiry): Obsolete. (mml1991-epg-secret-key-id-list): Remove variable. (mml1991-epg-passphrase-callback, mml1991-epg-find-usable-key) (mml1991-epg-find-usable-secret-key): Remove functions. (mml1991-epg-sign, mml1991-epg-encrypt): Refactor. * lisp/gnus/mml2015.el (mml2015-cache-passphrase) (mml2015-passphrase-cache-expiry): Obsolete. (mml2015-epg-secret-key-id-list): Remove variable. (mml2015-epg-passphrase-callback, mml2015-epg-check-user-id) (mml2015-epg-check-sub-key, mml2015-epg-find-usable-key) (mml2015-epg-find-usable-secret-key): Remove functions. (mml2015-epg-decrypt, mml2015-epg-clear-decrypt, mml2015-epg-sign) (mml2015-epg-encrypt): Refactor.
-rw-r--r--doc/misc/message.texi195
-rw-r--r--lisp/gnus/gnus-util.el15
-rw-r--r--lisp/gnus/mml-sec.el534
-rw-r--r--lisp/gnus/mml-smime.el273
-rw-r--r--lisp/gnus/mml1991.el203
-rw-r--r--lisp/gnus/mml2015.el306
6 files changed, 842 insertions, 684 deletions
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index dbc77592a0..761fb772f4 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 ea5f315547..31645fcd31 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1996,6 +1996,14 @@ 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
@@ -2006,6 +2014,13 @@ lists of strings."
(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 dbd31629f9..0a5f472079 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)
@@ -425,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 b19c9e89ba..a40595ecbd 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 6469636451..bb5c940f17 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 10ba126ae2..e2e9977180 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"