| 1 | ;;; bbdb-pgp.el --- use BBDB to handle PGP preferences -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2013-2017 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; This file is part of the Insidious Big Brother Database (aka BBDB), |
| 6 | |
| 7 | ;; BBDB is free software: you can redistribute it and/or modify |
| 8 | ;; it under the terms of the GNU General Public License as published by |
| 9 | ;; the Free Software Foundation, either version 3 of the License, or |
| 10 | ;; (at your option) any later version. |
| 11 | |
| 12 | ;; BBDB is distributed in the hope that it will be useful, |
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | ;; GNU General Public License for more details. |
| 16 | |
| 17 | ;; You should have received a copy of the GNU General Public License |
| 18 | ;; along with BBDB. If not, see <http://www.gnu.org/licenses/>. |
| 19 | |
| 20 | ;;; Commentary: |
| 21 | ;; It is believed that encrypted mail works best if all mail between |
| 22 | ;; individuals is encrypted - even concerning matters that are not |
| 23 | ;; confidential. The reasoning is that confidential messages cannot |
| 24 | ;; then be easily spotted and decryption efforts concentrated on them. |
| 25 | ;; Some people therefore prefer to have all their email encrypted. |
| 26 | ;; This package allows you to mark the BBDB entries for those |
| 27 | ;; individuals so that messages will be (signed or) encrypted |
| 28 | ;; when they are sent. |
| 29 | |
| 30 | ;;; Usage: |
| 31 | ;; Add the xfield pgp-mail (see `bbdb-pgp-field') with the value |
| 32 | ;; `sign' or `encrypt' to the BBDB records of the message recipients. |
| 33 | ;; If the value is `sign-query' or `encrypt-query', this will query |
| 34 | ;; whether to send signed or encrypted messages. |
| 35 | ;; |
| 36 | ;; Then call `bbdb-pgp' on outgoing message to add MML tags, |
| 37 | ;; see info node `(message)security'. For all message recipients |
| 38 | ;; in `bbdb-pgp-headers', this command grabs the action in `bbdb-pgp-field' |
| 39 | ;; of their BBDB records. If this proposes multiple actions, |
| 40 | ;; perform the action which appears first in `bbdb-pgp-ranked-actions'. |
| 41 | ;; If this proposes no action at all, use `bbdb-pgp-default'. |
| 42 | ;; The variable `bbdb-pgp-method' defines the method which is actually used |
| 43 | ;; for signing and encrypting, see also `bbdb-pgp-method-alist'. |
| 44 | ;; |
| 45 | ;; `bbdb-pgp' works with both `mail-mode' and `message-mode' to send |
| 46 | ;; signed or encrypted mail. |
| 47 | ;; |
| 48 | ;; To run `bbdb-pgp' automatically when sending a message, |
| 49 | ;; use `bbdb-initialize' with arg `pgp' to add this function |
| 50 | ;; to `message-send-hook' and `mail-send-hook'. |
| 51 | ;; Yet see info node `(message)Signing and encryption' why you |
| 52 | ;; might not want to rely for encryption on a hook function |
| 53 | ;; which runs just before the message is sent, that is, you might want |
| 54 | ;; to call the command `bbdb-pgp' manually, then call `mml-preview'. |
| 55 | ;; |
| 56 | ;; A thought: For these hooks we could define a wrapper that calls |
| 57 | ;; first `bbdb-pgp', then `mml-preview' for preview. The wrapper should |
| 58 | ;; abort the sending of the message if the preview is not getting |
| 59 | ;; the user's approval. Yet this might require some recursive editing mode |
| 60 | ;; so that the user can browse the preview before approving it. |
| 61 | ;; |
| 62 | ;;; Todo: |
| 63 | ;; Spot incoming PGP-signed or encrypted messages and prompt for adding |
| 64 | ;; `bbdb-pgp-field' to the senders' BBDB records; similar to how |
| 65 | ;; bbdb-sc.el maintains attribution preferences. |
| 66 | |
| 67 | ;;; Code: |
| 68 | |
| 69 | (require 'message) |
| 70 | (require 'bbdb-com) |
| 71 | |
| 72 | (defcustom bbdb-pgp-field 'pgp-mail |
| 73 | "BBDB xfield holding the PGP action. |
| 74 | If the recipient of a message has this xfield in his/her BBDB record, |
| 75 | its value determines whether `bbdb-pgp' signs or encrypts the message. |
| 76 | The value of this xfield should be one of the following symbols: |
| 77 | sign Sign the message |
| 78 | sign-query Query whether to sign the message |
| 79 | encrypt Encrypt the message |
| 80 | encrypt-query Query whether to encrypt the message |
| 81 | If the xfield is absent use `bbdb-pgp-default'. |
| 82 | See also info node `(message)security'." |
| 83 | :type '(symbol :tag "BBDB xfield") |
| 84 | :group 'bbdb-utilities-pgp) |
| 85 | |
| 86 | (defcustom bbdb-pgp-default nil |
| 87 | "Default action when sending a message and the recipients are not in BBDB. |
| 88 | This should be one of the following symbols: |
| 89 | nil Do nothing |
| 90 | sign Sign the message |
| 91 | sign-query Query whether to sign the message |
| 92 | encrypt Encrypt the message |
| 93 | encrypt-query Query whether to encrypt the message |
| 94 | See info node `(message)security'." |
| 95 | :type '(choice |
| 96 | (const :tag "Do Nothing" nil) |
| 97 | (const :tag "Encrypt" encrypt) |
| 98 | (const :tag "Query encryption" encrypt-query) |
| 99 | (const :tag "Sign" sign) |
| 100 | (const :tag "Query signing" sign-query)) |
| 101 | :group 'bbdb-utilities-pgp) |
| 102 | |
| 103 | (defcustom bbdb-pgp-ranked-actions |
| 104 | '(encrypt-query sign-query encrypt sign) |
| 105 | "Ranked list of actions when sending a message. |
| 106 | If a message has multiple recipients such that their BBDB records specify |
| 107 | different actions for this message, `bbdb-pgp' will perform the action |
| 108 | which appears first in `bbdb-pgp-ranked-actions'. |
| 109 | This list should include the following four symbols: |
| 110 | sign Sign the message |
| 111 | sign-query Query whether to sign the message |
| 112 | encrypt Encrypt the message |
| 113 | encrypt-query Query whether to encrypt the message." |
| 114 | :type '(repeat (symbol :tag "Action")) |
| 115 | :group 'bbdb-utilities-pgp) |
| 116 | |
| 117 | (defcustom bbdb-pgp-headers '("To" "Cc") |
| 118 | "Message headers to look at." |
| 119 | :type '(repeat (string :tag "Message header")) |
| 120 | :group 'bbdb-utilities-pgp) |
| 121 | |
| 122 | (defcustom bbdb-pgp-method 'pgpmime |
| 123 | "Method for signing and encrypting messages. |
| 124 | It should be one of the keys of `bbdb-pgp-method-alist'. |
| 125 | The default methods include |
| 126 | pgp Add MML tags for PGP format |
| 127 | pgpauto Add MML tags for PGP-auto format |
| 128 | pgpmime Add MML tags for PGP/MIME |
| 129 | smime Add MML tags for S/MIME |
| 130 | See info node `(message)security'." |
| 131 | :type '(choice |
| 132 | (const :tag "MML PGP" pgp) |
| 133 | (const :tag "MML PGP-auto" pgpauto) |
| 134 | (const :tag "MML PGP/MIME" pgpmime) |
| 135 | (const :tag "MML S/MIME" smime) |
| 136 | (symbol :tag "Custom")) |
| 137 | :group 'bbdb-utilities-pgp) |
| 138 | |
| 139 | (defcustom bbdb-pgp-method-alist |
| 140 | '((pgp mml-secure-message-sign-pgp |
| 141 | mml-secure-message-encrypt-pgp) |
| 142 | (pgpmime mml-secure-message-sign-pgpmime |
| 143 | mml-secure-message-encrypt-pgpmime) |
| 144 | (smime mml-secure-message-sign-smime |
| 145 | mml-secure-message-encrypt-smime) |
| 146 | (pgpauto mml-secure-message-sign-pgpauto |
| 147 | mml-secure-message-encrypt-pgpauto)) |
| 148 | "Alist of methods for signing and encrypting a message with `bbdb-pgp'. |
| 149 | Each method is a list (KEY SIGN ENCRYPT). |
| 150 | The symbol KEY identifies the method. The function SIGN signs the message; |
| 151 | the function ENCRYPT encrypts it. These functions take no arguments. |
| 152 | The default methods include |
| 153 | pgp Add MML tags for PGP format |
| 154 | pgpauto Add MML tags for PGP-auto format |
| 155 | pgpmime Add MML tags for PGP/MIME |
| 156 | smime Add MML tags for S/MIME |
| 157 | See info node `(message)security'." |
| 158 | :type '(repeat (list (symbol :tag "Key") |
| 159 | (symbol :tag "Sign method") |
| 160 | (symbol :tag "Encrypt method"))) |
| 161 | :group 'bbdb-utilities-pgp) |
| 162 | |
| 163 | ;;;###autoload |
| 164 | (defun bbdb-read-xfield-pgp-mail (&optional init) |
| 165 | "Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'." |
| 166 | (bbdb-read-string "PGP action: " init |
| 167 | (mapcar 'list bbdb-pgp-ranked-actions) t)) |
| 168 | |
| 169 | ;;;###autoload |
| 170 | (defun bbdb-pgp () |
| 171 | "Add PGP MML tags to a message according to the recipients' BBDB records. |
| 172 | For all message recipients in `bbdb-pgp-headers', this grabs the action |
| 173 | in `bbdb-pgp-field' of their BBDB records. If this proposes multiple actions, |
| 174 | perform the action which appears first in `bbdb-pgp-ranked-actions'. |
| 175 | If this proposes no action at all, use `bbdb-pgp-default'. |
| 176 | The variable `bbdb-pgp-method' defines the method which is actually used |
| 177 | for signing and encrypting. |
| 178 | |
| 179 | This command works with both `mail-mode' and `message-mode' to send |
| 180 | signed or encrypted mail. |
| 181 | |
| 182 | To run this command automatically when sending a message, |
| 183 | use `bbdb-initialize' with arg `pgp' to add this function |
| 184 | to `message-send-hook' and `mail-send-hook'. |
| 185 | Yet see info node `(message)Signing and encryption' why you |
| 186 | might not want to rely for encryption on a hook function |
| 187 | which runs just before the message is sent, that is, you might want |
| 188 | to call the command `bbdb-pgp' manually, then call `mml-preview'." |
| 189 | (interactive) |
| 190 | (save-excursion |
| 191 | (save-restriction |
| 192 | (widen) |
| 193 | (message-narrow-to-headers) |
| 194 | (when mail-aliases |
| 195 | ;; (sendmail-sync-aliases) ; needed? |
| 196 | (expand-mail-aliases (point-min) (point-max))) |
| 197 | (let ((actions |
| 198 | (or (delq nil |
| 199 | (delete-dups |
| 200 | (mapcar |
| 201 | (lambda (record) |
| 202 | (bbdb-record-xfield-intern record bbdb-pgp-field)) |
| 203 | (delete-dups |
| 204 | (apply 'nconc |
| 205 | (mapcar |
| 206 | (lambda (address) |
| 207 | (bbdb-message-search (car address) |
| 208 | (cadr address))) |
| 209 | (bbdb-extract-address-components |
| 210 | (mapconcat |
| 211 | (lambda (header) |
| 212 | (mail-fetch-field header nil t)) |
| 213 | bbdb-pgp-headers ", ") |
| 214 | t))))))) |
| 215 | (and bbdb-pgp-default |
| 216 | (list bbdb-pgp-default))))) |
| 217 | (when actions |
| 218 | (widen) ; after analyzing the headers |
| 219 | (let ((ranked-actions bbdb-pgp-ranked-actions) |
| 220 | action) |
| 221 | (while ranked-actions |
| 222 | (if (memq (setq action (pop ranked-actions)) actions) |
| 223 | (cond ((or (eq action 'sign) |
| 224 | (and (eq action 'sign-query) |
| 225 | (y-or-n-p "Sign message? "))) |
| 226 | (funcall (nth 1 (assq bbdb-pgp-method |
| 227 | bbdb-pgp-method-alist))) |
| 228 | (setq ranked-actions nil)) |
| 229 | ((or (eq action 'encrypt) |
| 230 | (and (eq action 'encrypt-query) |
| 231 | (y-or-n-p "Encrypt message? "))) |
| 232 | (funcall (nth 2 (assq bbdb-pgp-method |
| 233 | bbdb-pgp-method-alist))) |
| 234 | (setq ranked-actions nil))))))))))) |
| 235 | |
| 236 | (provide 'bbdb-pgp) |
| 237 | |
| 238 | ;;; bbdb-pgp.el ends here |