[emacs] update 4 drones
[~bandali/configs] / lisp / bbdb / bbdb-pgp.el
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