Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 220 lines (193 sloc) 7.299 kb
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
2 ;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
9e7fc2f @railwaycat init emacs 23.2.92
authored
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG, mail, message
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
6 ;; Package: epa
9e7fc2f @railwaycat init emacs 23.2.92
authored
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Code:
24
25 (require 'epa)
26 (require 'mail-utils)
27
28 (defvar epa-mail-mode-map
29 (let ((keymap (make-sparse-keymap)))
30 (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
31 (define-key keymap "\C-c\C-ev" 'epa-mail-verify)
32 (define-key keymap "\C-c\C-es" 'epa-mail-sign)
33 (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt)
34 (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys)
35 (define-key keymap "\C-c\C-eo" 'epa-insert-keys)
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
36 (define-key keymap "\C-c\C-e\C-d" 'epa-mail-decrypt)
37 (define-key keymap "\C-c\C-e\C-v" 'epa-mail-verify)
38 (define-key keymap "\C-c\C-e\C-s" 'epa-mail-sign)
39 (define-key keymap "\C-c\C-e\C-e" 'epa-mail-encrypt)
40 (define-key keymap "\C-c\C-e\C-i" 'epa-mail-import-keys)
41 (define-key keymap "\C-c\C-e\C-o" 'epa-insert-keys)
9e7fc2f @railwaycat init emacs 23.2.92
authored
42 keymap))
43
44 (defvar epa-mail-mode-hook nil)
45 (defvar epa-mail-mode-on-hook nil)
46 (defvar epa-mail-mode-off-hook nil)
47
48 ;;;###autoload
49 (define-minor-mode epa-mail-mode
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
50 "A minor-mode for composing encrypted/clearsigned mails.
51 With a prefix argument ARG, enable the mode if ARG is positive,
52 and disable it otherwise. If called from Lisp, enable the mode
53 if ARG is omitted or nil."
9e7fc2f @railwaycat init emacs 23.2.92
authored
54 nil " epa-mail" epa-mail-mode-map)
55
56 (defun epa-mail--find-usable-key (keys usage)
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
57 "Find a usable key from KEYS for USAGE.
58 USAGE would be `sign' or `encrypt'."
9e7fc2f @railwaycat init emacs 23.2.92
authored
59 (catch 'found
60 (while keys
61 (let ((pointer (epg-key-sub-key-list (car keys))))
62 (while pointer
63 (if (and (memq usage (epg-sub-key-capability (car pointer)))
64 (not (memq (epg-sub-key-validity (car pointer))
65 '(revoked expired))))
66 (throw 'found (car keys)))
67 (setq pointer (cdr pointer))))
68 (setq keys (cdr keys)))))
69
70 ;;;###autoload
71 (defun epa-mail-decrypt ()
72 "Decrypt OpenPGP armors in the current buffer.
73 The buffer is expected to contain a mail message.
74
75 Don't use this command in Lisp programs!"
76 (interactive)
77 (epa-decrypt-armor-in-region (point-min) (point-max)))
78
79 ;;;###autoload
80 (defun epa-mail-verify ()
81 "Verify OpenPGP cleartext signed messages in the current buffer.
82 The buffer is expected to contain a mail message.
83
84 Don't use this command in Lisp programs!"
85 (interactive)
86 (epa-verify-cleartext-in-region (point-min) (point-max)))
87
88 ;;;###autoload
89 (defun epa-mail-sign (start end signers mode)
90 "Sign the current buffer.
91 The buffer is expected to contain a mail message.
92
93 Don't use this command in Lisp programs!"
94 (interactive
95 (save-excursion
96 (goto-char (point-min))
97 (if (search-forward mail-header-separator nil t)
98 (forward-line))
99 (setq epa-last-coding-system-specified
100 (or coding-system-for-write
101 (epa--select-safe-coding-system (point) (point-max))))
102 (let ((verbose current-prefix-arg))
103 (list (point) (point-max)
104 (if verbose
105 (epa-select-keys (epg-make-context epa-protocol)
106 "Select keys for signing.
107 If no one is selected, default secret key is used. "
108 nil t))
109 (if verbose
110 (epa--read-signature-type)
111 'clear)))))
112 (epa-sign-region start end signers mode))
113
114 ;;;###autoload
115 (defun epa-mail-encrypt (start end recipients sign signers)
116 "Encrypt the current buffer.
117 The buffer is expected to contain a mail message.
118
119 Don't use this command in Lisp programs!"
120 (interactive
121 (save-excursion
122 (let ((verbose current-prefix-arg)
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
123 (config (epg-configuration))
9e7fc2f @railwaycat init emacs 23.2.92
authored
124 (context (epg-make-context epa-protocol))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
125 recipients-string recipients recipient-key sign)
9e7fc2f @railwaycat init emacs 23.2.92
authored
126 (goto-char (point-min))
127 (save-restriction
128 (narrow-to-region (point)
129 (if (search-forward mail-header-separator nil 0)
130 (match-beginning 0)
131 (point)))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
132 (setq recipients-string
133 (mapconcat #'identity
134 (nconc (mail-fetch-field "to" nil nil t)
135 (mail-fetch-field "cc" nil nil t)
136 (mail-fetch-field "bcc" nil nil t))
137 ","))
9e7fc2f @railwaycat init emacs 23.2.92
authored
138 (setq recipients
139 (mail-strip-quoted-names
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
140 (with-temp-buffer
141 (insert "to: " recipients-string "\n")
142 (expand-mail-aliases (point-min) (point-max))
143 (car (mail-fetch-field "to" nil nil t))))))
9e7fc2f @railwaycat init emacs 23.2.92
authored
144 (if recipients
145 (setq recipients (delete ""
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
146 (split-string recipients
147 "[ \t\n]*,[ \t\n]*"))))
148
149 ;; Process all the recipients thru the list of GnuPG groups.
150 ;; Expand GnuPG group names to what they stand for.
151 (setq recipients
152 (apply #'nconc
153 (mapcar
154 (lambda (recipient)
155 (or (epg-expand-group config recipient)
156 (list recipient)))
157 recipients)))
158
9e7fc2f @railwaycat init emacs 23.2.92
authored
159 (goto-char (point-min))
160 (if (search-forward mail-header-separator nil t)
161 (forward-line))
162 (setq epa-last-coding-system-specified
163 (or coding-system-for-write
164 (epa--select-safe-coding-system (point) (point-max))))
165 (list (point) (point-max)
166 (if verbose
167 (epa-select-keys
168 context
169 "Select recipients for encryption.
170 If no one is selected, symmetric encryption will be performed. "
171 recipients)
172 (if recipients
173 (mapcar
174 (lambda (recipient)
175 (setq recipient-key
176 (epa-mail--find-usable-key
177 (epg-list-keys
178 (epg-make-context epa-protocol)
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
179 (if (string-match "@" recipient)
180 (concat "<" recipient ">")
181 recipient))
9e7fc2f @railwaycat init emacs 23.2.92
authored
182 'encrypt))
183 (unless (or recipient-key
184 (y-or-n-p
185 (format
186 "No public key for %s; skip it? "
187 recipient)))
188 (error "No public key for %s" recipient))
189 recipient-key)
190 recipients)))
191 (setq sign (if verbose (y-or-n-p "Sign? ")))
192 (if sign
193 (epa-select-keys context
194 "Select keys for signing. "))))))
195 (epa-encrypt-region start end recipients sign signers))
196
197 ;;;###autoload
198 (defun epa-mail-import-keys ()
199 "Import keys in the OpenPGP armor format in the current buffer.
200 The buffer is expected to contain a mail message.
201
202 Don't use this command in Lisp programs!"
203 (interactive)
204 (epa-import-armor-in-region (point-min) (point-max)))
205
206 ;;;###autoload
207 (define-minor-mode epa-global-mail-mode
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
208 "Minor mode to hook EasyPG into Mail mode.
209 With a prefix argument ARG, enable the mode if ARG is positive,
210 and disable it otherwise. If called from Lisp, enable the mode
211 if ARG is omitted or nil."
9e7fc2f @railwaycat init emacs 23.2.92
authored
212 :global t :init-value nil :group 'epa-mail :version "23.1"
213 (remove-hook 'mail-mode-hook 'epa-mail-mode)
214 (if epa-global-mail-mode
215 (add-hook 'mail-mode-hook 'epa-mail-mode)))
216
217 (provide 'epa-mail)
218
219 ;;; epa-mail.el ends here
Something went wrong with that request. Please try again.