|
0
|
1 ;; mc-toplev.el, entry point functions for Mailcrypt
|
|
|
2 ;; Copyright (C) 1995 Jin Choi <jsc@mit.edu>
|
|
|
3 ;; Patrick LoPresti <patl@lcs.mit.edu>
|
|
|
4
|
|
|
5 ;;{{{ Licensing
|
|
|
6 ;; This file is intended to be used with GNU Emacs.
|
|
|
7
|
|
|
8 ;; This program is free software; you can redistribute it and/or modify
|
|
|
9 ;; it under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; This program is distributed in the hope that it will be useful,
|
|
|
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
16 ;; GNU General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
|
19 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
21 ;;}}}
|
|
|
22 ;;{{{ Load some required packages
|
|
|
23 (require 'mailcrypt)
|
|
|
24 (require 'mail-utils)
|
|
|
25
|
|
|
26 (eval-when-compile
|
|
|
27 ;; RMAIL
|
|
|
28 (condition-case nil (require 'rmail) (error nil))
|
|
|
29 (autoload 'rmail-abort-edit "rmailedit")
|
|
|
30 (autoload 'rmail-cease-edit "rmailedit")
|
|
|
31 ;; Is this a good idea?
|
|
|
32 (defvar rmail-buffer nil)
|
|
|
33
|
|
|
34 ;; VM
|
|
|
35 (condition-case nil (require 'vm) (error nil))
|
|
|
36
|
|
|
37 ;; GNUS
|
|
|
38 (condition-case nil (require 'gnus) (error nil))
|
|
|
39
|
|
|
40 ;; MH-E
|
|
|
41 (condition-case nil (require 'mh-e) (error nil)))
|
|
|
42
|
|
|
43 (eval-and-compile
|
|
|
44 (condition-case nil (require 'mailalias) (error nil)))
|
|
|
45
|
|
|
46 (if (not mc-xemacs-p)
|
|
|
47 (autoload 'mc-scheme-pgp "mc-pgp" nil t))
|
|
|
48
|
|
|
49 ;;}}}
|
|
|
50
|
|
|
51 ;;{{{ Encryption
|
|
|
52
|
|
|
53 ;;;###autoload
|
|
|
54 (defun mc-cleanup-recipient-headers (str)
|
|
|
55 ;; Takes a comma separated string of recipients to encrypt for and,
|
|
|
56 ;; assuming they were possibly extracted from the headers of a reply,
|
|
|
57 ;; returns a list of the address components.
|
|
|
58 (mapcar 'mc-strip-address
|
|
|
59 (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" str)))
|
|
|
60
|
|
|
61 (defun mc-find-headers-end ()
|
|
|
62 (save-excursion
|
|
|
63 (goto-char (point-min))
|
|
|
64 (re-search-forward
|
|
|
65 (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
66 (if (looking-at "^::\n")
|
|
|
67 (re-search-forward "^\n" nil t))
|
|
|
68 (if (looking-at "^##\n")
|
|
|
69 (re-search-forward "^\n" nil t))
|
|
|
70 (point-marker)))
|
|
|
71
|
|
|
72 ;;;###autoload
|
|
|
73 (defun mc-encrypt (arg)
|
|
|
74 "*Encrypt the current buffer.
|
|
|
75
|
|
|
76 Exact behavior depends on current major mode.
|
|
|
77
|
|
|
78 With \\[universal-argument], prompt for User ID to sign as.
|
|
|
79
|
|
|
80 With \\[universal-argument] \\[universal-argument], prompt for encryption scheme to use."
|
|
|
81 (interactive "p")
|
|
|
82 (mc-encrypt-region arg nil nil))
|
|
|
83
|
|
|
84 (defun mc-encrypt-region (arg start end)
|
|
|
85 "*Encrypt the current region."
|
|
|
86 (interactive "p\nr")
|
|
|
87 (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
|
|
|
88 (func (or (cdr-safe (assq 'encrypt mode-alist))
|
|
|
89 'mc-encrypt-generic))
|
|
|
90 sign scheme from)
|
|
|
91 (if (>= arg 4)
|
|
|
92 (setq from (read-string "User ID: ")
|
|
|
93 sign t))
|
|
|
94 (if (>= arg 16)
|
|
|
95 (setq scheme
|
|
|
96 (cdr (assoc
|
|
|
97 (completing-read "Encryption Scheme: " mc-schemes)
|
|
|
98 mc-schemes))))
|
|
|
99 (funcall func nil scheme start end from sign)))
|
|
|
100
|
|
|
101 (defun mc-encrypt-generic (&optional recipients scheme start end from sign)
|
|
|
102 "*Generic function to encrypt a region of data."
|
|
|
103 (save-excursion
|
|
|
104 (or start (setq start (point-min-marker)))
|
|
|
105 (or (markerp start) (setq start (copy-marker start)))
|
|
|
106 (or end (setq end (point-max-marker)))
|
|
|
107 (or (markerp end) (setq end (copy-marker end)))
|
|
|
108 (run-hooks 'mc-pre-encryption-hook)
|
|
|
109 (cond ((stringp recipients)
|
|
|
110 (setq recipients
|
|
|
111 (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)))
|
|
|
112 ((null recipients)
|
|
|
113 (setq recipients
|
|
|
114 (mc-cleanup-recipient-headers (read-string "Recipients: "))))
|
|
|
115 (t (error "mc-encrypt-generic: recipients not string or nil")))
|
|
|
116 (or scheme (setq scheme mc-default-scheme))
|
|
|
117 (if (funcall (cdr (assoc 'encryption-func (funcall scheme)))
|
|
|
118 recipients start end from sign)
|
|
|
119 (progn
|
|
|
120 (run-hooks 'mc-post-encryption-hook)
|
|
|
121 t))))
|
|
|
122
|
|
|
123 ;;;###autoload
|
|
|
124 (defun mc-encrypt-message (&optional recipients scheme start end from sign)
|
|
|
125 "*Encrypt a message for RECIPIENTS using the given encryption SCHEME.
|
|
|
126 RECIPIENTS is a comma separated string. If SCHEME is nil, use the value
|
|
|
127 of `mc-default-scheme'. Returns t on success, nil otherwise."
|
|
|
128 (save-excursion
|
|
|
129 (let ((headers-end (mc-find-headers-end))
|
|
|
130 default-recipients)
|
|
|
131
|
|
|
132 (setq default-recipients
|
|
|
133 (save-restriction
|
|
|
134 (goto-char (point-min))
|
|
|
135 (re-search-forward
|
|
|
136 (concat "^" (regexp-quote mail-header-separator) "$"))
|
|
|
137 (narrow-to-region (point-min) (point))
|
|
|
138 (and (featurep 'mailalias)
|
|
|
139 (not (featurep 'mail-abbrevs))
|
|
|
140 mail-aliases
|
|
|
141 (expand-mail-aliases (point-min) (point-max)))
|
|
|
142 (mc-strip-addresses
|
|
|
143 (mapcar 'cdr
|
|
|
144 (mc-get-fields "to\\|cc\\|bcc")))))
|
|
|
145
|
|
|
146 (if (not from)
|
|
|
147 (save-restriction
|
|
|
148 (goto-char (point-min))
|
|
|
149 (re-search-forward
|
|
|
150 (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
151 (narrow-to-region (point) headers-end)
|
|
|
152 (setq from (mail-fetch-field "From"))))
|
|
|
153
|
|
|
154 (if (not recipients)
|
|
|
155 (setq recipients
|
|
|
156 (if mc-use-default-recipients
|
|
|
157 default-recipients
|
|
|
158 (read-from-minibuffer "Recipients: " default-recipients))))
|
|
|
159
|
|
|
160 (or start (setq start headers-end))
|
|
|
161 (or end (setq end (point-max-marker)))
|
|
|
162
|
|
|
163 (mc-encrypt-generic recipients scheme start end from sign))))
|
|
|
164
|
|
|
165
|
|
|
166 ;;}}}
|
|
|
167 ;;{{{ Decryption
|
|
|
168
|
|
|
169 ;;;###autoload
|
|
|
170 (defun mc-decrypt ()
|
|
|
171 "*Decrypt a message in the current buffer.
|
|
|
172
|
|
|
173 Exact behavior depends on current major mode."
|
|
|
174 (interactive)
|
|
|
175 (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
|
|
|
176 (func (or (cdr-safe (assq 'decrypt mode-alist))
|
|
|
177 'mc-decrypt-message)))
|
|
|
178 (funcall func)))
|
|
|
179
|
|
|
180 ;;;###autoload
|
|
|
181 (defun mc-decrypt-message ()
|
|
|
182 "Decrypt whatever message is in the current buffer.
|
|
|
183 Returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if the encryption
|
|
|
184 succeeded and VERIFIED is t if it had a valid signature."
|
|
|
185 (save-excursion
|
|
|
186 (let ((schemes mc-schemes)
|
|
|
187 limits scheme)
|
|
|
188 (while (and schemes
|
|
|
189 (setq scheme (cdr (car schemes)))
|
|
|
190 (not (setq
|
|
|
191 limits
|
|
|
192 (mc-message-delimiter-positions
|
|
|
193 (cdr (assoc 'msg-begin-line (funcall scheme)))
|
|
|
194 (cdr (assoc 'msg-end-line (funcall scheme)))))))
|
|
|
195 (setq schemes (cdr schemes)))
|
|
|
196
|
|
|
197 (if (null limits)
|
|
|
198 (error "Found no encrypted message in this buffer.")
|
|
|
199 (run-hooks 'mc-pre-decryption-hook)
|
|
|
200 (let ((resultval (funcall (cdr (assoc 'decryption-func
|
|
|
201 (funcall scheme)))
|
|
|
202 (car limits) (cdr limits))))
|
|
|
203 (goto-char (point-min))
|
|
|
204 (if (car resultval) ; decryption succeeded
|
|
|
205 (run-hooks 'mc-post-decryption-hook))
|
|
|
206 resultval)))))
|
|
|
207 ;;}}}
|
|
|
208 ;;{{{ Signing
|
|
|
209 ;;;###autoload
|
|
|
210 (defun mc-sign (arg)
|
|
|
211 "*Sign a message in the current buffer.
|
|
|
212
|
|
|
213 Exact behavior depends on current major mode.
|
|
|
214
|
|
|
215 With one prefix arg, prompts for private key to use, with two prefix args,
|
|
|
216 also prompts for encryption scheme to use. With negative prefix arg,
|
|
|
217 inhibits clearsigning (pgp)."
|
|
|
218 (interactive "p")
|
|
|
219 (mc-sign-region arg nil nil))
|
|
|
220
|
|
|
221 (defun mc-sign-region (arg start end)
|
|
|
222 "*Sign the current region."
|
|
|
223 (interactive "p\nr")
|
|
|
224 (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
|
|
|
225 (func (or (cdr-safe (assq 'sign mode-alist))
|
|
|
226 'mc-sign-generic))
|
|
|
227 from scheme)
|
|
|
228 (if (>= arg 16)
|
|
|
229 (setq scheme
|
|
|
230 (cdr (assoc
|
|
|
231 (completing-read "Encryption Scheme: " mc-schemes)
|
|
|
232 mc-schemes))))
|
|
|
233 (if (>= arg 4)
|
|
|
234 (setq from (read-string "User ID: ")))
|
|
|
235
|
|
|
236 (funcall func from scheme start end (< arg 0))))
|
|
|
237
|
|
|
238 (defun mc-sign-generic (withkey scheme start end unclearsig)
|
|
|
239 (or scheme (setq scheme mc-default-scheme))
|
|
|
240 (or start (setq start (point-min-marker)))
|
|
|
241 (or (markerp start) (setq start (copy-marker start)))
|
|
|
242 (or end (setq end (point-max-marker)))
|
|
|
243 (or (markerp end) (setq end (copy-marker end)))
|
|
|
244 (run-hooks 'mc-pre-signature-hook)
|
|
|
245 (if (funcall (cdr (assoc 'signing-func (funcall scheme)))
|
|
|
246 start end withkey unclearsig)
|
|
|
247 (progn
|
|
|
248 (run-hooks 'mc-post-signature-hook)
|
|
|
249 t)))
|
|
|
250
|
|
|
251 ;;;###autoload
|
|
|
252 (defun mc-sign-message (&optional withkey scheme start end unclearsig)
|
|
|
253 "Clear sign the message."
|
|
|
254 (save-excursion
|
|
|
255 (let ((headers-end (mc-find-headers-end)))
|
|
|
256 (or withkey
|
|
|
257 (progn
|
|
|
258 (goto-char (point-min))
|
|
|
259 (re-search-forward
|
|
|
260 (concat "^" (regexp-quote mail-header-separator) "\n"))
|
|
|
261 (save-restriction
|
|
|
262 (narrow-to-region (point) headers-end)
|
|
|
263 (setq withkey (mail-fetch-field "From")))))
|
|
|
264 (or start (setq start headers-end))
|
|
|
265 (or end (setq end (point-max-marker)))
|
|
|
266 (mc-sign-generic withkey scheme start end unclearsig))))
|
|
|
267
|
|
|
268 ;;}}}
|
|
|
269 ;;{{{ Signature verification
|
|
|
270
|
|
|
271 ;;;###autoload
|
|
|
272 (defun mc-verify ()
|
|
|
273 "*Verify a message in the current buffer.
|
|
|
274
|
|
|
275 Exact behavior depends on current major mode."
|
|
|
276 (interactive)
|
|
|
277 (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
|
|
|
278 (func (or (cdr-safe (assq 'verify mode-alist))
|
|
|
279 'mc-verify-signature)))
|
|
|
280 (funcall func)))
|
|
|
281
|
|
|
282 ;;;###autoload
|
|
|
283 (defun mc-verify-signature ()
|
|
|
284 "*Verify the signature of the signed message in the current buffer.
|
|
|
285 Show the result as a message in the minibuffer. Returns t if the signature
|
|
|
286 is verified."
|
|
|
287 (save-excursion
|
|
|
288 (let ((schemes mc-schemes)
|
|
|
289 limits scheme)
|
|
|
290 (while (and schemes
|
|
|
291 (setq scheme (cdr (car schemes)))
|
|
|
292 (not
|
|
|
293 (setq
|
|
|
294 limits
|
|
|
295 (mc-message-delimiter-positions
|
|
|
296 (cdr (assoc 'signed-begin-line (funcall scheme)))
|
|
|
297 (cdr (assoc 'signed-end-line (funcall scheme)))))))
|
|
|
298 (setq schemes (cdr schemes)))
|
|
|
299
|
|
|
300 (if (null limits)
|
|
|
301 (error "Found no signed message in this buffer.")
|
|
|
302 (funcall (cdr (assoc 'verification-func (funcall scheme)))
|
|
|
303 (car limits) (cdr limits))))))
|
|
|
304
|
|
|
305
|
|
|
306 ;;}}}
|
|
|
307 ;;{{{ Key management
|
|
|
308
|
|
|
309 ;;{{{ mc-insert-public-key
|
|
|
310
|
|
|
311 ;;;###autoload
|
|
|
312 (defun mc-insert-public-key (&optional userid scheme)
|
|
|
313 "*Insert your public key at point.
|
|
|
314 With one prefix arg, prompts for user id to use. With two prefix
|
|
|
315 args, prompts for encryption scheme."
|
|
|
316 (interactive
|
|
|
317 (let (arglist)
|
|
|
318 (if (not (and (listp current-prefix-arg)
|
|
|
319 (numberp (car current-prefix-arg))))
|
|
|
320 nil
|
|
|
321 (if (>= (car current-prefix-arg) 16)
|
|
|
322 (setq arglist
|
|
|
323 (cons (cdr (assoc (completing-read "Encryption Scheme: "
|
|
|
324 mc-schemes)
|
|
|
325 mc-schemes))
|
|
|
326 arglist)))
|
|
|
327 (if (>= (car current-prefix-arg) 4)
|
|
|
328 (setq arglist (cons (read-string "User ID: ") arglist))))
|
|
|
329 arglist))
|
|
|
330
|
|
|
331 ; (if (< (point) (mc-find-headers-end))
|
|
|
332 ; (error "Can't insert key inside message header"))
|
|
|
333 (or scheme (setq scheme mc-default-scheme))
|
|
|
334 (or userid (setq userid (cdr (assoc 'user-id (funcall scheme)))))
|
|
|
335
|
|
|
336 ;; (goto-char (point-max))
|
|
|
337 (if (not (bolp))
|
|
|
338 (insert "\n"))
|
|
|
339 (funcall (cdr (assoc 'key-insertion-func (funcall scheme))) userid))
|
|
|
340
|
|
|
341 ;;}}}
|
|
|
342 ;;{{{ mc-snarf-keys
|
|
|
343
|
|
|
344 ;;;###autoload
|
|
|
345 (defun mc-snarf ()
|
|
|
346 "*Add all public keys in the buffer to your keyring.
|
|
|
347
|
|
|
348 Exact behavior depends on current major mode."
|
|
|
349 (interactive)
|
|
|
350 (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
|
|
|
351 (func (or (cdr-safe (assq 'snarf mode-alist))
|
|
|
352 'mc-snarf-keys)))
|
|
|
353 (funcall func)))
|
|
|
354
|
|
|
355 ;;;###autoload
|
|
|
356 (defun mc-snarf-keys ()
|
|
|
357 "*Add all public keys in the buffer to your keyring."
|
|
|
358 (interactive)
|
|
|
359 (let ((schemes mc-schemes)
|
|
|
360 (start (point-min))
|
|
|
361 (found 0)
|
|
|
362 limits scheme)
|
|
|
363 (save-excursion
|
|
|
364 (catch 'done
|
|
|
365 (while t
|
|
|
366 (while (and schemes
|
|
|
367 (setq scheme (cdr (car schemes)))
|
|
|
368 (not
|
|
|
369 (setq
|
|
|
370 limits
|
|
|
371 (mc-message-delimiter-positions
|
|
|
372 (cdr (assoc 'key-begin-line (funcall scheme)))
|
|
|
373 (cdr (assoc 'key-end-line (funcall scheme)))
|
|
|
374 start))))
|
|
|
375 (setq schemes (cdr schemes)))
|
|
|
376 (if (null limits)
|
|
|
377 (throw 'done found)
|
|
|
378 (setq start (cdr limits))
|
|
|
379 (setq found (+ found (funcall (cdr (assoc 'snarf-func
|
|
|
380 (funcall scheme)))
|
|
|
381 (car limits) (cdr limits)))))))
|
|
|
382 (message (format "%d new key%s found" found
|
|
|
383 (if (eq 1 found) "" "s"))))))
|
|
|
384 ;;}}}
|
|
|
385 ;;}}}
|
|
|
386 ;;{{{ Mode specific functions
|
|
|
387
|
|
|
388 ;;{{{ RMAIL
|
|
|
389 ;;;###autoload
|
|
|
390 (defun mc-rmail-summary-verify-signature ()
|
|
|
391 "*Verify the signature in the current message."
|
|
|
392 (interactive)
|
|
|
393 (if (not (eq major-mode 'rmail-summary-mode))
|
|
|
394 (error
|
|
|
395 "mc-rmail-summary-verify-signature called in inappropriate buffer"))
|
|
|
396 (save-excursion
|
|
|
397 (set-buffer rmail-buffer)
|
|
|
398 (mc-verify)))
|
|
|
399
|
|
|
400 ;;;###autoload
|
|
|
401 (defun mc-rmail-summary-decrypt-message ()
|
|
|
402 "*Decrypt the contents of this message"
|
|
|
403 (interactive)
|
|
|
404 (if (not (eq major-mode 'rmail-summary-mode))
|
|
|
405 (error
|
|
|
406 "mc-rmail-summary-decrypt-message called in inappropriate buffer"))
|
|
|
407 (save-excursion
|
|
|
408 (set-buffer rmail-buffer)
|
|
|
409 (mc-decrypt)))
|
|
|
410
|
|
|
411 ;;;###autoload
|
|
|
412 (defun mc-rmail-summary-snarf-keys ()
|
|
|
413 "*Adds keys from current message to public key ring"
|
|
|
414 (interactive)
|
|
|
415 (if (not (eq major-mode 'rmail-summary-mode))
|
|
|
416 (error
|
|
|
417 "mc-rmail-summary-snarf-keys called in inappropriate buffer"))
|
|
|
418 (save-excursion
|
|
|
419 (set-buffer rmail-buffer)
|
|
|
420 (mc-snarf)))
|
|
|
421
|
|
|
422 ;;;###autoload
|
|
|
423 (defun mc-rmail-verify-signature ()
|
|
|
424 "*Verify the signature in the current message."
|
|
|
425 (interactive)
|
|
|
426 (if (not (equal mode-name "RMAIL"))
|
|
|
427 (error "mc-rmail-verify-signature called in a non-RMAIL buffer"))
|
|
|
428 ;; Hack to load rmailkwd before verifying sig
|
|
|
429 (rmail-add-label "verified")
|
|
|
430 (rmail-kill-label "verified")
|
|
|
431 (if (mc-verify-signature)
|
|
|
432 (rmail-add-label "verified")))
|
|
|
433
|
|
|
434 ;;;###autoload
|
|
|
435 (defun mc-rmail-decrypt-message ()
|
|
|
436 "*Decrypt the contents of this message"
|
|
|
437 (interactive)
|
|
|
438 (let (decryption-result)
|
|
|
439 (if (not (equal mode-name "RMAIL"))
|
|
|
440 (error "mc-rmail-decrypt-message called in a non-RMAIL buffer"))
|
|
|
441 (unwind-protect
|
|
|
442 (progn
|
|
|
443 (rmail-edit-current-message)
|
|
|
444 (setq decryption-result (mc-decrypt-message))
|
|
|
445 (cond ((not (car decryption-result))
|
|
|
446 (rmail-abort-edit))
|
|
|
447 ((and (not (eq mc-always-replace 'never))
|
|
|
448 (or mc-always-replace
|
|
|
449 (y-or-n-p
|
|
|
450 "Replace encrypted message with decrypted? ")))
|
|
|
451 (rmail-cease-edit)
|
|
|
452 (rmail-kill-label "edited")
|
|
|
453 (rmail-add-label "decrypted")
|
|
|
454 (if (cdr decryption-result)
|
|
|
455 (rmail-add-label "verified")))
|
|
|
456 (t
|
|
|
457 (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
|
|
|
458 (copy-to-buffer tmp (point-min) (point-max))
|
|
|
459 (rmail-abort-edit)
|
|
|
460 (switch-to-buffer tmp t)
|
|
|
461 (goto-char (point-min))
|
|
|
462 (insert "From Mailcrypt-" mc-version " "
|
|
|
463 (current-time-string) "\n")
|
|
|
464 (rmail-convert-file)
|
|
|
465 (rmail-mode)
|
|
|
466 (use-local-map (copy-keymap (current-local-map)))
|
|
|
467 (local-set-key "q" 'mc-rmail-view-quit)
|
|
|
468 (set-buffer-modified-p nil)))))
|
|
|
469 (if (eq major-mode 'rmail-edit-mode)
|
|
|
470 (rmail-abort-edit)))))
|
|
|
471
|
|
|
472 (defun mc-rmail-view-quit ()
|
|
|
473 (interactive)
|
|
|
474 (let ((buf (current-buffer)))
|
|
|
475 (set-buffer-modified-p nil)
|
|
|
476 (rmail-quit)
|
|
|
477 (kill-buffer buf)))
|
|
|
478
|
|
|
479 ;;}}}
|
|
|
480 ;;{{{ VM
|
|
|
481 ;;;###autoload
|
|
|
482 (defun mc-vm-verify-signature ()
|
|
|
483 "*Verify the signature in the current VM message"
|
|
|
484 (interactive)
|
|
|
485 (if (interactive-p)
|
|
|
486 (vm-follow-summary-cursor))
|
|
|
487 (vm-select-folder-buffer)
|
|
|
488 (vm-check-for-killed-summary)
|
|
|
489 (vm-error-if-folder-empty)
|
|
|
490 (save-restriction
|
|
|
491 (vm-widen-page)
|
|
|
492 (mc-verify-signature)))
|
|
|
493
|
|
|
494 ;;;###autoload
|
|
|
495 (defun mc-vm-decrypt-message ()
|
|
|
496 "*Decrypt the contents of the current VM message"
|
|
|
497 (interactive)
|
|
|
498 (let ((vm-frame-per-edit nil)
|
|
|
499 from-line)
|
|
|
500 (if (interactive-p)
|
|
|
501 (vm-follow-summary-cursor))
|
|
|
502 (vm-select-folder-buffer)
|
|
|
503 (vm-check-for-killed-summary)
|
|
|
504 (vm-error-if-folder-read-only)
|
|
|
505 (vm-error-if-folder-empty)
|
|
|
506
|
|
|
507 ;; store away a valid "From " line for possible later use.
|
|
|
508 (setq from-line (vm-leading-message-separator))
|
|
|
509 (vm-edit-message)
|
|
|
510 (cond ((not (condition-case condition-data
|
|
|
511 (car (mc-decrypt-message))
|
|
|
512 (error
|
|
|
513 (vm-edit-message-abort)
|
|
|
514 (error (message "Decryption failed: %s"
|
|
|
515 (car (cdr condition-data)))))))
|
|
|
516 (vm-edit-message-abort)
|
|
|
517 (error "Decryption failed."))
|
|
|
518 ((and (not (eq mc-always-replace 'never))
|
|
|
519 (or mc-always-replace
|
|
|
520 (y-or-n-p "Replace encrypted message with decrypted? ")))
|
|
|
521 (let ((this-command 'vm-edit-message-end))
|
|
|
522 (vm-edit-message-end)))
|
|
|
523 (t
|
|
|
524 (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
|
|
|
525 (copy-to-buffer tmp (point-min) (point-max))
|
|
|
526 (vm-edit-message-abort)
|
|
|
527 (switch-to-buffer tmp t)
|
|
|
528 (goto-char (point-min))
|
|
|
529 (insert from-line)
|
|
|
530 (set-buffer-modified-p nil)
|
|
|
531 (vm-mode t))))))
|
|
|
532
|
|
|
533 ;;;###autoload
|
|
|
534 (defun mc-vm-snarf-keys ()
|
|
|
535 "*Snarf public key from the contents of the current VM message"
|
|
|
536 (interactive)
|
|
|
537 (if (interactive-p)
|
|
|
538 (vm-follow-summary-cursor))
|
|
|
539 (vm-select-folder-buffer)
|
|
|
540 (vm-check-for-killed-summary)
|
|
|
541 (vm-error-if-folder-empty)
|
|
|
542 (save-restriction
|
|
|
543 (vm-widen-page)
|
|
|
544 (mc-snarf-keys)))
|
|
|
545
|
|
|
546 ;;}}}
|
|
|
547 ;;{{{ GNUS
|
|
|
548
|
|
|
549 ;;;###autoload
|
|
|
550 (defun mc-gnus-verify-signature ()
|
|
|
551 (interactive)
|
|
|
552 (gnus-summary-select-article)
|
|
2
|
553 (save-excursion
|
|
|
554 (set-buffer gnus-original-article-buffer)
|
|
0
|
555 (save-restriction (widen) (mc-verify-signature))))
|
|
|
556
|
|
|
557 ;;;###autoload
|
|
|
558 (defun mc-gnus-snarf-keys ()
|
|
|
559 (interactive)
|
|
|
560 (gnus-summary-select-article)
|
|
|
561 (gnus-eval-in-buffer-window gnus-article-buffer
|
|
|
562 (save-restriction (widen) (mc-snarf-keys))))
|
|
|
563
|
|
|
564 ;;;###autoload
|
|
|
565 (defun mc-gnus-decrypt-message ()
|
|
|
566 (interactive)
|
|
|
567 (gnus-summary-select-article)
|
|
|
568 ;; Gnus 5 has the string "Gnus" instead of "GNUS" in gnus-version.
|
|
|
569 (if (not (let ((case-fold-search nil))
|
|
|
570 (string-match "Gnus" gnus-version)))
|
|
|
571 (gnus-eval-in-buffer-window
|
|
|
572 gnus-article-buffer
|
|
|
573 (save-restriction (widen) (mc-decrypt-message)))
|
|
|
574 ;; Gnus 5 allows editing of articles. (Actually, it makes a great
|
|
|
575 ;; mail reader.)
|
|
|
576 (gnus-eval-in-buffer-window gnus-article-buffer
|
|
|
577 (gnus-summary-edit-article t)
|
|
|
578 (save-restriction
|
|
|
579 (widen)
|
|
|
580 (cond ((not (car (mc-decrypt-message)))
|
|
|
581 (gnus-summary-edit-article-postpone))
|
|
|
582 ((and (not (gnus-group-read-only-p))
|
|
|
583 (not (eq mc-always-replace 'never))
|
|
|
584 (or mc-always-replace
|
|
|
585 (y-or-n-p
|
|
|
586 "Replace encrypted message on disk? ")))
|
|
|
587 (gnus-summary-edit-article-done))
|
|
|
588 (t
|
|
|
589 (gnus-summary-edit-article-postpone)))))))
|
|
|
590
|
|
|
591 ;;}}}
|
|
|
592 ;;{{{ MH
|
|
|
593
|
|
|
594 ;;;###autoload
|
|
|
595 (defun mc-mh-decrypt-message ()
|
|
|
596 "Decrypt the contents of the current MH message in the show buffer."
|
|
|
597 (interactive "P")
|
|
|
598 (let* ((msg (mh-get-msg-num t))
|
|
|
599 (msg-filename (mh-msg-filename msg))
|
|
|
600 (show-buffer (get-buffer mh-show-buffer))
|
|
|
601 decrypt-okay decrypt-on-disk)
|
|
|
602 (setq
|
|
|
603 decrypt-on-disk
|
|
|
604 (and (not (eq mc-always-replace 'never))
|
|
|
605 (or mc-always-replace
|
|
|
606 (y-or-n-p "Replace encrypted message on disk? "))))
|
|
|
607 (if decrypt-on-disk
|
|
|
608 (progn
|
|
|
609 (save-excursion
|
|
|
610 (set-buffer (create-file-buffer msg-filename))
|
|
|
611 (insert-file-contents msg-filename t)
|
|
|
612 (if (setq decrypt-okay (car (mc-decrypt-message)))
|
|
|
613 (save-buffer)
|
|
|
614 (message "Decryption failed.")
|
|
|
615 (set-buffer-modified-p nil))
|
|
|
616 (kill-buffer nil))
|
|
|
617 (if decrypt-okay
|
|
|
618 (if (and show-buffer
|
|
|
619 (equal msg-filename (buffer-file-name show-buffer)))
|
|
|
620 (save-excursion
|
|
|
621 (save-window-excursion
|
|
|
622 (mh-invalidate-show-buffer)))))
|
|
|
623 (mh-show msg))
|
|
|
624 (mh-show msg)
|
|
|
625 (save-excursion
|
|
|
626 (set-buffer mh-show-buffer)
|
|
|
627 (if (setq decrypt-okay (car (mc-decrypt-message)))
|
|
|
628 (progn
|
|
|
629 (goto-char (point-min))
|
|
|
630 (set-buffer-modified-p nil))
|
|
|
631 (message "Decryption failed.")))
|
|
|
632 (if (not decrypt-okay)
|
|
|
633 (progn
|
|
|
634 (mh-invalidate-show-buffer)
|
|
|
635 (mh-show msg))))))
|
|
|
636
|
|
|
637 ;;;###autoload
|
|
|
638 (defun mc-mh-verify-signature ()
|
|
|
639 "*Verify the signature in the current MH message."
|
|
|
640 (interactive)
|
|
|
641 (mh-show)
|
|
|
642 (mh-in-show-buffer (mh-show-buffer)
|
|
|
643 (mc-verify-signature)))
|
|
|
644
|
|
|
645
|
|
|
646 ;;;###autoload
|
|
|
647 (defun mc-mh-snarf-keys ()
|
|
|
648 (interactive)
|
|
|
649 (mh-show)
|
|
|
650 (mh-in-show-buffer (mh-show-buffer)
|
|
|
651 (mc-snarf-keys)))
|
|
|
652
|
|
|
653 ;;}}}
|
|
|
654
|
|
|
655 ;;}}}
|
