91647
|
1 ;;; epa.el --- the EasyPG Assistant
|
|
2 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
|
|
3
|
|
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
|
|
5 ;; Keywords: PGP, GnuPG
|
|
6
|
|
7 ;; This file is part of GNU Emacs.
|
|
8
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
11 ;; the Free Software Foundation; either version 3, or (at your option)
|
|
12 ;; any later version.
|
|
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
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
22 ;; Boston, MA 02110-1301, USA.
|
|
23
|
|
24 ;;; Code:
|
|
25
|
|
26 (require 'epg)
|
|
27 (require 'font-lock)
|
|
28 (require 'widget)
|
|
29 (eval-when-compile (require 'wid-edit))
|
|
30 (require 'derived)
|
|
31
|
|
32 (defgroup epa nil
|
|
33 "The EasyPG Assistant"
|
|
34 :group 'epg)
|
|
35
|
|
36 (defcustom epa-popup-info-window t
|
|
37 "If non-nil, status information from epa commands is displayed on
|
|
38 the separate window."
|
|
39 :type 'boolean
|
|
40 :group 'epa)
|
|
41
|
|
42 (defcustom epa-info-window-height 5
|
|
43 "Number of lines used to display status information."
|
|
44 :type 'integer
|
|
45 :group 'epa)
|
|
46
|
|
47 (defgroup epa-faces nil
|
|
48 "Faces for epa-mode."
|
|
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
|
|
202 (let ((keymap (make-sparse-keymap)))
|
|
203 (define-key keymap "m" 'epa-mark-key)
|
|
204 (define-key keymap "u" 'epa-unmark-key)
|
|
205 (define-key keymap "d" 'epa-decrypt-file)
|
|
206 (define-key keymap "v" 'epa-verify-file)
|
|
207 (define-key keymap "s" 'epa-sign-file)
|
|
208 (define-key keymap "e" 'epa-encrypt-file)
|
|
209 (define-key keymap "r" 'epa-delete-keys)
|
|
210 (define-key keymap "i" 'epa-import-keys)
|
|
211 (define-key keymap "o" 'epa-export-keys)
|
|
212 (define-key keymap "g" 'revert-buffer)
|
|
213 (define-key keymap "n" 'next-line)
|
|
214 (define-key keymap "p" 'previous-line)
|
|
215 (define-key keymap " " 'scroll-up)
|
|
216 (define-key keymap [delete] 'scroll-down)
|
|
217 (define-key keymap "q" 'epa-exit-buffer)
|
|
218 keymap))
|
|
219
|
|
220 (defvar epa-key-mode-map
|
|
221 (let ((keymap (make-sparse-keymap)))
|
|
222 (define-key keymap "q" 'epa-exit-buffer)
|
|
223 keymap))
|
|
224
|
|
225 (defvar epa-info-mode-map
|
|
226 (let ((keymap (make-sparse-keymap)))
|
|
227 (define-key keymap "q" 'delete-window)
|
|
228 keymap))
|
|
229
|
|
230 (defvar epa-exit-buffer-function #'bury-buffer)
|
|
231
|
|
232 (define-widget 'epa-key 'push-button
|
|
233 "Button for representing a epg-key object."
|
|
234 :format "%[%v%]"
|
|
235 :button-face-get 'epa--key-widget-button-face-get
|
|
236 :value-create 'epa--key-widget-value-create
|
|
237 :action 'epa--key-widget-action
|
|
238 :help-echo 'epa--key-widget-help-echo)
|
|
239
|
|
240 (defun epa--key-widget-action (widget &optional event)
|
|
241 (epa--show-key (widget-get widget :value)))
|
|
242
|
|
243 (defun epa--key-widget-value-create (widget)
|
|
244 (let* ((key (widget-get widget :value))
|
|
245 (primary-sub-key (car (epg-key-sub-key-list key)))
|
|
246 (primary-user-id (car (epg-key-user-id-list key))))
|
|
247 (insert (format "%c "
|
|
248 (if (epg-sub-key-validity primary-sub-key)
|
|
249 (car (rassq (epg-sub-key-validity primary-sub-key)
|
|
250 epg-key-validity-alist))
|
|
251 ? ))
|
|
252 (epg-sub-key-id primary-sub-key)
|
|
253 " "
|
|
254 (if primary-user-id
|
|
255 (if (stringp (epg-user-id-string primary-user-id))
|
|
256 (epg-user-id-string primary-user-id)
|
|
257 (epg-decode-dn (epg-user-id-string primary-user-id)))
|
|
258 ""))))
|
|
259
|
|
260 (defun epa--key-widget-button-face-get (widget)
|
|
261 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
|
|
262 (widget-get widget :value))))))
|
|
263 (if validity
|
|
264 (cdr (assq validity epa-validity-face-alist))
|
|
265 'default)))
|
|
266
|
|
267 (defun epa--key-widget-help-echo (widget)
|
|
268 (format "Show %s"
|
|
269 (epg-sub-key-id (car (epg-key-sub-key-list
|
|
270 (widget-get widget :value))))))
|
|
271
|
|
272 (eval-and-compile
|
|
273 (if (fboundp 'encode-coding-string)
|
|
274 (defalias 'epa--encode-coding-string 'encode-coding-string)
|
|
275 (defalias 'epa--encode-coding-string 'identity)))
|
|
276
|
|
277 (eval-and-compile
|
|
278 (if (fboundp 'decode-coding-string)
|
|
279 (defalias 'epa--decode-coding-string 'decode-coding-string)
|
|
280 (defalias 'epa--decode-coding-string 'identity)))
|
|
281
|
|
282 (defun epa-key-list-mode ()
|
|
283 "Major mode for `epa-list-keys'."
|
|
284 (kill-all-local-variables)
|
|
285 (buffer-disable-undo)
|
|
286 (setq major-mode 'epa-key-list-mode
|
|
287 mode-name "Keys"
|
|
288 truncate-lines t
|
|
289 buffer-read-only t)
|
|
290 (use-local-map epa-key-list-mode-map)
|
|
291 (make-local-variable 'font-lock-defaults)
|
|
292 (setq font-lock-defaults '(epa-font-lock-keywords t))
|
|
293 ;; In XEmacs, auto-initialization of font-lock is not effective
|
|
294 ;; if buffer-file-name is not set.
|
|
295 (font-lock-set-defaults)
|
|
296 (make-local-variable 'epa-exit-buffer-function)
|
|
297 (make-local-variable 'revert-buffer-function)
|
|
298 (setq revert-buffer-function 'epa--key-list-revert-buffer)
|
|
299 (run-hooks 'epa-key-list-mode-hook))
|
|
300
|
|
301 (defun epa-key-mode ()
|
|
302 "Major mode for a key description."
|
|
303 (kill-all-local-variables)
|
|
304 (buffer-disable-undo)
|
|
305 (setq major-mode 'epa-key-mode
|
|
306 mode-name "Key"
|
|
307 truncate-lines t
|
|
308 buffer-read-only t)
|
|
309 (use-local-map epa-key-mode-map)
|
|
310 (make-local-variable 'font-lock-defaults)
|
|
311 (setq font-lock-defaults '(epa-font-lock-keywords t))
|
|
312 ;; In XEmacs, auto-initialization of font-lock is not effective
|
|
313 ;; if buffer-file-name is not set.
|
|
314 (font-lock-set-defaults)
|
|
315 (make-local-variable 'epa-exit-buffer-function)
|
|
316 (run-hooks 'epa-key-mode-hook))
|
|
317
|
|
318 (defun epa-info-mode ()
|
|
319 "Major mode for `epa-info-buffer'."
|
|
320 (kill-all-local-variables)
|
|
321 (buffer-disable-undo)
|
|
322 (setq major-mode 'epa-info-mode
|
|
323 mode-name "Info"
|
|
324 truncate-lines t
|
|
325 buffer-read-only t)
|
|
326 (use-local-map epa-info-mode-map)
|
|
327 (run-hooks 'epa-info-mode-hook))
|
|
328
|
|
329 (defun epa-mark-key (&optional arg)
|
|
330 "Mark a key on the current line.
|
|
331 If ARG is non-nil, unmark the key."
|
|
332 (interactive "P")
|
|
333 (let ((inhibit-read-only t)
|
|
334 buffer-read-only
|
|
335 properties)
|
|
336 (beginning-of-line)
|
|
337 (unless (get-text-property (point) 'epa-key)
|
|
338 (error "No key on this line"))
|
|
339 (setq properties (text-properties-at (point)))
|
|
340 (delete-char 1)
|
|
341 (insert (if arg " " "*"))
|
|
342 (set-text-properties (1- (point)) (point) properties)
|
|
343 (forward-line)))
|
|
344
|
|
345 (defun epa-unmark-key (&optional arg)
|
|
346 "Unmark a key on the current line.
|
|
347 If ARG is non-nil, mark the key."
|
|
348 (interactive "P")
|
|
349 (epa-mark-key (not arg)))
|
|
350
|
|
351 (defun epa-exit-buffer ()
|
|
352 "Exit the current buffer.
|
|
353 `epa-exit-buffer-function' is called if it is set."
|
|
354 (interactive)
|
|
355 (funcall epa-exit-buffer-function))
|
|
356
|
|
357 (defun epa--insert-keys (keys)
|
|
358 (save-excursion
|
|
359 (save-restriction
|
|
360 (narrow-to-region (point) (point))
|
|
361 (let (point)
|
|
362 (while keys
|
|
363 (setq point (point))
|
|
364 (insert " ")
|
|
365 (add-text-properties point (point)
|
|
366 (list 'epa-key (car keys)
|
|
367 'front-sticky nil
|
|
368 'rear-nonsticky t
|
|
369 'start-open t
|
|
370 'end-open t))
|
|
371 (widget-create 'epa-key :value (car keys))
|
|
372 (insert "\n")
|
|
373 (setq keys (cdr keys))))
|
|
374 (add-text-properties (point-min) (point-max)
|
|
375 (list 'epa-list-keys t
|
|
376 'front-sticky nil
|
|
377 'rear-nonsticky t
|
|
378 'start-open t
|
|
379 'end-open t)))))
|
|
380
|
|
381 (defun epa--list-keys (name secret)
|
|
382 (unless (and epa-keys-buffer
|
|
383 (buffer-live-p epa-keys-buffer))
|
|
384 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
|
|
385 (set-buffer epa-keys-buffer)
|
|
386 (epa-key-list-mode)
|
|
387 (let ((inhibit-read-only t)
|
|
388 buffer-read-only
|
|
389 (point (point-min))
|
|
390 (context (epg-make-context epa-protocol)))
|
|
391 (unless (get-text-property point 'epa-list-keys)
|
|
392 (setq point (next-single-property-change point 'epa-list-keys)))
|
|
393 (when point
|
|
394 (delete-region point
|
|
395 (or (next-single-property-change point 'epa-list-keys)
|
|
396 (point-max)))
|
|
397 (goto-char point))
|
|
398 (epa--insert-keys (epg-list-keys context name secret))
|
|
399 (widget-setup)
|
|
400 (set-keymap-parent (current-local-map) widget-keymap))
|
|
401 (make-local-variable 'epa-list-keys-arguments)
|
|
402 (setq epa-list-keys-arguments (list name secret))
|
|
403 (goto-char (point-min))
|
|
404 (pop-to-buffer (current-buffer)))
|
|
405
|
|
406 ;;;###autoload
|
|
407 (defun epa-list-keys (&optional name)
|
|
408 "List all keys matched with NAME from the public keyring."
|
|
409 (interactive
|
|
410 (if current-prefix-arg
|
|
411 (let ((name (read-string "Pattern: "
|
|
412 (if epa-list-keys-arguments
|
|
413 (car epa-list-keys-arguments)))))
|
|
414 (list (if (equal name "") nil name)))
|
|
415 (list nil)))
|
|
416 (epa--list-keys name nil))
|
|
417
|
|
418 ;;;###autoload
|
|
419 (defun epa-list-secret-keys (&optional name)
|
|
420 "List all keys matched with NAME from the private keyring."
|
|
421 (interactive
|
|
422 (if current-prefix-arg
|
|
423 (let ((name (read-string "Pattern: "
|
|
424 (if epa-list-keys-arguments
|
|
425 (car epa-list-keys-arguments)))))
|
|
426 (list (if (equal name "") nil name)))
|
|
427 (list nil)))
|
|
428 (epa--list-keys name t))
|
|
429
|
|
430 (defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm)
|
|
431 (apply #'epa--list-keys epa-list-keys-arguments))
|
|
432
|
|
433 (defun epa--marked-keys ()
|
|
434 (or (save-excursion
|
|
435 (set-buffer epa-keys-buffer)
|
|
436 (goto-char (point-min))
|
|
437 (let (keys key)
|
|
438 (while (re-search-forward "^\\*" nil t)
|
|
439 (if (setq key (get-text-property (match-beginning 0)
|
|
440 'epa-key))
|
|
441 (setq keys (cons key keys))))
|
|
442 (nreverse keys)))
|
|
443 (save-excursion
|
|
444 (beginning-of-line)
|
|
445 (let ((key (get-text-property (point) 'epa-key)))
|
|
446 (if key
|
|
447 (list key))))))
|
|
448
|
|
449 (defun epa--select-keys (prompt keys)
|
|
450 (save-excursion
|
|
451 (unless (and epa-keys-buffer
|
|
452 (buffer-live-p epa-keys-buffer))
|
|
453 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
|
|
454 (set-buffer epa-keys-buffer)
|
|
455 (epa-key-list-mode)
|
|
456 (let ((inhibit-read-only t)
|
|
457 buffer-read-only)
|
|
458 (erase-buffer)
|
|
459 (insert prompt "\n"
|
|
460 (substitute-command-keys "\
|
|
461 - `\\[epa-mark-key]' to mark a key on the line
|
|
462 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
|
|
463 (widget-create 'link
|
|
464 :notify (lambda (&rest ignore) (abort-recursive-edit))
|
|
465 :help-echo
|
|
466 (substitute-command-keys
|
|
467 "Click here or \\[abort-recursive-edit] to cancel")
|
|
468 "Cancel")
|
|
469 (widget-create 'link
|
|
470 :notify (lambda (&rest ignore) (exit-recursive-edit))
|
|
471 :help-echo
|
|
472 (substitute-command-keys
|
|
473 "Click here or \\[exit-recursive-edit] to finish")
|
|
474 "OK")
|
|
475 (insert "\n\n")
|
|
476 (epa--insert-keys keys)
|
|
477 (widget-setup)
|
|
478 (set-keymap-parent (current-local-map) widget-keymap)
|
|
479 (setq epa-exit-buffer-function #'abort-recursive-edit)
|
|
480 (goto-char (point-min))
|
|
481 (pop-to-buffer (current-buffer)))
|
|
482 (unwind-protect
|
|
483 (progn
|
|
484 (recursive-edit)
|
|
485 (epa--marked-keys))
|
|
486 (if (get-buffer-window epa-keys-buffer)
|
|
487 (delete-window (get-buffer-window epa-keys-buffer)))
|
|
488 (kill-buffer epa-keys-buffer))))
|
|
489
|
|
490 ;;;###autoload
|
|
491 (defun epa-select-keys (context prompt &optional names secret)
|
|
492 "Display a user's keyring and ask him to select keys.
|
|
493 CONTEXT is an epg-context.
|
|
494 PROMPT is a string to prompt with.
|
|
495 NAMES is a list of strings to be matched with keys. If it is nil, all
|
|
496 the keys are listed.
|
|
497 If SECRET is non-nil, list secret keys instead of public keys."
|
|
498 (let ((keys (epg-list-keys context names secret)))
|
|
499 (if (> (length keys) 1)
|
|
500 (epa--select-keys prompt keys)
|
|
501 keys)))
|
|
502
|
|
503 (defun epa--show-key (key)
|
|
504 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
|
|
505 (entry (assoc (epg-sub-key-id primary-sub-key)
|
|
506 epa-key-buffer-alist))
|
|
507 (inhibit-read-only t)
|
|
508 buffer-read-only
|
|
509 pointer)
|
|
510 (unless entry
|
|
511 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
|
|
512 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
|
|
513 (unless (and (cdr entry)
|
|
514 (buffer-live-p (cdr entry)))
|
|
515 (setcdr entry (generate-new-buffer
|
|
516 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
|
|
517 (set-buffer (cdr entry))
|
|
518 (epa-key-mode)
|
|
519 (make-local-variable 'epa-key)
|
|
520 (setq epa-key key)
|
|
521 (erase-buffer)
|
|
522 (setq pointer (epg-key-user-id-list key))
|
|
523 (while pointer
|
|
524 (if (car pointer)
|
|
525 (insert " "
|
|
526 (if (epg-user-id-validity (car pointer))
|
|
527 (char-to-string
|
|
528 (car (rassq (epg-user-id-validity (car pointer))
|
|
529 epg-key-validity-alist)))
|
|
530 " ")
|
|
531 " "
|
|
532 (if (stringp (epg-user-id-string (car pointer)))
|
|
533 (epg-user-id-string (car pointer))
|
|
534 (epg-decode-dn (epg-user-id-string (car pointer))))
|
|
535 "\n"))
|
|
536 (setq pointer (cdr pointer)))
|
|
537 (setq pointer (epg-key-sub-key-list key))
|
|
538 (while pointer
|
|
539 (insert " "
|
|
540 (if (epg-sub-key-validity (car pointer))
|
|
541 (char-to-string
|
|
542 (car (rassq (epg-sub-key-validity (car pointer))
|
|
543 epg-key-validity-alist)))
|
|
544 " ")
|
|
545 " "
|
|
546 (epg-sub-key-id (car pointer))
|
|
547 " "
|
|
548 (format "%dbits"
|
|
549 (epg-sub-key-length (car pointer)))
|
|
550 " "
|
|
551 (cdr (assq (epg-sub-key-algorithm (car pointer))
|
|
552 epg-pubkey-algorithm-alist))
|
|
553 "\n\tCreated: "
|
|
554 (condition-case nil
|
|
555 (format-time-string "%Y-%m-%d"
|
|
556 (epg-sub-key-creation-time (car pointer)))
|
|
557 (error "????-??-??"))
|
|
558 (if (epg-sub-key-expiration-time (car pointer))
|
|
559 (format "\n\tExpires: %s"
|
|
560 (condition-case nil
|
|
561 (format-time-string "%Y-%m-%d"
|
|
562 (epg-sub-key-expiration-time
|
|
563 (car pointer)))
|
|
564 (error "????-??-??")))
|
|
565 "")
|
|
566 "\n\tCapabilities: "
|
|
567 (mapconcat #'symbol-name
|
|
568 (epg-sub-key-capability (car pointer))
|
|
569 " ")
|
|
570 "\n\tFingerprint: "
|
|
571 (epg-sub-key-fingerprint (car pointer))
|
|
572 "\n")
|
|
573 (setq pointer (cdr pointer)))
|
|
574 (goto-char (point-min))
|
|
575 (pop-to-buffer (current-buffer))))
|
|
576
|
|
577 (defun epa-display-info (info)
|
|
578 (if epa-popup-info-window
|
|
579 (save-selected-window
|
|
580 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
|
|
581 (setq epa-info-buffer (generate-new-buffer "*Info*")))
|
|
582 (if (get-buffer-window epa-info-buffer)
|
|
583 (delete-window (get-buffer-window epa-info-buffer)))
|
|
584 (save-excursion
|
|
585 (set-buffer epa-info-buffer)
|
|
586 (let ((inhibit-read-only t)
|
|
587 buffer-read-only)
|
|
588 (erase-buffer)
|
|
589 (insert info))
|
|
590 (epa-info-mode)
|
|
591 (goto-char (point-min)))
|
|
592 (if (> (window-height)
|
|
593 epa-info-window-height)
|
|
594 (set-window-buffer (split-window nil (- (window-height)
|
|
595 epa-info-window-height))
|
|
596 epa-info-buffer)
|
|
597 (pop-to-buffer epa-info-buffer)
|
|
598 (if (> (window-height) epa-info-window-height)
|
|
599 (shrink-window (- (window-height) epa-info-window-height)))))
|
|
600 (message "%s" info)))
|
|
601
|
|
602 (defun epa-display-verify-result (verify-result)
|
|
603 (epa-display-info (epg-verify-result-to-string verify-result)))
|
|
604 (make-obsolete 'epa-display-verify-result 'epa-display-info)
|
|
605
|
|
606 (defun epa-passphrase-callback-function (context key-id handback)
|
|
607 (if (eq key-id 'SYM)
|
|
608 (read-passwd "Passphrase for symmetric encryption: "
|
|
609 (eq (epg-context-operation context) 'encrypt))
|
|
610 (read-passwd
|
|
611 (if (eq key-id 'PIN)
|
|
612 "Passphrase for PIN: "
|
|
613 (let ((entry (assoc key-id epg-user-id-alist)))
|
|
614 (if entry
|
|
615 (format "Passphrase for %s %s: " key-id (cdr entry))
|
|
616 (format "Passphrase for %s: " key-id)))))))
|
|
617
|
|
618 (defun epa-progress-callback-function (context what char current total
|
|
619 handback)
|
|
620 (message "%s%d%% (%d/%d)" (or handback
|
|
621 (concat what ": "))
|
|
622 (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
|
|
623 current total))
|
|
624
|
|
625 ;;;###autoload
|
|
626 (defun epa-decrypt-file (file)
|
|
627 "Decrypt FILE."
|
|
628 (interactive "fFile: ")
|
|
629 (setq file (expand-file-name file))
|
|
630 (let* ((default-name (file-name-sans-extension file))
|
|
631 (plain (expand-file-name
|
|
632 (read-file-name
|
|
633 (concat "To file (default "
|
|
634 (file-name-nondirectory default-name)
|
|
635 ") ")
|
|
636 (file-name-directory default-name)
|
|
637 default-name)))
|
|
638 (context (epg-make-context epa-protocol)))
|
|
639 (epg-context-set-passphrase-callback context
|
|
640 #'epa-passphrase-callback-function)
|
|
641 (epg-context-set-progress-callback context
|
|
642 (cons
|
|
643 #'epa-progress-callback-function
|
|
644 (format "Decrypting %s..."
|
|
645 (file-name-nondirectory file))))
|
|
646 (message "Decrypting %s..." (file-name-nondirectory file))
|
|
647 (epg-decrypt-file context file plain)
|
|
648 (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
|
|
649 (file-name-nondirectory plain))
|
|
650 (if (epg-context-result-for context 'verify)
|
|
651 (epa-display-info (epg-verify-result-to-string
|
|
652 (epg-context-result-for context 'verify))))))
|
|
653
|
|
654 ;;;###autoload
|
|
655 (defun epa-verify-file (file)
|
|
656 "Verify FILE."
|
|
657 (interactive "fFile: ")
|
|
658 (setq file (expand-file-name file))
|
|
659 (let* ((context (epg-make-context epa-protocol))
|
|
660 (plain (if (equal (file-name-extension file) "sig")
|
|
661 (file-name-sans-extension file))))
|
|
662 (epg-context-set-progress-callback context
|
|
663 (cons
|
|
664 #'epa-progress-callback-function
|
|
665 (format "Verifying %s..."
|
|
666 (file-name-nondirectory file))))
|
|
667 (message "Verifying %s..." (file-name-nondirectory file))
|
|
668 (epg-verify-file context file plain)
|
|
669 (message "Verifying %s...done" (file-name-nondirectory file))
|
|
670 (if (epg-context-result-for context 'verify)
|
|
671 (epa-display-info (epg-verify-result-to-string
|
|
672 (epg-context-result-for context 'verify))))))
|
|
673
|
|
674 (defun epa--read-signature-type ()
|
|
675 (let (type c)
|
|
676 (while (null type)
|
|
677 (message "Signature type (n,c,d,?) ")
|
|
678 (setq c (read-char))
|
|
679 (cond ((eq c ?c)
|
|
680 (setq type 'clear))
|
|
681 ((eq c ?d)
|
|
682 (setq type 'detached))
|
|
683 ((eq c ??)
|
|
684 (with-output-to-temp-buffer "*Help*"
|
|
685 (save-excursion
|
|
686 (set-buffer standard-output)
|
|
687 (insert "\
|
|
688 n - Create a normal signature
|
|
689 c - Create a cleartext signature
|
|
690 d - Create a detached signature
|
|
691 ? - Show this help
|
|
692 "))))
|
|
693 (t
|
|
694 (setq type 'normal))))))
|
|
695
|
|
696 ;;;###autoload
|
|
697 (defun epa-sign-file (file signers mode)
|
|
698 "Sign FILE by SIGNERS keys selected."
|
|
699 (interactive
|
|
700 (let ((verbose current-prefix-arg))
|
|
701 (list (expand-file-name (read-file-name "File: "))
|
|
702 (if verbose
|
|
703 (epa-select-keys (epg-make-context epa-protocol)
|
|
704 "Select keys for signing.
|
|
705 If no one is selected, default secret key is used. "
|
|
706 nil t))
|
|
707 (if verbose
|
|
708 (epa--read-signature-type)
|
|
709 'clear))))
|
|
710 (let ((signature (concat file
|
|
711 (if (eq epa-protocol 'OpenPGP)
|
|
712 (if (or epa-armor
|
|
713 (not (memq mode
|
|
714 '(nil t normal detached))))
|
|
715 ".asc"
|
|
716 (if (memq mode '(t detached))
|
|
717 ".sig"
|
|
718 ".gpg"))
|
|
719 (if (memq mode '(t detached))
|
|
720 ".p7s"
|
|
721 ".p7m"))))
|
|
722 (context (epg-make-context epa-protocol)))
|
|
723 (epg-context-set-armor context epa-armor)
|
|
724 (epg-context-set-textmode context epa-textmode)
|
|
725 (epg-context-set-signers context signers)
|
|
726 (epg-context-set-passphrase-callback context
|
|
727 #'epa-passphrase-callback-function)
|
|
728 (epg-context-set-progress-callback context
|
|
729 (cons
|
|
730 #'epa-progress-callback-function
|
|
731 (format "Signing %s..."
|
|
732 (file-name-nondirectory file))))
|
|
733 (message "Signing %s..." (file-name-nondirectory file))
|
|
734 (epg-sign-file context file signature mode)
|
|
735 (message "Signing %s...wrote %s" (file-name-nondirectory file)
|
|
736 (file-name-nondirectory signature))))
|
|
737
|
|
738 ;;;###autoload
|
|
739 (defun epa-encrypt-file (file recipients)
|
|
740 "Encrypt FILE for RECIPIENTS."
|
|
741 (interactive
|
|
742 (list (expand-file-name (read-file-name "File: "))
|
|
743 (epa-select-keys (epg-make-context epa-protocol)
|
|
744 "Select recipients for encryption.
|
|
745 If no one is selected, symmetric encryption will be performed. ")))
|
|
746 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
|
|
747 (if epa-armor ".asc" ".gpg")
|
|
748 ".p7m")))
|
|
749 (context (epg-make-context epa-protocol)))
|
|
750 (epg-context-set-armor context epa-armor)
|
|
751 (epg-context-set-textmode context epa-textmode)
|
|
752 (epg-context-set-passphrase-callback context
|
|
753 #'epa-passphrase-callback-function)
|
|
754 (epg-context-set-progress-callback context
|
|
755 (cons
|
|
756 #'epa-progress-callback-function
|
|
757 (format "Encrypting %s..."
|
|
758 (file-name-nondirectory file))))
|
|
759 (message "Encrypting %s..." (file-name-nondirectory file))
|
|
760 (epg-encrypt-file context file recipients cipher)
|
|
761 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
|
|
762 (file-name-nondirectory cipher))))
|
|
763
|
|
764 ;;;###autoload
|
|
765 (defun epa-decrypt-region (start end)
|
|
766 "Decrypt the current region between START and END.
|
|
767
|
|
768 Don't use this command in Lisp programs!"
|
|
769 (interactive "r")
|
|
770 (save-excursion
|
|
771 (let ((context (epg-make-context epa-protocol))
|
|
772 plain)
|
|
773 (epg-context-set-passphrase-callback context
|
|
774 #'epa-passphrase-callback-function)
|
|
775 (epg-context-set-progress-callback context
|
|
776 (cons
|
|
777 #'epa-progress-callback-function
|
|
778 "Decrypting..."))
|
|
779 (message "Decrypting...")
|
|
780 (setq plain (epg-decrypt-string context (buffer-substring start end)))
|
|
781 (message "Decrypting...done")
|
|
782 (setq plain (epa--decode-coding-string
|
|
783 plain
|
|
784 (or coding-system-for-read
|
|
785 (get-text-property start 'epa-coding-system-used))))
|
|
786 (if (y-or-n-p "Replace the original text? ")
|
|
787 (let ((inhibit-read-only t)
|
|
788 buffer-read-only)
|
|
789 (delete-region start end)
|
|
790 (goto-char start)
|
|
791 (insert plain))
|
|
792 (with-output-to-temp-buffer "*Temp*"
|
|
793 (set-buffer standard-output)
|
|
794 (insert plain)
|
|
795 (epa-info-mode)))
|
|
796 (if (epg-context-result-for context 'verify)
|
|
797 (epa-display-info (epg-verify-result-to-string
|
|
798 (epg-context-result-for context 'verify)))))))
|
|
799
|
|
800 (defun epa--find-coding-system-for-mime-charset (mime-charset)
|
|
801 (if (featurep 'xemacs)
|
|
802 (if (fboundp 'find-coding-system)
|
|
803 (find-coding-system mime-charset))
|
|
804 (let ((pointer (coding-system-list)))
|
|
805 (while (and pointer
|
|
806 (eq (coding-system-get (car pointer) 'mime-charset)
|
|
807 mime-charset))
|
|
808 (setq pointer (cdr pointer)))
|
|
809 pointer)))
|
|
810
|
|
811 ;;;###autoload
|
|
812 (defun epa-decrypt-armor-in-region (start end)
|
|
813 "Decrypt OpenPGP armors in the current region between START and END.
|
|
814
|
|
815 Don't use this command in Lisp programs!"
|
|
816 (interactive "r")
|
|
817 (save-excursion
|
|
818 (save-restriction
|
|
819 (narrow-to-region start end)
|
|
820 (goto-char start)
|
|
821 (let (armor-start armor-end)
|
|
822 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
|
|
823 (setq armor-start (match-beginning 0)
|
|
824 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
|
|
825 nil t))
|
|
826 (unless armor-end
|
|
827 (error "No armor tail"))
|
|
828 (goto-char armor-start)
|
|
829 (let ((coding-system-for-read
|
|
830 (or coding-system-for-read
|
|
831 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
|
|
832 (epa--find-coding-system-for-mime-charset
|
|
833 (intern (downcase (match-string 1))))))))
|
|
834 (goto-char armor-end)
|
|
835 (epa-decrypt-region armor-start armor-end)))))))
|
|
836
|
|
837 ;;;###autoload
|
|
838 (defun epa-verify-region (start end)
|
|
839 "Verify the current region between START and END.
|
|
840
|
|
841 Don't use this command in Lisp programs!"
|
|
842 (interactive "r")
|
|
843 (let ((context (epg-make-context epa-protocol))
|
|
844 plain)
|
|
845 (epg-context-set-progress-callback context
|
|
846 (cons
|
|
847 #'epa-progress-callback-function
|
|
848 "Verifying..."))
|
|
849 (message "Verifying...")
|
|
850 (setq plain (epg-verify-string
|
|
851 context
|
|
852 (epa--encode-coding-string
|
|
853 (buffer-substring start end)
|
|
854 (or coding-system-for-write
|
|
855 (get-text-property start 'epa-coding-system-used)))))
|
|
856 (message "Verifying...done")
|
|
857 (setq plain (epa--decode-coding-string
|
|
858 plain
|
|
859 (or coding-system-for-read
|
|
860 (get-text-property start 'epa-coding-system-used))))
|
|
861 (if (y-or-n-p "Replace the original text? ")
|
|
862 (let ((inhibit-read-only t)
|
|
863 buffer-read-only)
|
|
864 (delete-region start end)
|
|
865 (goto-char start)
|
|
866 (insert plain))
|
|
867 (with-output-to-temp-buffer "*Temp*"
|
|
868 (set-buffer standard-output)
|
|
869 (insert plain)
|
|
870 (epa-info-mode)))
|
|
871 (if (epg-context-result-for context 'verify)
|
|
872 (epa-display-info (epg-verify-result-to-string
|
|
873 (epg-context-result-for context 'verify))))))
|
|
874
|
|
875 ;;;###autoload
|
|
876 (defun epa-verify-cleartext-in-region (start end)
|
|
877 "Verify OpenPGP cleartext signed messages in the current region
|
|
878 between START and END.
|
|
879
|
|
880 Don't use this command in Lisp programs!"
|
|
881 (interactive "r")
|
|
882 (save-excursion
|
|
883 (save-restriction
|
|
884 (narrow-to-region start end)
|
|
885 (goto-char start)
|
|
886 (let (cleartext-start cleartext-end)
|
|
887 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
|
|
888 nil t)
|
|
889 (setq cleartext-start (match-beginning 0))
|
|
890 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
|
|
891 nil t)
|
|
892 (error "Invalid cleartext signed message"))
|
|
893 (setq cleartext-end (re-search-forward
|
|
894 "^-----END PGP SIGNATURE-----$"
|
|
895 nil t))
|
|
896 (unless cleartext-end
|
|
897 (error "No cleartext tail"))
|
|
898 (epa-verify-region cleartext-start cleartext-end))))))
|
|
899
|
|
900 (eval-and-compile
|
|
901 (if (fboundp 'select-safe-coding-system)
|
|
902 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
|
|
903 (defun epa--select-safe-coding-system (from to)
|
|
904 buffer-file-coding-system)))
|
|
905
|
|
906 ;;;###autoload
|
|
907 (defun epa-sign-region (start end signers mode)
|
|
908 "Sign the current region between START and END by SIGNERS keys selected.
|
|
909
|
|
910 Don't use this command in Lisp programs!"
|
|
911 (interactive
|
|
912 (let ((verbose current-prefix-arg))
|
|
913 (setq epa-last-coding-system-specified
|
|
914 (or coding-system-for-write
|
|
915 (epa--select-safe-coding-system
|
|
916 (region-beginning) (region-end))))
|
|
917 (list (region-beginning) (region-end)
|
|
918 (if verbose
|
|
919 (epa-select-keys (epg-make-context epa-protocol)
|
|
920 "Select keys for signing.
|
|
921 If no one is selected, default secret key is used. "
|
|
922 nil t))
|
|
923 (if verbose
|
|
924 (epa--read-signature-type)
|
|
925 'clear))))
|
|
926 (save-excursion
|
|
927 (let ((context (epg-make-context epa-protocol))
|
|
928 signature)
|
|
929 ;;(epg-context-set-armor context epa-armor)
|
|
930 (epg-context-set-armor context t)
|
|
931 ;;(epg-context-set-textmode context epa-textmode)
|
|
932 (epg-context-set-textmode context t)
|
|
933 (epg-context-set-signers context signers)
|
|
934 (epg-context-set-passphrase-callback context
|
|
935 #'epa-passphrase-callback-function)
|
|
936 (epg-context-set-progress-callback context
|
|
937 (cons
|
|
938 #'epa-progress-callback-function
|
|
939 "Signing..."))
|
|
940 (message "Signing...")
|
|
941 (setq signature (epg-sign-string context
|
|
942 (epa--encode-coding-string
|
|
943 (buffer-substring start end)
|
|
944 epa-last-coding-system-specified)
|
|
945 mode))
|
|
946 (message "Signing...done")
|
|
947 (delete-region start end)
|
|
948 (goto-char start)
|
|
949 (add-text-properties (point)
|
|
950 (progn
|
|
951 (insert (epa--decode-coding-string
|
|
952 signature
|
|
953 (or coding-system-for-read
|
|
954 epa-last-coding-system-specified)))
|
|
955 (point))
|
|
956 (list 'epa-coding-system-used
|
|
957 epa-last-coding-system-specified
|
|
958 'front-sticky nil
|
|
959 'rear-nonsticky t
|
|
960 'start-open t
|
|
961 'end-open t)))))
|
|
962
|
|
963 (eval-and-compile
|
|
964 (if (fboundp 'derived-mode-p)
|
|
965 (defalias 'epa--derived-mode-p 'derived-mode-p)
|
|
966 (defun epa--derived-mode-p (&rest modes)
|
|
967 "Non-nil if the current major mode is derived from one of MODES.
|
|
968 Uses the `derived-mode-parent' property of the symbol to trace backwards."
|
|
969 (let ((parent major-mode))
|
|
970 (while (and (not (memq parent modes))
|
|
971 (setq parent (get parent 'derived-mode-parent))))
|
|
972 parent))))
|
|
973
|
|
974 ;;;###autoload
|
|
975 (defun epa-encrypt-region (start end recipients sign signers)
|
|
976 "Encrypt the current region between START and END for RECIPIENTS.
|
|
977
|
|
978 Don't use this command in Lisp programs!"
|
|
979 (interactive
|
|
980 (let ((verbose current-prefix-arg)
|
|
981 (context (epg-make-context epa-protocol))
|
|
982 sign)
|
|
983 (setq epa-last-coding-system-specified
|
|
984 (or coding-system-for-write
|
|
985 (epa--select-safe-coding-system
|
|
986 (region-beginning) (region-end))))
|
|
987 (list (region-beginning) (region-end)
|
|
988 (epa-select-keys context
|
|
989 "Select recipients for encryption.
|
|
990 If no one is selected, symmetric encryption will be performed. ")
|
|
991 (setq sign (if verbose (y-or-n-p "Sign? ")))
|
|
992 (if sign
|
|
993 (epa-select-keys context
|
|
994 "Select keys for signing. ")))))
|
|
995 (save-excursion
|
|
996 (let ((context (epg-make-context epa-protocol))
|
|
997 cipher)
|
|
998 ;;(epg-context-set-armor context epa-armor)
|
|
999 (epg-context-set-armor context t)
|
|
1000 ;;(epg-context-set-textmode context epa-textmode)
|
|
1001 (epg-context-set-textmode context t)
|
|
1002 (if sign
|
|
1003 (epg-context-set-signers context signers))
|
|
1004 (epg-context-set-passphrase-callback context
|
|
1005 #'epa-passphrase-callback-function)
|
|
1006 (epg-context-set-progress-callback context
|
|
1007 (cons
|
|
1008 #'epa-progress-callback-function
|
|
1009 "Encrypting..."))
|
|
1010 (message "Encrypting...")
|
|
1011 (setq cipher (epg-encrypt-string context
|
|
1012 (epa--encode-coding-string
|
|
1013 (buffer-substring start end)
|
|
1014 epa-last-coding-system-specified)
|
|
1015 recipients
|
|
1016 sign))
|
|
1017 (message "Encrypting...done")
|
|
1018 (delete-region start end)
|
|
1019 (goto-char start)
|
|
1020 (add-text-properties (point)
|
|
1021 (progn
|
|
1022 (insert cipher)
|
|
1023 (point))
|
|
1024 (list 'epa-coding-system-used
|
|
1025 epa-last-coding-system-specified
|
|
1026 'front-sticky nil
|
|
1027 'rear-nonsticky t
|
|
1028 'start-open t
|
|
1029 'end-open t)))))
|
|
1030
|
|
1031 ;;;###autoload
|
|
1032 (defun epa-delete-keys (keys &optional allow-secret)
|
|
1033 "Delete selected KEYS.
|
|
1034
|
|
1035 Don't use this command in Lisp programs!"
|
|
1036 (interactive
|
|
1037 (let ((keys (epa--marked-keys)))
|
|
1038 (unless keys
|
|
1039 (error "No keys selected"))
|
|
1040 (list keys
|
|
1041 (eq (nth 1 epa-list-keys-arguments) t))))
|
|
1042 (let ((context (epg-make-context epa-protocol)))
|
|
1043 (message "Deleting...")
|
|
1044 (epg-delete-keys context keys allow-secret)
|
|
1045 (message "Deleting...done")
|
|
1046 (apply #'epa-list-keys epa-list-keys-arguments)))
|
|
1047
|
|
1048 ;;;###autoload
|
|
1049 (defun epa-import-keys (file)
|
|
1050 "Import keys from FILE.
|
|
1051
|
|
1052 Don't use this command in Lisp programs!"
|
|
1053 (interactive "fFile: ")
|
|
1054 (setq file (expand-file-name file))
|
|
1055 (let ((context (epg-make-context epa-protocol)))
|
|
1056 (message "Importing %s..." (file-name-nondirectory file))
|
|
1057 (condition-case nil
|
|
1058 (progn
|
|
1059 (epg-import-keys-from-file context file)
|
|
1060 (message "Importing %s...done" (file-name-nondirectory file)))
|
|
1061 (error
|
|
1062 (message "Importing %s...failed" (file-name-nondirectory file))))
|
|
1063 (if (epg-context-result-for context 'import)
|
|
1064 (epa-display-info (epg-import-result-to-string
|
|
1065 (epg-context-result-for context 'import))))
|
|
1066 (if (eq major-mode 'epa-key-list-mode)
|
|
1067 (apply #'epa-list-keys epa-list-keys-arguments))))
|
|
1068
|
|
1069 ;;;###autoload
|
|
1070 (defun epa-import-keys-region (start end)
|
|
1071 "Import keys from the region.
|
|
1072
|
|
1073 Don't use this command in Lisp programs!"
|
|
1074 (interactive "r")
|
|
1075 (let ((context (epg-make-context epa-protocol)))
|
|
1076 (message "Importing...")
|
|
1077 (condition-case nil
|
|
1078 (progn
|
|
1079 (epg-import-keys-from-string context (buffer-substring start end))
|
|
1080 (message "Importing...done"))
|
|
1081 (error
|
|
1082 (message "Importing...failed")))
|
|
1083 (if (epg-context-result-for context 'import)
|
|
1084 (epa-display-info (epg-import-result-to-string
|
|
1085 (epg-context-result-for context 'import))))))
|
|
1086
|
|
1087 ;;;###autoload
|
|
1088 (defun epa-import-armor-in-region (start end)
|
|
1089 "Import keys in the OpenPGP armor format in the current region
|
|
1090 between START and END.
|
|
1091
|
|
1092 Don't use this command in Lisp programs!"
|
|
1093 (interactive "r")
|
|
1094 (save-excursion
|
|
1095 (save-restriction
|
|
1096 (narrow-to-region start end)
|
|
1097 (goto-char start)
|
|
1098 (let (armor-start armor-end)
|
|
1099 (while (re-search-forward
|
|
1100 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
|
|
1101 nil t)
|
|
1102 (setq armor-start (match-beginning 0)
|
|
1103 armor-end (re-search-forward
|
|
1104 (concat "^-----END " (match-string 1) "-----$")
|
|
1105 nil t))
|
|
1106 (unless armor-end
|
|
1107 (error "No armor tail"))
|
|
1108 (epa-import-keys-region armor-start armor-end))))))
|
|
1109
|
|
1110 ;;;###autoload
|
|
1111 (defun epa-export-keys (keys file)
|
|
1112 "Export selected KEYS to FILE.
|
|
1113
|
|
1114 Don't use this command in Lisp programs!"
|
|
1115 (interactive
|
|
1116 (let ((keys (epa--marked-keys))
|
|
1117 default-name)
|
|
1118 (unless keys
|
|
1119 (error "No keys selected"))
|
|
1120 (setq default-name
|
|
1121 (expand-file-name
|
|
1122 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
|
|
1123 (if epa-armor ".asc" ".gpg"))
|
|
1124 default-directory))
|
|
1125 (list keys
|
|
1126 (expand-file-name
|
|
1127 (read-file-name
|
|
1128 (concat "To file (default "
|
|
1129 (file-name-nondirectory default-name)
|
|
1130 ") ")
|
|
1131 (file-name-directory default-name)
|
|
1132 default-name)))))
|
|
1133 (let ((context (epg-make-context epa-protocol)))
|
|
1134 (epg-context-set-armor context epa-armor)
|
|
1135 (message "Exporting to %s..." (file-name-nondirectory file))
|
|
1136 (epg-export-keys-to-file context keys file)
|
|
1137 (message "Exporting to %s...done" (file-name-nondirectory file))))
|
|
1138
|
|
1139 ;;;###autoload
|
|
1140 (defun epa-insert-keys (keys)
|
|
1141 "Insert selected KEYS after the point.
|
|
1142
|
|
1143 Don't use this command in Lisp programs!"
|
|
1144 (interactive
|
|
1145 (list (epa-select-keys (epg-make-context epa-protocol)
|
|
1146 "Select keys to export. ")))
|
|
1147 (let ((context (epg-make-context epa-protocol)))
|
|
1148 ;;(epg-context-set-armor context epa-armor)
|
|
1149 (epg-context-set-armor context t)
|
|
1150 (insert (epg-export-keys-to-string context keys))))
|
|
1151
|
|
1152 ;; (defun epa-sign-keys (keys &optional local)
|
|
1153 ;; "Sign selected KEYS.
|
|
1154 ;; If a prefix-arg is specified, the signature is marked as non exportable.
|
|
1155
|
|
1156 ;; Don't use this command in Lisp programs!"
|
|
1157 ;; (interactive
|
|
1158 ;; (let ((keys (epa--marked-keys)))
|
|
1159 ;; (unless keys
|
|
1160 ;; (error "No keys selected"))
|
|
1161 ;; (list keys current-prefix-arg)))
|
|
1162 ;; (let ((context (epg-make-context epa-protocol)))
|
|
1163 ;; (epg-context-set-passphrase-callback context
|
|
1164 ;; #'epa-passphrase-callback-function)
|
|
1165 ;; (epg-context-set-progress-callback context
|
|
1166 ;; (cons
|
|
1167 ;; #'epa-progress-callback-function
|
|
1168 ;; "Signing keys..."))
|
|
1169 ;; (message "Signing keys...")
|
|
1170 ;; (epg-sign-keys context keys local)
|
|
1171 ;; (message "Signing keys...done")))
|
|
1172 ;; (make-obsolete 'epa-sign-keys "Do not use.")
|
|
1173
|
|
1174 (provide 'epa)
|
|
1175
|
|
1176 ;;; epa.el ends here
|