mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-26 10:49:33 +00:00
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.
This commit is contained in:
Jens Lechtenboerger
Katsumi Yamaoka
parent
43662a240b
commit
5213ded9aa
@ -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 @acronym{S/MIME} support in Message (and @acronym{MML}) require
|
||||
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}) 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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
(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"))
|
||||
|
||||
(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))
|
||||
(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 "\
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user