[emacs] Update 3 drones
[~bandali/configs] / lisp / bbdb / bbdb-pgp.el
CommitLineData
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.
74If the recipient of a message has this xfield in his/her BBDB record,
75its value determines whether `bbdb-pgp' signs or encrypts the message.
76The 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
81If the xfield is absent use `bbdb-pgp-default'.
82See 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.
88This 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
94See 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.
106If a message has multiple recipients such that their BBDB records specify
107different actions for this message, `bbdb-pgp' will perform the action
108which appears first in `bbdb-pgp-ranked-actions'.
109This 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.
124It should be one of the keys of `bbdb-pgp-method-alist'.
125The 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
130See 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'.
149Each method is a list (KEY SIGN ENCRYPT).
150The symbol KEY identifies the method. The function SIGN signs the message;
151the function ENCRYPT encrypts it. These functions take no arguments.
152The 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
157See 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.
172For all message recipients in `bbdb-pgp-headers', this grabs the action
173in `bbdb-pgp-field' of their BBDB records. If this proposes multiple actions,
174perform the action which appears first in `bbdb-pgp-ranked-actions'.
175If this proposes no action at all, use `bbdb-pgp-default'.
176The variable `bbdb-pgp-method' defines the method which is actually used
177for signing and encrypting.
178
179This command works with both `mail-mode' and `message-mode' to send
180signed or encrypted mail.
181
182To run this command automatically when sending a message,
183use `bbdb-initialize' with arg `pgp' to add this function
184to `message-send-hook' and `mail-send-hook'.
185Yet see info node `(message)Signing and encryption' why you
186might not want to rely for encryption on a hook function
187which runs just before the message is sent, that is, you might want
188to 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