diff options
Diffstat (limited to 'lisp/bbdb/bbdb-pgp.el')
| -rw-r--r-- | lisp/bbdb/bbdb-pgp.el | 238 |
1 files changed, 238 insertions, 0 deletions
diff --git a/lisp/bbdb/bbdb-pgp.el b/lisp/bbdb/bbdb-pgp.el new file mode 100644 index 0000000..0881388 --- /dev/null +++ b/lisp/bbdb/bbdb-pgp.el @@ -0,0 +1,238 @@ +;;; bbdb-pgp.el --- use BBDB to handle PGP preferences -*- lexical-binding: t -*- + +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. + +;; This file is part of the Insidious Big Brother Database (aka BBDB), + +;; BBDB is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; BBDB is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with BBDB. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; It is believed that encrypted mail works best if all mail between +;; individuals is encrypted - even concerning matters that are not +;; confidential. The reasoning is that confidential messages cannot +;; then be easily spotted and decryption efforts concentrated on them. +;; Some people therefore prefer to have all their email encrypted. +;; This package allows you to mark the BBDB entries for those +;; individuals so that messages will be (signed or) encrypted +;; when they are sent. + +;;; Usage: +;; Add the xfield pgp-mail (see `bbdb-pgp-field') with the value +;; `sign' or `encrypt' to the BBDB records of the message recipients. +;; If the value is `sign-query' or `encrypt-query', this will query +;; whether to send signed or encrypted messages. +;; +;; Then call `bbdb-pgp' on outgoing message to add MML tags, +;; see info node `(message)security'. For all message recipients +;; in `bbdb-pgp-headers', this command grabs the action in `bbdb-pgp-field' +;; of their BBDB records. If this proposes multiple actions, +;; perform the action which appears first in `bbdb-pgp-ranked-actions'. +;; If this proposes no action at all, use `bbdb-pgp-default'. +;; The variable `bbdb-pgp-method' defines the method which is actually used +;; for signing and encrypting, see also `bbdb-pgp-method-alist'. +;; +;; `bbdb-pgp' works with both `mail-mode' and `message-mode' to send +;; signed or encrypted mail. +;; +;; To run `bbdb-pgp' automatically when sending a message, +;; use `bbdb-initialize' with arg `pgp' to add this function +;; to `message-send-hook' and `mail-send-hook'. +;; Yet see info node `(message)Signing and encryption' why you +;; might not want to rely for encryption on a hook function +;; which runs just before the message is sent, that is, you might want +;; to call the command `bbdb-pgp' manually, then call `mml-preview'. +;; +;; A thought: For these hooks we could define a wrapper that calls +;; first `bbdb-pgp', then `mml-preview' for preview. The wrapper should +;; abort the sending of the message if the preview is not getting +;; the user's approval. Yet this might require some recursive editing mode +;; so that the user can browse the preview before approving it. +;; +;;; Todo: +;; Spot incoming PGP-signed or encrypted messages and prompt for adding +;; `bbdb-pgp-field' to the senders' BBDB records; similar to how +;; bbdb-sc.el maintains attribution preferences. + +;;; Code: + +(require 'message) +(require 'bbdb-com) + +(defcustom bbdb-pgp-field 'pgp-mail + "BBDB xfield holding the PGP action. +If the recipient of a message has this xfield in his/her BBDB record, +its value determines whether `bbdb-pgp' signs or encrypts the message. +The value of this xfield should be one of the following symbols: + sign Sign the message + sign-query Query whether to sign the message + encrypt Encrypt the message + encrypt-query Query whether to encrypt the message +If the xfield is absent use `bbdb-pgp-default'. +See also info node `(message)security'." + :type '(symbol :tag "BBDB xfield") + :group 'bbdb-utilities-pgp) + +(defcustom bbdb-pgp-default nil + "Default action when sending a message and the recipients are not in BBDB. +This should be one of the following symbols: + nil Do nothing + sign Sign the message + sign-query Query whether to sign the message + encrypt Encrypt the message + encrypt-query Query whether to encrypt the message +See info node `(message)security'." + :type '(choice + (const :tag "Do Nothing" nil) + (const :tag "Encrypt" encrypt) + (const :tag "Query encryption" encrypt-query) + (const :tag "Sign" sign) + (const :tag "Query signing" sign-query)) + :group 'bbdb-utilities-pgp) + +(defcustom bbdb-pgp-ranked-actions + '(encrypt-query sign-query encrypt sign) + "Ranked list of actions when sending a message. +If a message has multiple recipients such that their BBDB records specify +different actions for this message, `bbdb-pgp' will perform the action +which appears first in `bbdb-pgp-ranked-actions'. +This list should include the following four symbols: + sign Sign the message + sign-query Query whether to sign the message + encrypt Encrypt the message + encrypt-query Query whether to encrypt the message." + :type '(repeat (symbol :tag "Action")) + :group 'bbdb-utilities-pgp) + +(defcustom bbdb-pgp-headers '("To" "Cc") + "Message headers to look at." + :type '(repeat (string :tag "Message header")) + :group 'bbdb-utilities-pgp) + +(defcustom bbdb-pgp-method 'pgpmime + "Method for signing and encrypting messages. +It should be one of the keys of `bbdb-pgp-method-alist'. +The default methods include + pgp Add MML tags for PGP format + pgpauto Add MML tags for PGP-auto format + pgpmime Add MML tags for PGP/MIME + smime Add MML tags for S/MIME +See info node `(message)security'." + :type '(choice + (const :tag "MML PGP" pgp) + (const :tag "MML PGP-auto" pgpauto) + (const :tag "MML PGP/MIME" pgpmime) + (const :tag "MML S/MIME" smime) + (symbol :tag "Custom")) + :group 'bbdb-utilities-pgp) + +(defcustom bbdb-pgp-method-alist + '((pgp mml-secure-message-sign-pgp + mml-secure-message-encrypt-pgp) + (pgpmime mml-secure-message-sign-pgpmime + mml-secure-message-encrypt-pgpmime) + (smime mml-secure-message-sign-smime + mml-secure-message-encrypt-smime) + (pgpauto mml-secure-message-sign-pgpauto + mml-secure-message-encrypt-pgpauto)) + "Alist of methods for signing and encrypting a message with `bbdb-pgp'. +Each method is a list (KEY SIGN ENCRYPT). +The symbol KEY identifies the method. The function SIGN signs the message; +the function ENCRYPT encrypts it. These functions take no arguments. +The default methods include + pgp Add MML tags for PGP format + pgpauto Add MML tags for PGP-auto format + pgpmime Add MML tags for PGP/MIME + smime Add MML tags for S/MIME +See info node `(message)security'." + :type '(repeat (list (symbol :tag "Key") + (symbol :tag "Sign method") + (symbol :tag "Encrypt method"))) + :group 'bbdb-utilities-pgp) + +;;;###autoload +(defun bbdb-read-xfield-pgp-mail (&optional init) + "Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'." + (bbdb-read-string "PGP action: " init + (mapcar 'list bbdb-pgp-ranked-actions) t)) + +;;;###autoload +(defun bbdb-pgp () + "Add PGP MML tags to a message according to the recipients' BBDB records. +For all message recipients in `bbdb-pgp-headers', this grabs the action +in `bbdb-pgp-field' of their BBDB records. If this proposes multiple actions, +perform the action which appears first in `bbdb-pgp-ranked-actions'. +If this proposes no action at all, use `bbdb-pgp-default'. +The variable `bbdb-pgp-method' defines the method which is actually used +for signing and encrypting. + +This command works with both `mail-mode' and `message-mode' to send +signed or encrypted mail. + +To run this command automatically when sending a message, +use `bbdb-initialize' with arg `pgp' to add this function +to `message-send-hook' and `mail-send-hook'. +Yet see info node `(message)Signing and encryption' why you +might not want to rely for encryption on a hook function +which runs just before the message is sent, that is, you might want +to call the command `bbdb-pgp' manually, then call `mml-preview'." + (interactive) + (save-excursion + (save-restriction + (widen) + (message-narrow-to-headers) + (when mail-aliases + ;; (sendmail-sync-aliases) ; needed? + (expand-mail-aliases (point-min) (point-max))) + (let ((actions + (or (delq nil + (delete-dups + (mapcar + (lambda (record) + (bbdb-record-xfield-intern record bbdb-pgp-field)) + (delete-dups + (apply 'nconc + (mapcar + (lambda (address) + (bbdb-message-search (car address) + (cadr address))) + (bbdb-extract-address-components + (mapconcat + (lambda (header) + (mail-fetch-field header nil t)) + bbdb-pgp-headers ", ") + t))))))) + (and bbdb-pgp-default + (list bbdb-pgp-default))))) + (when actions + (widen) ; after analyzing the headers + (let ((ranked-actions bbdb-pgp-ranked-actions) + action) + (while ranked-actions + (if (memq (setq action (pop ranked-actions)) actions) + (cond ((or (eq action 'sign) + (and (eq action 'sign-query) + (y-or-n-p "Sign message? "))) + (funcall (nth 1 (assq bbdb-pgp-method + bbdb-pgp-method-alist))) + (setq ranked-actions nil)) + ((or (eq action 'encrypt) + (and (eq action 'encrypt-query) + (y-or-n-p "Encrypt message? "))) + (funcall (nth 2 (assq bbdb-pgp-method + bbdb-pgp-method-alist))) + (setq ranked-actions nil))))))))))) + +(provide 'bbdb-pgp) + +;;; bbdb-pgp.el ends here |