1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
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
|
