Commit | Line | Data |
---|---|---|
1a5de666 AB |
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 |