Mercurial > emacs
annotate lisp/epa.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 5a957bb32b66 |
children | f60f4abe5849 376148b31b5e |
rev | line source |
---|---|
91647 | 1 ;;; epa.el --- the EasyPG Assistant |
106815 | 2 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
91647 | 3 |
4 ;; Author: Daiki Ueno <ueno@unixuser.org> | |
5 ;; Keywords: PGP, GnuPG | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94490
diff
changeset
|
9 ;; GNU Emacs is free software: you can redistribute it and/or modify |
91647 | 10 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94490
diff
changeset
|
11 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94490
diff
changeset
|
12 ;; (at your option) any later version. |
91647 | 13 |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94490
diff
changeset
|
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
91647 | 21 |
22 ;;; Code: | |
23 | |
24 (require 'epg) | |
25 (require 'font-lock) | |
26 (require 'widget) | |
27 (eval-when-compile (require 'wid-edit)) | |
28 (require 'derived) | |
29 | |
30 (defgroup epa nil | |
31 "The EasyPG Assistant" | |
91703
bda1e76bc03b
* epa.el (epa-faces, epa):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
91687
diff
changeset
|
32 :version "23.1" |
91647 | 33 :group 'epg) |
34 | |
35 (defcustom epa-popup-info-window t | |
36 "If non-nil, status information from epa commands is displayed on | |
37 the separate window." | |
38 :type 'boolean | |
39 :group 'epa) | |
40 | |
41 (defcustom epa-info-window-height 5 | |
42 "Number of lines used to display status information." | |
43 :type 'integer | |
44 :group 'epa) | |
45 | |
46 (defgroup epa-faces nil | |
47 "Faces for epa-mode." | |
91703
bda1e76bc03b
* epa.el (epa-faces, epa):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
91687
diff
changeset
|
48 :version "23.1" |
91647 | 49 :group 'epa) |
50 | |
51 (defface epa-validity-high | |
52 `((((class color) (background dark)) | |
53 (:foreground "PaleTurquoise" | |
54 ,@(if (assq ':weight custom-face-attributes) | |
55 '(:weight bold) | |
56 '(:bold t)))) | |
57 (t | |
58 (,@(if (assq ':weight custom-face-attributes) | |
59 '(:weight bold) | |
60 '(:bold t))))) | |
61 "Face used for displaying the high validity." | |
62 :group 'epa-faces) | |
63 | |
64 (defface epa-validity-medium | |
65 `((((class color) (background dark)) | |
66 (:foreground "PaleTurquoise" | |
67 ,@(if (assq ':slant custom-face-attributes) | |
68 '(:slant italic) | |
69 '(:italic t)))) | |
70 (t | |
71 (,@(if (assq ':slant custom-face-attributes) | |
72 '(:slant italic) | |
73 '(:italic t))))) | |
74 "Face used for displaying the medium validity." | |
75 :group 'epa-faces) | |
76 | |
77 (defface epa-validity-low | |
78 `((t | |
79 (,@(if (assq ':slant custom-face-attributes) | |
80 '(:slant italic) | |
81 '(:italic t))))) | |
82 "Face used for displaying the low validity." | |
83 :group 'epa-faces) | |
84 | |
85 (defface epa-validity-disabled | |
86 `((t | |
87 (,@(if (assq ':slant custom-face-attributes) | |
88 '(:slant italic) | |
89 '(:italic t)) | |
90 :inverse-video t))) | |
91 "Face used for displaying the disabled validity." | |
92 :group 'epa-faces) | |
93 | |
94 (defface epa-string | |
95 '((((class color) (background dark)) | |
96 (:foreground "lightyellow")) | |
97 (((class color) (background light)) | |
98 (:foreground "blue4"))) | |
99 "Face used for displaying the string." | |
100 :group 'epa-faces) | |
101 | |
102 (defface epa-mark | |
103 `((((class color) (background dark)) | |
104 (:foreground "orange" | |
105 ,@(if (assq ':weight custom-face-attributes) | |
106 '(:weight bold) | |
107 '(:bold t)))) | |
108 (((class color) (background light)) | |
109 (:foreground "red" | |
110 ,@(if (assq ':weight custom-face-attributes) | |
111 '(:weight bold) | |
112 '(:bold t)))) | |
113 (t | |
114 (,@(if (assq ':weight custom-face-attributes) | |
115 '(:weight bold) | |
116 '(:bold t))))) | |
117 "Face used for displaying the high validity." | |
118 :group 'epa-faces) | |
119 | |
120 (defface epa-field-name | |
121 `((((class color) (background dark)) | |
122 (:foreground "PaleTurquoise" | |
123 ,@(if (assq ':weight custom-face-attributes) | |
124 '(:weight bold) | |
125 '(:bold t)))) | |
126 (t | |
127 (,@(if (assq ':weight custom-face-attributes) | |
128 '(:weight bold) | |
129 '(:bold t))))) | |
130 "Face for the name of the attribute field." | |
131 :group 'epa) | |
132 | |
133 (defface epa-field-body | |
134 `((((class color) (background dark)) | |
135 (:foreground "turquoise" | |
136 ,@(if (assq ':slant custom-face-attributes) | |
137 '(:slant italic) | |
138 '(:italic t)))) | |
139 (t | |
140 (,@(if (assq ':slant custom-face-attributes) | |
141 '(:slant italic) | |
142 '(:italic t))))) | |
143 "Face for the body of the attribute field." | |
144 :group 'epa) | |
145 | |
146 (defcustom epa-validity-face-alist | |
147 '((unknown . epa-validity-disabled) | |
148 (invalid . epa-validity-disabled) | |
149 (disabled . epa-validity-disabled) | |
150 (revoked . epa-validity-disabled) | |
151 (expired . epa-validity-disabled) | |
152 (none . epa-validity-low) | |
153 (undefined . epa-validity-low) | |
154 (never . epa-validity-low) | |
155 (marginal . epa-validity-medium) | |
156 (full . epa-validity-high) | |
157 (ultimate . epa-validity-high)) | |
158 "An alist mapping validity values to faces." | |
159 :type '(repeat (cons symbol face)) | |
160 :group 'epa) | |
161 | |
162 (defvar epa-font-lock-keywords | |
163 '(("^\\*" | |
164 (0 'epa-mark)) | |
165 ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$" | |
166 (1 'epa-field-name) | |
167 (2 'epa-field-body))) | |
168 "Default expressions to addon in epa-mode.") | |
169 | |
170 (defconst epa-pubkey-algorithm-letter-alist | |
171 '((1 . ?R) | |
172 (2 . ?r) | |
173 (3 . ?s) | |
174 (16 . ?g) | |
175 (17 . ?D) | |
176 (20 . ?G))) | |
177 | |
178 (defvar epa-protocol 'OpenPGP | |
179 "*The default protocol. | |
180 The value can be either OpenPGP or CMS. | |
181 | |
182 You should bind this variable with `let', but do not set it globally.") | |
183 | |
184 (defvar epa-armor nil | |
185 "*If non-nil, epa commands create ASCII armored output. | |
186 | |
187 You should bind this variable with `let', but do not set it globally.") | |
188 | |
189 (defvar epa-textmode nil | |
190 "*If non-nil, epa commands treat input files as text. | |
191 | |
192 You should bind this variable with `let', but do not set it globally.") | |
193 | |
194 (defvar epa-keys-buffer nil) | |
195 (defvar epa-key-buffer-alist nil) | |
196 (defvar epa-key nil) | |
197 (defvar epa-list-keys-arguments nil) | |
198 (defvar epa-info-buffer nil) | |
199 (defvar epa-last-coding-system-specified nil) | |
200 | |
201 (defvar epa-key-list-mode-map | |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
202 (let ((keymap (make-sparse-keymap)) |
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
203 (menu-map (make-sparse-keymap))) |
91647 | 204 (define-key keymap "m" 'epa-mark-key) |
205 (define-key keymap "u" 'epa-unmark-key) | |
206 (define-key keymap "d" 'epa-decrypt-file) | |
207 (define-key keymap "v" 'epa-verify-file) | |
208 (define-key keymap "s" 'epa-sign-file) | |
209 (define-key keymap "e" 'epa-encrypt-file) | |
210 (define-key keymap "r" 'epa-delete-keys) | |
211 (define-key keymap "i" 'epa-import-keys) | |
212 (define-key keymap "o" 'epa-export-keys) | |
213 (define-key keymap "g" 'revert-buffer) | |
214 (define-key keymap "n" 'next-line) | |
215 (define-key keymap "p" 'previous-line) | |
216 (define-key keymap " " 'scroll-up) | |
217 (define-key keymap [delete] 'scroll-down) | |
218 (define-key keymap "q" 'epa-exit-buffer) | |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
219 (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map)) |
94490
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
220 (define-key menu-map [epa-key-list-unmark-key] |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
221 '(menu-item "Unmark Key" epa-unmark-key |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
222 :help "Unmark a key")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
223 (define-key menu-map [epa-key-list-mark-key] |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
224 '(menu-item "Mark Key" epa-mark-key |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
225 :help "Mark a key")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
226 (define-key menu-map [separator-epa-file] '(menu-item "--")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
227 (define-key menu-map [epa-verify-file] |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
228 '(menu-item "Verify File..." epa-verify-file |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
229 :help "Verify FILE")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
230 (define-key menu-map [epa-sign-file] |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
231 '(menu-item "Sign File..." epa-sign-file |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
232 :help "Sign FILE by SIGNERS keys selected")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
233 (define-key menu-map [epa-decrypt-file] |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
234 '(menu-item "Decrypt File..." epa-decrypt-file |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
235 :help "Decrypt FILE")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
236 (define-key menu-map [epa-encrypt-file] |
105275
b78ceb253d15
* speedbar.el (speedbar-item-delete):
Juanma Barranquero <lekktu@gmail.com>
parents:
104395
diff
changeset
|
237 '(menu-item "Encrypt File..." epa-encrypt-file |
94490
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
238 :help "Encrypt FILE for RECIPIENTS")) |
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
239 (define-key menu-map [separator-epa-key-list] '(menu-item "--")) |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
240 (define-key menu-map [epa-key-list-delete-keys] |
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
241 '(menu-item "Delete keys" epa-delete-keys |
94490
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
242 :help "Delete Marked Keys")) |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
243 (define-key menu-map [epa-key-list-import-keys] |
94490
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
244 '(menu-item "Import Keys" epa-import-keys |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
245 :help "Import keys from a file")) |
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
246 (define-key menu-map [epa-key-list-export-keys] |
94490
dcbaed9de6ff
(epa-key-list-mode-map): Add more menu entries.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
94471
diff
changeset
|
247 '(menu-item "Export Keys" epa-export-keys |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
248 :help "Export marked keys to a file")) |
91647 | 249 keymap)) |
250 | |
251 (defvar epa-key-mode-map | |
252 (let ((keymap (make-sparse-keymap))) | |
253 (define-key keymap "q" 'epa-exit-buffer) | |
254 keymap)) | |
255 | |
256 (defvar epa-info-mode-map | |
257 (let ((keymap (make-sparse-keymap))) | |
258 (define-key keymap "q" 'delete-window) | |
259 keymap)) | |
260 | |
261 (defvar epa-exit-buffer-function #'bury-buffer) | |
262 | |
263 (define-widget 'epa-key 'push-button | |
264 "Button for representing a epg-key object." | |
265 :format "%[%v%]" | |
266 :button-face-get 'epa--key-widget-button-face-get | |
267 :value-create 'epa--key-widget-value-create | |
268 :action 'epa--key-widget-action | |
269 :help-echo 'epa--key-widget-help-echo) | |
270 | |
271 (defun epa--key-widget-action (widget &optional event) | |
97719
73388588c9b4
(epa--key-widget-action): Save the selected window to
Daiki Ueno <ueno@unixuser.org>
parents:
96760
diff
changeset
|
272 (save-selected-window |
73388588c9b4
(epa--key-widget-action): Save the selected window to
Daiki Ueno <ueno@unixuser.org>
parents:
96760
diff
changeset
|
273 (epa--show-key (widget-get widget :value)))) |
91647 | 274 |
275 (defun epa--key-widget-value-create (widget) | |
276 (let* ((key (widget-get widget :value)) | |
277 (primary-sub-key (car (epg-key-sub-key-list key))) | |
278 (primary-user-id (car (epg-key-user-id-list key)))) | |
279 (insert (format "%c " | |
280 (if (epg-sub-key-validity primary-sub-key) | |
281 (car (rassq (epg-sub-key-validity primary-sub-key) | |
282 epg-key-validity-alist)) | |
283 ? )) | |
284 (epg-sub-key-id primary-sub-key) | |
285 " " | |
286 (if primary-user-id | |
287 (if (stringp (epg-user-id-string primary-user-id)) | |
288 (epg-user-id-string primary-user-id) | |
289 (epg-decode-dn (epg-user-id-string primary-user-id))) | |
290 "")))) | |
291 | |
292 (defun epa--key-widget-button-face-get (widget) | |
293 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list | |
294 (widget-get widget :value)))))) | |
295 (if validity | |
296 (cdr (assq validity epa-validity-face-alist)) | |
297 'default))) | |
298 | |
299 (defun epa--key-widget-help-echo (widget) | |
300 (format "Show %s" | |
301 (epg-sub-key-id (car (epg-key-sub-key-list | |
302 (widget-get widget :value)))))) | |
303 | |
304 (eval-and-compile | |
305 (if (fboundp 'encode-coding-string) | |
306 (defalias 'epa--encode-coding-string 'encode-coding-string) | |
307 (defalias 'epa--encode-coding-string 'identity))) | |
308 | |
309 (eval-and-compile | |
310 (if (fboundp 'decode-coding-string) | |
311 (defalias 'epa--decode-coding-string 'decode-coding-string) | |
312 (defalias 'epa--decode-coding-string 'identity))) | |
313 | |
314 (defun epa-key-list-mode () | |
315 "Major mode for `epa-list-keys'." | |
316 (kill-all-local-variables) | |
317 (buffer-disable-undo) | |
318 (setq major-mode 'epa-key-list-mode | |
319 mode-name "Keys" | |
320 truncate-lines t | |
321 buffer-read-only t) | |
322 (use-local-map epa-key-list-mode-map) | |
323 (make-local-variable 'font-lock-defaults) | |
324 (setq font-lock-defaults '(epa-font-lock-keywords t)) | |
325 ;; In XEmacs, auto-initialization of font-lock is not effective | |
326 ;; if buffer-file-name is not set. | |
327 (font-lock-set-defaults) | |
328 (make-local-variable 'epa-exit-buffer-function) | |
329 (make-local-variable 'revert-buffer-function) | |
330 (setq revert-buffer-function 'epa--key-list-revert-buffer) | |
96760
b056a93eb26f
(epa-key-list-mode): Use run-mode-hooks.
Daiki Ueno <ueno@unixuser.org>
parents:
94678
diff
changeset
|
331 (run-mode-hooks 'epa-key-list-mode-hook)) |
91647 | 332 |
333 (defun epa-key-mode () | |
334 "Major mode for a key description." | |
335 (kill-all-local-variables) | |
336 (buffer-disable-undo) | |
337 (setq major-mode 'epa-key-mode | |
338 mode-name "Key" | |
339 truncate-lines t | |
340 buffer-read-only t) | |
341 (use-local-map epa-key-mode-map) | |
342 (make-local-variable 'font-lock-defaults) | |
343 (setq font-lock-defaults '(epa-font-lock-keywords t)) | |
344 ;; In XEmacs, auto-initialization of font-lock is not effective | |
345 ;; if buffer-file-name is not set. | |
346 (font-lock-set-defaults) | |
347 (make-local-variable 'epa-exit-buffer-function) | |
96760
b056a93eb26f
(epa-key-list-mode): Use run-mode-hooks.
Daiki Ueno <ueno@unixuser.org>
parents:
94678
diff
changeset
|
348 (run-mode-hooks 'epa-key-mode-hook)) |
91647 | 349 |
350 (defun epa-info-mode () | |
351 "Major mode for `epa-info-buffer'." | |
352 (kill-all-local-variables) | |
353 (buffer-disable-undo) | |
354 (setq major-mode 'epa-info-mode | |
355 mode-name "Info" | |
356 truncate-lines t | |
357 buffer-read-only t) | |
358 (use-local-map epa-info-mode-map) | |
96760
b056a93eb26f
(epa-key-list-mode): Use run-mode-hooks.
Daiki Ueno <ueno@unixuser.org>
parents:
94678
diff
changeset
|
359 (run-mode-hooks 'epa-info-mode-hook)) |
91647 | 360 |
361 (defun epa-mark-key (&optional arg) | |
362 "Mark a key on the current line. | |
363 If ARG is non-nil, unmark the key." | |
364 (interactive "P") | |
365 (let ((inhibit-read-only t) | |
366 buffer-read-only | |
367 properties) | |
368 (beginning-of-line) | |
369 (unless (get-text-property (point) 'epa-key) | |
370 (error "No key on this line")) | |
371 (setq properties (text-properties-at (point))) | |
372 (delete-char 1) | |
373 (insert (if arg " " "*")) | |
374 (set-text-properties (1- (point)) (point) properties) | |
375 (forward-line))) | |
376 | |
377 (defun epa-unmark-key (&optional arg) | |
378 "Unmark a key on the current line. | |
379 If ARG is non-nil, mark the key." | |
380 (interactive "P") | |
381 (epa-mark-key (not arg))) | |
382 | |
383 (defun epa-exit-buffer () | |
384 "Exit the current buffer. | |
385 `epa-exit-buffer-function' is called if it is set." | |
386 (interactive) | |
387 (funcall epa-exit-buffer-function)) | |
388 | |
389 (defun epa--insert-keys (keys) | |
390 (save-excursion | |
391 (save-restriction | |
392 (narrow-to-region (point) (point)) | |
393 (let (point) | |
394 (while keys | |
395 (setq point (point)) | |
396 (insert " ") | |
397 (add-text-properties point (point) | |
398 (list 'epa-key (car keys) | |
399 'front-sticky nil | |
400 'rear-nonsticky t | |
401 'start-open t | |
402 'end-open t)) | |
403 (widget-create 'epa-key :value (car keys)) | |
404 (insert "\n") | |
91731
7efbdc83b944
EasyPG: Implement some suggestions from emacs-devel.
Michael Olson <mwolson@gnu.org>
parents:
91703
diff
changeset
|
405 (setq keys (cdr keys)))) |
91647 | 406 (add-text-properties (point-min) (point-max) |
407 (list 'epa-list-keys t | |
408 'front-sticky nil | |
409 'rear-nonsticky t | |
410 'start-open t | |
411 'end-open t))))) | |
412 | |
413 (defun epa--list-keys (name secret) | |
414 (unless (and epa-keys-buffer | |
415 (buffer-live-p epa-keys-buffer)) | |
416 (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) | |
417 (set-buffer epa-keys-buffer) | |
418 (epa-key-list-mode) | |
419 (let ((inhibit-read-only t) | |
420 buffer-read-only | |
421 (point (point-min)) | |
422 (context (epg-make-context epa-protocol))) | |
423 (unless (get-text-property point 'epa-list-keys) | |
424 (setq point (next-single-property-change point 'epa-list-keys))) | |
425 (when point | |
426 (delete-region point | |
427 (or (next-single-property-change point 'epa-list-keys) | |
428 (point-max))) | |
429 (goto-char point)) | |
430 (epa--insert-keys (epg-list-keys context name secret)) | |
431 (widget-setup) | |
432 (set-keymap-parent (current-local-map) widget-keymap)) | |
433 (make-local-variable 'epa-list-keys-arguments) | |
434 (setq epa-list-keys-arguments (list name secret)) | |
435 (goto-char (point-min)) | |
436 (pop-to-buffer (current-buffer))) | |
437 | |
438 ;;;###autoload | |
439 (defun epa-list-keys (&optional name) | |
440 "List all keys matched with NAME from the public keyring." | |
441 (interactive | |
442 (if current-prefix-arg | |
443 (let ((name (read-string "Pattern: " | |
444 (if epa-list-keys-arguments | |
445 (car epa-list-keys-arguments))))) | |
446 (list (if (equal name "") nil name))) | |
447 (list nil))) | |
448 (epa--list-keys name nil)) | |
449 | |
450 ;;;###autoload | |
451 (defun epa-list-secret-keys (&optional name) | |
452 "List all keys matched with NAME from the private keyring." | |
453 (interactive | |
454 (if current-prefix-arg | |
455 (let ((name (read-string "Pattern: " | |
456 (if epa-list-keys-arguments | |
457 (car epa-list-keys-arguments))))) | |
458 (list (if (equal name "") nil name))) | |
459 (list nil))) | |
460 (epa--list-keys name t)) | |
461 | |
462 (defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm) | |
463 (apply #'epa--list-keys epa-list-keys-arguments)) | |
464 | |
465 (defun epa--marked-keys () | |
105994
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
466 (or (with-current-buffer epa-keys-buffer |
91647 | 467 (goto-char (point-min)) |
468 (let (keys key) | |
469 (while (re-search-forward "^\\*" nil t) | |
470 (if (setq key (get-text-property (match-beginning 0) | |
471 'epa-key)) | |
472 (setq keys (cons key keys)))) | |
473 (nreverse keys))) | |
474 (save-excursion | |
475 (beginning-of-line) | |
476 (let ((key (get-text-property (point) 'epa-key))) | |
477 (if key | |
478 (list key)))))) | |
479 | |
480 (defun epa--select-keys (prompt keys) | |
105994
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
481 (unless (and epa-keys-buffer |
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
482 (buffer-live-p epa-keys-buffer)) |
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
483 (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) |
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
484 (with-current-buffer epa-keys-buffer |
91647 | 485 (epa-key-list-mode) |
486 (let ((inhibit-read-only t) | |
487 buffer-read-only) | |
488 (erase-buffer) | |
489 (insert prompt "\n" | |
490 (substitute-command-keys "\ | |
491 - `\\[epa-mark-key]' to mark a key on the line | |
492 - `\\[epa-unmark-key]' to unmark a key on the line\n")) | |
493 (widget-create 'link | |
494 :notify (lambda (&rest ignore) (abort-recursive-edit)) | |
495 :help-echo | |
496 (substitute-command-keys | |
497 "Click here or \\[abort-recursive-edit] to cancel") | |
498 "Cancel") | |
499 (widget-create 'link | |
500 :notify (lambda (&rest ignore) (exit-recursive-edit)) | |
501 :help-echo | |
502 (substitute-command-keys | |
503 "Click here or \\[exit-recursive-edit] to finish") | |
504 "OK") | |
505 (insert "\n\n") | |
506 (epa--insert-keys keys) | |
507 (widget-setup) | |
508 (set-keymap-parent (current-local-map) widget-keymap) | |
509 (setq epa-exit-buffer-function #'abort-recursive-edit) | |
510 (goto-char (point-min)) | |
108668
5a957bb32b66
* epa.el (epa--select-keys): Don't explicitly delete the window since
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
511 (let ((display-buffer-mark-dedicated 'soft)) |
5a957bb32b66
* epa.el (epa--select-keys): Don't explicitly delete the window since
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
512 (pop-to-buffer (current-buffer)))) |
91647 | 513 (unwind-protect |
514 (progn | |
515 (recursive-edit) | |
516 (epa--marked-keys)) | |
517 (kill-buffer epa-keys-buffer)))) | |
518 | |
519 ;;;###autoload | |
520 (defun epa-select-keys (context prompt &optional names secret) | |
521 "Display a user's keyring and ask him to select keys. | |
522 CONTEXT is an epg-context. | |
523 PROMPT is a string to prompt with. | |
524 NAMES is a list of strings to be matched with keys. If it is nil, all | |
525 the keys are listed. | |
526 If SECRET is non-nil, list secret keys instead of public keys." | |
527 (let ((keys (epg-list-keys context names secret))) | |
93506 | 528 (epa--select-keys prompt keys))) |
91647 | 529 |
530 (defun epa--show-key (key) | |
531 (let* ((primary-sub-key (car (epg-key-sub-key-list key))) | |
532 (entry (assoc (epg-sub-key-id primary-sub-key) | |
533 epa-key-buffer-alist)) | |
534 (inhibit-read-only t) | |
535 buffer-read-only | |
536 pointer) | |
537 (unless entry | |
538 (setq entry (cons (epg-sub-key-id primary-sub-key) nil) | |
539 epa-key-buffer-alist (cons entry epa-key-buffer-alist))) | |
540 (unless (and (cdr entry) | |
541 (buffer-live-p (cdr entry))) | |
542 (setcdr entry (generate-new-buffer | |
543 (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) | |
544 (set-buffer (cdr entry)) | |
545 (epa-key-mode) | |
546 (make-local-variable 'epa-key) | |
547 (setq epa-key key) | |
548 (erase-buffer) | |
549 (setq pointer (epg-key-user-id-list key)) | |
550 (while pointer | |
551 (if (car pointer) | |
552 (insert " " | |
553 (if (epg-user-id-validity (car pointer)) | |
554 (char-to-string | |
555 (car (rassq (epg-user-id-validity (car pointer)) | |
556 epg-key-validity-alist))) | |
557 " ") | |
558 " " | |
559 (if (stringp (epg-user-id-string (car pointer))) | |
560 (epg-user-id-string (car pointer)) | |
561 (epg-decode-dn (epg-user-id-string (car pointer)))) | |
562 "\n")) | |
563 (setq pointer (cdr pointer))) | |
564 (setq pointer (epg-key-sub-key-list key)) | |
565 (while pointer | |
566 (insert " " | |
567 (if (epg-sub-key-validity (car pointer)) | |
568 (char-to-string | |
569 (car (rassq (epg-sub-key-validity (car pointer)) | |
570 epg-key-validity-alist))) | |
571 " ") | |
572 " " | |
573 (epg-sub-key-id (car pointer)) | |
574 " " | |
575 (format "%dbits" | |
576 (epg-sub-key-length (car pointer))) | |
577 " " | |
578 (cdr (assq (epg-sub-key-algorithm (car pointer)) | |
579 epg-pubkey-algorithm-alist)) | |
580 "\n\tCreated: " | |
581 (condition-case nil | |
582 (format-time-string "%Y-%m-%d" | |
583 (epg-sub-key-creation-time (car pointer))) | |
584 (error "????-??-??")) | |
585 (if (epg-sub-key-expiration-time (car pointer)) | |
100175
be17c10d7381
(epa--show-key): Use past tense of "expire" if the key
Daiki Ueno <ueno@unixuser.org>
parents:
97719
diff
changeset
|
586 (format (if (time-less-p (current-time) |
be17c10d7381
(epa--show-key): Use past tense of "expire" if the key
Daiki Ueno <ueno@unixuser.org>
parents:
97719
diff
changeset
|
587 (epg-sub-key-expiration-time |
be17c10d7381
(epa--show-key): Use past tense of "expire" if the key
Daiki Ueno <ueno@unixuser.org>
parents:
97719
diff
changeset
|
588 (car pointer))) |
be17c10d7381
(epa--show-key): Use past tense of "expire" if the key
Daiki Ueno <ueno@unixuser.org>
parents:
97719
diff
changeset
|
589 "\n\tExpires: %s" |
be17c10d7381
(epa--show-key): Use past tense of "expire" if the key
Daiki Ueno <ueno@unixuser.org>
parents:
97719
diff
changeset
|
590 "\n\tExpired: %s") |
91647 | 591 (condition-case nil |
592 (format-time-string "%Y-%m-%d" | |
593 (epg-sub-key-expiration-time | |
594 (car pointer))) | |
595 (error "????-??-??"))) | |
596 "") | |
597 "\n\tCapabilities: " | |
598 (mapconcat #'symbol-name | |
599 (epg-sub-key-capability (car pointer)) | |
600 " ") | |
601 "\n\tFingerprint: " | |
602 (epg-sub-key-fingerprint (car pointer)) | |
603 "\n") | |
604 (setq pointer (cdr pointer))) | |
605 (goto-char (point-min)) | |
606 (pop-to-buffer (current-buffer)))) | |
607 | |
608 (defun epa-display-info (info) | |
609 (if epa-popup-info-window | |
610 (save-selected-window | |
611 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer)) | |
612 (setq epa-info-buffer (generate-new-buffer "*Info*"))) | |
613 (if (get-buffer-window epa-info-buffer) | |
614 (delete-window (get-buffer-window epa-info-buffer))) | |
105994
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
615 (with-current-buffer epa-info-buffer |
91647 | 616 (let ((inhibit-read-only t) |
617 buffer-read-only) | |
618 (erase-buffer) | |
619 (insert info)) | |
620 (epa-info-mode) | |
621 (goto-char (point-min))) | |
622 (if (> (window-height) | |
623 epa-info-window-height) | |
624 (set-window-buffer (split-window nil (- (window-height) | |
625 epa-info-window-height)) | |
626 epa-info-buffer) | |
627 (pop-to-buffer epa-info-buffer) | |
628 (if (> (window-height) epa-info-window-height) | |
629 (shrink-window (- (window-height) epa-info-window-height))))) | |
630 (message "%s" info))) | |
631 | |
632 (defun epa-display-verify-result (verify-result) | |
633 (epa-display-info (epg-verify-result-to-string verify-result))) | |
104395
df3d3d6c4426
* net/newst-treeview.el (newsticker-groups-filename):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
103324
diff
changeset
|
634 (make-obsolete 'epa-display-verify-result 'epa-display-info "23.1") |
91647 | 635 |
636 (defun epa-passphrase-callback-function (context key-id handback) | |
637 (if (eq key-id 'SYM) | |
638 (read-passwd "Passphrase for symmetric encryption: " | |
639 (eq (epg-context-operation context) 'encrypt)) | |
640 (read-passwd | |
641 (if (eq key-id 'PIN) | |
642 "Passphrase for PIN: " | |
643 (let ((entry (assoc key-id epg-user-id-alist))) | |
644 (if entry | |
645 (format "Passphrase for %s %s: " key-id (cdr entry)) | |
646 (format "Passphrase for %s: " key-id))))))) | |
647 | |
648 (defun epa-progress-callback-function (context what char current total | |
649 handback) | |
650 (message "%s%d%% (%d/%d)" (or handback | |
651 (concat what ": ")) | |
652 (if (> total 0) (floor (* (/ current (float total)) 100)) 0) | |
653 current total)) | |
654 | |
655 ;;;###autoload | |
656 (defun epa-decrypt-file (file) | |
657 "Decrypt FILE." | |
658 (interactive "fFile: ") | |
659 (setq file (expand-file-name file)) | |
660 (let* ((default-name (file-name-sans-extension file)) | |
661 (plain (expand-file-name | |
662 (read-file-name | |
663 (concat "To file (default " | |
664 (file-name-nondirectory default-name) | |
665 ") ") | |
666 (file-name-directory default-name) | |
667 default-name))) | |
668 (context (epg-make-context epa-protocol))) | |
669 (epg-context-set-passphrase-callback context | |
670 #'epa-passphrase-callback-function) | |
671 (epg-context-set-progress-callback context | |
672 (cons | |
673 #'epa-progress-callback-function | |
674 (format "Decrypting %s..." | |
675 (file-name-nondirectory file)))) | |
676 (message "Decrypting %s..." (file-name-nondirectory file)) | |
677 (epg-decrypt-file context file plain) | |
678 (message "Decrypting %s...wrote %s" (file-name-nondirectory file) | |
679 (file-name-nondirectory plain)) | |
680 (if (epg-context-result-for context 'verify) | |
681 (epa-display-info (epg-verify-result-to-string | |
682 (epg-context-result-for context 'verify)))))) | |
683 | |
684 ;;;###autoload | |
685 (defun epa-verify-file (file) | |
686 "Verify FILE." | |
687 (interactive "fFile: ") | |
688 (setq file (expand-file-name file)) | |
689 (let* ((context (epg-make-context epa-protocol)) | |
690 (plain (if (equal (file-name-extension file) "sig") | |
691 (file-name-sans-extension file)))) | |
692 (epg-context-set-progress-callback context | |
693 (cons | |
694 #'epa-progress-callback-function | |
695 (format "Verifying %s..." | |
696 (file-name-nondirectory file)))) | |
697 (message "Verifying %s..." (file-name-nondirectory file)) | |
698 (epg-verify-file context file plain) | |
699 (message "Verifying %s...done" (file-name-nondirectory file)) | |
700 (if (epg-context-result-for context 'verify) | |
701 (epa-display-info (epg-verify-result-to-string | |
702 (epg-context-result-for context 'verify)))))) | |
703 | |
704 (defun epa--read-signature-type () | |
705 (let (type c) | |
706 (while (null type) | |
707 (message "Signature type (n,c,d,?) ") | |
708 (setq c (read-char)) | |
709 (cond ((eq c ?c) | |
710 (setq type 'clear)) | |
711 ((eq c ?d) | |
712 (setq type 'detached)) | |
713 ((eq c ??) | |
714 (with-output-to-temp-buffer "*Help*" | |
105994
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105275
diff
changeset
|
715 (with-current-buffer standard-output |
91647 | 716 (insert "\ |
717 n - Create a normal signature | |
718 c - Create a cleartext signature | |
719 d - Create a detached signature | |
720 ? - Show this help | |
721 ")))) | |
722 (t | |
103138
55823cc572a6
(epa--read-signature-type): Fix typo.
Daiki Ueno <ueno@unixuser.org>
parents:
100908
diff
changeset
|
723 (setq type 'normal)))) |
55823cc572a6
(epa--read-signature-type): Fix typo.
Daiki Ueno <ueno@unixuser.org>
parents:
100908
diff
changeset
|
724 type)) |
91647 | 725 |
726 ;;;###autoload | |
727 (defun epa-sign-file (file signers mode) | |
728 "Sign FILE by SIGNERS keys selected." | |
729 (interactive | |
730 (let ((verbose current-prefix-arg)) | |
731 (list (expand-file-name (read-file-name "File: ")) | |
732 (if verbose | |
733 (epa-select-keys (epg-make-context epa-protocol) | |
734 "Select keys for signing. | |
735 If no one is selected, default secret key is used. " | |
736 nil t)) | |
737 (if verbose | |
738 (epa--read-signature-type) | |
739 'clear)))) | |
740 (let ((signature (concat file | |
741 (if (eq epa-protocol 'OpenPGP) | |
742 (if (or epa-armor | |
743 (not (memq mode | |
744 '(nil t normal detached)))) | |
745 ".asc" | |
746 (if (memq mode '(t detached)) | |
747 ".sig" | |
748 ".gpg")) | |
749 (if (memq mode '(t detached)) | |
750 ".p7s" | |
751 ".p7m")))) | |
752 (context (epg-make-context epa-protocol))) | |
753 (epg-context-set-armor context epa-armor) | |
754 (epg-context-set-textmode context epa-textmode) | |
755 (epg-context-set-signers context signers) | |
756 (epg-context-set-passphrase-callback context | |
757 #'epa-passphrase-callback-function) | |
758 (epg-context-set-progress-callback context | |
759 (cons | |
760 #'epa-progress-callback-function | |
761 (format "Signing %s..." | |
762 (file-name-nondirectory file)))) | |
763 (message "Signing %s..." (file-name-nondirectory file)) | |
764 (epg-sign-file context file signature mode) | |
765 (message "Signing %s...wrote %s" (file-name-nondirectory file) | |
766 (file-name-nondirectory signature)))) | |
767 | |
768 ;;;###autoload | |
769 (defun epa-encrypt-file (file recipients) | |
770 "Encrypt FILE for RECIPIENTS." | |
771 (interactive | |
772 (list (expand-file-name (read-file-name "File: ")) | |
773 (epa-select-keys (epg-make-context epa-protocol) | |
774 "Select recipients for encryption. | |
775 If no one is selected, symmetric encryption will be performed. "))) | |
776 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP) | |
777 (if epa-armor ".asc" ".gpg") | |
778 ".p7m"))) | |
779 (context (epg-make-context epa-protocol))) | |
780 (epg-context-set-armor context epa-armor) | |
781 (epg-context-set-textmode context epa-textmode) | |
782 (epg-context-set-passphrase-callback context | |
783 #'epa-passphrase-callback-function) | |
784 (epg-context-set-progress-callback context | |
785 (cons | |
786 #'epa-progress-callback-function | |
787 (format "Encrypting %s..." | |
788 (file-name-nondirectory file)))) | |
789 (message "Encrypting %s..." (file-name-nondirectory file)) | |
790 (epg-encrypt-file context file recipients cipher) | |
791 (message "Encrypting %s...wrote %s" (file-name-nondirectory file) | |
792 (file-name-nondirectory cipher)))) | |
793 | |
794 ;;;###autoload | |
795 (defun epa-decrypt-region (start end) | |
796 "Decrypt the current region between START and END. | |
797 | |
93506 | 798 Don't use this command in Lisp programs! |
799 Since this function operates on regions, it does some tricks such | |
800 as coding-system detection and unibyte/multibyte conversion. If | |
801 you are sure how the data in the region should be treated, you | |
802 should consider using the string based counterpart | |
803 `epg-decrypt-string', or the file based counterpart | |
804 `epg-decrypt-file' instead. | |
805 | |
806 For example: | |
807 | |
808 \(let ((context (epg-make-context 'OpenPGP))) | |
809 (decode-coding-string | |
810 (epg-decrypt-string context (buffer-substring start end)) | |
811 'utf-8))" | |
91647 | 812 (interactive "r") |
813 (save-excursion | |
814 (let ((context (epg-make-context epa-protocol)) | |
815 plain) | |
816 (epg-context-set-passphrase-callback context | |
817 #'epa-passphrase-callback-function) | |
818 (epg-context-set-progress-callback context | |
819 (cons | |
820 #'epa-progress-callback-function | |
821 "Decrypting...")) | |
822 (message "Decrypting...") | |
823 (setq plain (epg-decrypt-string context (buffer-substring start end))) | |
824 (message "Decrypting...done") | |
825 (setq plain (epa--decode-coding-string | |
826 plain | |
827 (or coding-system-for-read | |
103324
6f4c24703dac
(epa-decrypt-region): Detect encoding if
Daiki Ueno <ueno@unixuser.org>
parents:
103138
diff
changeset
|
828 (get-text-property start 'epa-coding-system-used) |
6f4c24703dac
(epa-decrypt-region): Detect encoding if
Daiki Ueno <ueno@unixuser.org>
parents:
103138
diff
changeset
|
829 'undecided))) |
91647 | 830 (if (y-or-n-p "Replace the original text? ") |
831 (let ((inhibit-read-only t) | |
832 buffer-read-only) | |
833 (delete-region start end) | |
834 (goto-char start) | |
835 (insert plain)) | |
836 (with-output-to-temp-buffer "*Temp*" | |
837 (set-buffer standard-output) | |
838 (insert plain) | |
839 (epa-info-mode))) | |
840 (if (epg-context-result-for context 'verify) | |
841 (epa-display-info (epg-verify-result-to-string | |
842 (epg-context-result-for context 'verify))))))) | |
843 | |
844 (defun epa--find-coding-system-for-mime-charset (mime-charset) | |
845 (if (featurep 'xemacs) | |
846 (if (fboundp 'find-coding-system) | |
847 (find-coding-system mime-charset)) | |
848 (let ((pointer (coding-system-list))) | |
849 (while (and pointer | |
850 (eq (coding-system-get (car pointer) 'mime-charset) | |
851 mime-charset)) | |
852 (setq pointer (cdr pointer))) | |
853 pointer))) | |
854 | |
855 ;;;###autoload | |
856 (defun epa-decrypt-armor-in-region (start end) | |
857 "Decrypt OpenPGP armors in the current region between START and END. | |
858 | |
93506 | 859 Don't use this command in Lisp programs! |
860 See the reason described in the `epa-decrypt-region' documentation." | |
91647 | 861 (interactive "r") |
862 (save-excursion | |
863 (save-restriction | |
864 (narrow-to-region start end) | |
865 (goto-char start) | |
866 (let (armor-start armor-end) | |
867 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) | |
868 (setq armor-start (match-beginning 0) | |
869 armor-end (re-search-forward "^-----END PGP MESSAGE-----$" | |
870 nil t)) | |
871 (unless armor-end | |
872 (error "No armor tail")) | |
873 (goto-char armor-start) | |
874 (let ((coding-system-for-read | |
875 (or coding-system-for-read | |
876 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) | |
877 (epa--find-coding-system-for-mime-charset | |
878 (intern (downcase (match-string 1)))))))) | |
879 (goto-char armor-end) | |
880 (epa-decrypt-region armor-start armor-end))))))) | |
881 | |
882 ;;;###autoload | |
883 (defun epa-verify-region (start end) | |
884 "Verify the current region between START and END. | |
885 | |
93506 | 886 Don't use this command in Lisp programs! |
887 Since this function operates on regions, it does some tricks such | |
888 as coding-system detection and unibyte/multibyte conversion. If | |
889 you are sure how the data in the region should be treated, you | |
890 should consider using the string based counterpart | |
891 `epg-verify-string', or the file based counterpart | |
892 `epg-verify-file' instead. | |
893 | |
894 For example: | |
895 | |
896 \(let ((context (epg-make-context 'OpenPGP))) | |
897 (decode-coding-string | |
898 (epg-verify-string context (buffer-substring start end)) | |
899 'utf-8))" | |
91647 | 900 (interactive "r") |
901 (let ((context (epg-make-context epa-protocol)) | |
902 plain) | |
903 (epg-context-set-progress-callback context | |
904 (cons | |
905 #'epa-progress-callback-function | |
906 "Verifying...")) | |
907 (message "Verifying...") | |
908 (setq plain (epg-verify-string | |
909 context | |
910 (epa--encode-coding-string | |
911 (buffer-substring start end) | |
912 (or coding-system-for-write | |
913 (get-text-property start 'epa-coding-system-used))))) | |
914 (message "Verifying...done") | |
915 (setq plain (epa--decode-coding-string | |
916 plain | |
917 (or coding-system-for-read | |
103324
6f4c24703dac
(epa-decrypt-region): Detect encoding if
Daiki Ueno <ueno@unixuser.org>
parents:
103138
diff
changeset
|
918 (get-text-property start 'epa-coding-system-used) |
6f4c24703dac
(epa-decrypt-region): Detect encoding if
Daiki Ueno <ueno@unixuser.org>
parents:
103138
diff
changeset
|
919 'undecided))) |
91647 | 920 (if (y-or-n-p "Replace the original text? ") |
921 (let ((inhibit-read-only t) | |
922 buffer-read-only) | |
923 (delete-region start end) | |
924 (goto-char start) | |
925 (insert plain)) | |
926 (with-output-to-temp-buffer "*Temp*" | |
927 (set-buffer standard-output) | |
928 (insert plain) | |
929 (epa-info-mode))) | |
930 (if (epg-context-result-for context 'verify) | |
931 (epa-display-info (epg-verify-result-to-string | |
932 (epg-context-result-for context 'verify)))))) | |
933 | |
934 ;;;###autoload | |
935 (defun epa-verify-cleartext-in-region (start end) | |
936 "Verify OpenPGP cleartext signed messages in the current region | |
937 between START and END. | |
938 | |
93506 | 939 Don't use this command in Lisp programs! |
940 See the reason described in the `epa-verify-region' documentation." | |
91647 | 941 (interactive "r") |
942 (save-excursion | |
943 (save-restriction | |
944 (narrow-to-region start end) | |
945 (goto-char start) | |
946 (let (cleartext-start cleartext-end) | |
947 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$" | |
948 nil t) | |
949 (setq cleartext-start (match-beginning 0)) | |
950 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$" | |
951 nil t) | |
952 (error "Invalid cleartext signed message")) | |
953 (setq cleartext-end (re-search-forward | |
954 "^-----END PGP SIGNATURE-----$" | |
955 nil t)) | |
956 (unless cleartext-end | |
957 (error "No cleartext tail")) | |
958 (epa-verify-region cleartext-start cleartext-end)))))) | |
959 | |
960 (eval-and-compile | |
961 (if (fboundp 'select-safe-coding-system) | |
962 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) | |
963 (defun epa--select-safe-coding-system (from to) | |
964 buffer-file-coding-system))) | |
965 | |
966 ;;;###autoload | |
967 (defun epa-sign-region (start end signers mode) | |
968 "Sign the current region between START and END by SIGNERS keys selected. | |
969 | |
93506 | 970 Don't use this command in Lisp programs! |
971 Since this function operates on regions, it does some tricks such | |
972 as coding-system detection and unibyte/multibyte conversion. If | |
973 you are sure how the data should be treated, you should consider | |
974 using the string based counterpart `epg-sign-string', or the file | |
975 based counterpart `epg-sign-file' instead. | |
976 | |
977 For example: | |
978 | |
979 \(let ((context (epg-make-context 'OpenPGP))) | |
980 (epg-sign-string | |
981 context | |
982 (encode-coding-string (buffer-substring start end) 'utf-8)))" | |
91647 | 983 (interactive |
984 (let ((verbose current-prefix-arg)) | |
985 (setq epa-last-coding-system-specified | |
986 (or coding-system-for-write | |
987 (epa--select-safe-coding-system | |
988 (region-beginning) (region-end)))) | |
989 (list (region-beginning) (region-end) | |
990 (if verbose | |
991 (epa-select-keys (epg-make-context epa-protocol) | |
992 "Select keys for signing. | |
993 If no one is selected, default secret key is used. " | |
994 nil t)) | |
995 (if verbose | |
996 (epa--read-signature-type) | |
997 'clear)))) | |
998 (save-excursion | |
999 (let ((context (epg-make-context epa-protocol)) | |
1000 signature) | |
1001 ;;(epg-context-set-armor context epa-armor) | |
1002 (epg-context-set-armor context t) | |
1003 ;;(epg-context-set-textmode context epa-textmode) | |
1004 (epg-context-set-textmode context t) | |
1005 (epg-context-set-signers context signers) | |
1006 (epg-context-set-passphrase-callback context | |
1007 #'epa-passphrase-callback-function) | |
1008 (epg-context-set-progress-callback context | |
1009 (cons | |
1010 #'epa-progress-callback-function | |
1011 "Signing...")) | |
1012 (message "Signing...") | |
1013 (setq signature (epg-sign-string context | |
1014 (epa--encode-coding-string | |
1015 (buffer-substring start end) | |
1016 epa-last-coding-system-specified) | |
1017 mode)) | |
1018 (message "Signing...done") | |
1019 (delete-region start end) | |
1020 (goto-char start) | |
1021 (add-text-properties (point) | |
1022 (progn | |
1023 (insert (epa--decode-coding-string | |
1024 signature | |
1025 (or coding-system-for-read | |
1026 epa-last-coding-system-specified))) | |
1027 (point)) | |
1028 (list 'epa-coding-system-used | |
1029 epa-last-coding-system-specified | |
1030 'front-sticky nil | |
1031 'rear-nonsticky t | |
1032 'start-open t | |
1033 'end-open t))))) | |
1034 | |
1035 (eval-and-compile | |
1036 (if (fboundp 'derived-mode-p) | |
1037 (defalias 'epa--derived-mode-p 'derived-mode-p) | |
1038 (defun epa--derived-mode-p (&rest modes) | |
1039 "Non-nil if the current major mode is derived from one of MODES. | |
1040 Uses the `derived-mode-parent' property of the symbol to trace backwards." | |
1041 (let ((parent major-mode)) | |
1042 (while (and (not (memq parent modes)) | |
1043 (setq parent (get parent 'derived-mode-parent)))) | |
1044 parent)))) | |
1045 | |
1046 ;;;###autoload | |
1047 (defun epa-encrypt-region (start end recipients sign signers) | |
1048 "Encrypt the current region between START and END for RECIPIENTS. | |
1049 | |
93506 | 1050 Don't use this command in Lisp programs! |
1051 Since this function operates on regions, it does some tricks such | |
1052 as coding-system detection and unibyte/multibyte conversion. If | |
1053 you are sure how the data should be treated, you should consider | |
1054 using the string based counterpart `epg-encrypt-string', or the | |
1055 file based counterpart `epg-encrypt-file' instead. | |
1056 | |
1057 For example: | |
1058 | |
1059 \(let ((context (epg-make-context 'OpenPGP))) | |
1060 (epg-encrypt-string | |
1061 context | |
1062 (encode-coding-string (buffer-substring start end) 'utf-8) | |
1063 nil))" | |
91647 | 1064 (interactive |
1065 (let ((verbose current-prefix-arg) | |
1066 (context (epg-make-context epa-protocol)) | |
1067 sign) | |
1068 (setq epa-last-coding-system-specified | |
1069 (or coding-system-for-write | |
1070 (epa--select-safe-coding-system | |
1071 (region-beginning) (region-end)))) | |
1072 (list (region-beginning) (region-end) | |
1073 (epa-select-keys context | |
1074 "Select recipients for encryption. | |
1075 If no one is selected, symmetric encryption will be performed. ") | |
1076 (setq sign (if verbose (y-or-n-p "Sign? "))) | |
1077 (if sign | |
1078 (epa-select-keys context | |
1079 "Select keys for signing. "))))) | |
1080 (save-excursion | |
1081 (let ((context (epg-make-context epa-protocol)) | |
1082 cipher) | |
1083 ;;(epg-context-set-armor context epa-armor) | |
1084 (epg-context-set-armor context t) | |
1085 ;;(epg-context-set-textmode context epa-textmode) | |
1086 (epg-context-set-textmode context t) | |
1087 (if sign | |
1088 (epg-context-set-signers context signers)) | |
1089 (epg-context-set-passphrase-callback context | |
1090 #'epa-passphrase-callback-function) | |
1091 (epg-context-set-progress-callback context | |
1092 (cons | |
1093 #'epa-progress-callback-function | |
1094 "Encrypting...")) | |
1095 (message "Encrypting...") | |
1096 (setq cipher (epg-encrypt-string context | |
1097 (epa--encode-coding-string | |
1098 (buffer-substring start end) | |
1099 epa-last-coding-system-specified) | |
1100 recipients | |
1101 sign)) | |
1102 (message "Encrypting...done") | |
1103 (delete-region start end) | |
1104 (goto-char start) | |
1105 (add-text-properties (point) | |
1106 (progn | |
1107 (insert cipher) | |
1108 (point)) | |
1109 (list 'epa-coding-system-used | |
1110 epa-last-coding-system-specified | |
1111 'front-sticky nil | |
1112 'rear-nonsticky t | |
1113 'start-open t | |
1114 'end-open t))))) | |
1115 | |
1116 ;;;###autoload | |
1117 (defun epa-delete-keys (keys &optional allow-secret) | |
93506 | 1118 "Delete selected KEYS." |
91647 | 1119 (interactive |
1120 (let ((keys (epa--marked-keys))) | |
1121 (unless keys | |
1122 (error "No keys selected")) | |
1123 (list keys | |
1124 (eq (nth 1 epa-list-keys-arguments) t)))) | |
1125 (let ((context (epg-make-context epa-protocol))) | |
1126 (message "Deleting...") | |
1127 (epg-delete-keys context keys allow-secret) | |
1128 (message "Deleting...done") | |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
1129 (apply #'epa--list-keys epa-list-keys-arguments))) |
91647 | 1130 |
1131 ;;;###autoload | |
1132 (defun epa-import-keys (file) | |
93506 | 1133 "Import keys from FILE." |
91647 | 1134 (interactive "fFile: ") |
1135 (setq file (expand-file-name file)) | |
1136 (let ((context (epg-make-context epa-protocol))) | |
1137 (message "Importing %s..." (file-name-nondirectory file)) | |
1138 (condition-case nil | |
1139 (progn | |
1140 (epg-import-keys-from-file context file) | |
1141 (message "Importing %s...done" (file-name-nondirectory file))) | |
1142 (error | |
1143 (message "Importing %s...failed" (file-name-nondirectory file)))) | |
1144 (if (epg-context-result-for context 'import) | |
1145 (epa-display-info (epg-import-result-to-string | |
1146 (epg-context-result-for context 'import)))) | |
1147 (if (eq major-mode 'epa-key-list-mode) | |
94471
ecd293096a4b
Daiki Ueno <ueno at unixuser.org>
Glenn Morris <rgm@gnu.org>
parents:
94417
diff
changeset
|
1148 (apply #'epa--list-keys epa-list-keys-arguments)))) |
91647 | 1149 |
1150 ;;;###autoload | |
1151 (defun epa-import-keys-region (start end) | |
93506 | 1152 "Import keys from the region." |
91647 | 1153 (interactive "r") |
1154 (let ((context (epg-make-context epa-protocol))) | |
1155 (message "Importing...") | |
1156 (condition-case nil | |
1157 (progn | |
1158 (epg-import-keys-from-string context (buffer-substring start end)) | |
1159 (message "Importing...done")) | |
1160 (error | |
1161 (message "Importing...failed"))) | |
1162 (if (epg-context-result-for context 'import) | |
1163 (epa-display-info (epg-import-result-to-string | |
1164 (epg-context-result-for context 'import)))))) | |
1165 | |
1166 ;;;###autoload | |
1167 (defun epa-import-armor-in-region (start end) | |
1168 "Import keys in the OpenPGP armor format in the current region | |
93506 | 1169 between START and END." |
91647 | 1170 (interactive "r") |
1171 (save-excursion | |
1172 (save-restriction | |
1173 (narrow-to-region start end) | |
1174 (goto-char start) | |
1175 (let (armor-start armor-end) | |
1176 (while (re-search-forward | |
1177 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$" | |
1178 nil t) | |
1179 (setq armor-start (match-beginning 0) | |
1180 armor-end (re-search-forward | |
1181 (concat "^-----END " (match-string 1) "-----$") | |
1182 nil t)) | |
1183 (unless armor-end | |
1184 (error "No armor tail")) | |
1185 (epa-import-keys-region armor-start armor-end)))))) | |
1186 | |
1187 ;;;###autoload | |
1188 (defun epa-export-keys (keys file) | |
93506 | 1189 "Export selected KEYS to FILE." |
91647 | 1190 (interactive |
1191 (let ((keys (epa--marked-keys)) | |
1192 default-name) | |
1193 (unless keys | |
1194 (error "No keys selected")) | |
1195 (setq default-name | |
1196 (expand-file-name | |
1197 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys)))) | |
1198 (if epa-armor ".asc" ".gpg")) | |
1199 default-directory)) | |
1200 (list keys | |
1201 (expand-file-name | |
1202 (read-file-name | |
1203 (concat "To file (default " | |
1204 (file-name-nondirectory default-name) | |
1205 ") ") | |
1206 (file-name-directory default-name) | |
1207 default-name))))) | |
1208 (let ((context (epg-make-context epa-protocol))) | |
1209 (epg-context-set-armor context epa-armor) | |
1210 (message "Exporting to %s..." (file-name-nondirectory file)) | |
1211 (epg-export-keys-to-file context keys file) | |
1212 (message "Exporting to %s...done" (file-name-nondirectory file)))) | |
1213 | |
1214 ;;;###autoload | |
1215 (defun epa-insert-keys (keys) | |
93506 | 1216 "Insert selected KEYS after the point." |
91647 | 1217 (interactive |
1218 (list (epa-select-keys (epg-make-context epa-protocol) | |
1219 "Select keys to export. "))) | |
1220 (let ((context (epg-make-context epa-protocol))) | |
1221 ;;(epg-context-set-armor context epa-armor) | |
1222 (epg-context-set-armor context t) | |
1223 (insert (epg-export-keys-to-string context keys)))) | |
1224 | |
1225 ;; (defun epa-sign-keys (keys &optional local) | |
1226 ;; "Sign selected KEYS. | |
1227 ;; If a prefix-arg is specified, the signature is marked as non exportable. | |
1228 | |
1229 ;; Don't use this command in Lisp programs!" | |
1230 ;; (interactive | |
1231 ;; (let ((keys (epa--marked-keys))) | |
1232 ;; (unless keys | |
1233 ;; (error "No keys selected")) | |
1234 ;; (list keys current-prefix-arg))) | |
1235 ;; (let ((context (epg-make-context epa-protocol))) | |
1236 ;; (epg-context-set-passphrase-callback context | |
1237 ;; #'epa-passphrase-callback-function) | |
1238 ;; (epg-context-set-progress-callback context | |
1239 ;; (cons | |
1240 ;; #'epa-progress-callback-function | |
1241 ;; "Signing keys...")) | |
1242 ;; (message "Signing keys...") | |
1243 ;; (epg-sign-keys context keys local) | |
1244 ;; (message "Signing keys...done"))) | |
1245 ;; (make-obsolete 'epa-sign-keys "Do not use.") | |
1246 | |
1247 (provide 'epa) | |
1248 | |
91687 | 1249 ;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7 |
91647 | 1250 ;;; epa.el ends here |