|
91647
|
1 ;;; epa.el --- the EasyPG Assistant
|
|
100908
|
2 ;; Copyright (C) 2006, 2007, 2008, 2009 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
|
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
|
11 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
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
|
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
|
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
|
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
|
202 (let ((keymap (make-sparse-keymap))
|
|
|
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
|
219 (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
|
|
94490
|
220 (define-key menu-map [epa-key-list-unmark-key]
|
|
|
221 '(menu-item "Unmark Key" epa-unmark-key
|
|
|
222 :help "Unmark a key"))
|
|
|
223 (define-key menu-map [epa-key-list-mark-key]
|
|
|
224 '(menu-item "Mark Key" epa-mark-key
|
|
|
225 :help "Mark a key"))
|
|
|
226 (define-key menu-map [separator-epa-file] '(menu-item "--"))
|
|
|
227 (define-key menu-map [epa-verify-file]
|
|
|
228 '(menu-item "Verify File..." epa-verify-file
|
|
|
229 :help "Verify FILE"))
|
|
|
230 (define-key menu-map [epa-sign-file]
|
|
|
231 '(menu-item "Sign File..." epa-sign-file
|
|
|
232 :help "Sign FILE by SIGNERS keys selected"))
|
|
|
233 (define-key menu-map [epa-decrypt-file]
|
|
|
234 '(menu-item "Decrypt File..." epa-decrypt-file
|
|
|
235 :help "Decrypt FILE"))
|
|
|
236 (define-key menu-map [epa-encrypt-file]
|
|
|
237 '(menu-item "Encrypt File.." epa-encrypt-file
|
|
|
238 :help "Encrypt FILE for RECIPIENTS"))
|
|
|
239 (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
|
|
94471
|
240 (define-key menu-map [epa-key-list-delete-keys]
|
|
|
241 '(menu-item "Delete keys" epa-delete-keys
|
|
94490
|
242 :help "Delete Marked Keys"))
|
|
94471
|
243 (define-key menu-map [epa-key-list-import-keys]
|
|
94490
|
244 '(menu-item "Import Keys" epa-import-keys
|
|
94471
|
245 :help "Import keys from a file"))
|
|
|
246 (define-key menu-map [epa-key-list-export-keys]
|
|
94490
|
247 '(menu-item "Export Keys" epa-export-keys
|
|
94471
|
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
|
272 (save-selected-window
|
|
|
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
|
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
|
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
|
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
|
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 ()
|
|
|
466 (or (save-excursion
|
|
|
467 (set-buffer epa-keys-buffer)
|
|
|
468 (goto-char (point-min))
|
|
|
469 (let (keys key)
|
|
|
470 (while (re-search-forward "^\\*" nil t)
|
|
|
471 (if (setq key (get-text-property (match-beginning 0)
|
|
|
472 'epa-key))
|
|
|
473 (setq keys (cons key keys))))
|
|
|
474 (nreverse keys)))
|
|
|
475 (save-excursion
|
|
|
476 (beginning-of-line)
|
|
|
477 (let ((key (get-text-property (point) 'epa-key)))
|
|
|
478 (if key
|
|
|
479 (list key))))))
|
|
|
480
|
|
|
481 (defun epa--select-keys (prompt keys)
|
|
|
482 (save-excursion
|
|
|
483 (unless (and epa-keys-buffer
|
|
|
484 (buffer-live-p epa-keys-buffer))
|
|
|
485 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
|
|
|
486 (set-buffer epa-keys-buffer)
|
|
|
487 (epa-key-list-mode)
|
|
|
488 (let ((inhibit-read-only t)
|
|
|
489 buffer-read-only)
|
|
|
490 (erase-buffer)
|
|
|
491 (insert prompt "\n"
|
|
|
492 (substitute-command-keys "\
|
|
|
493 - `\\[epa-mark-key]' to mark a key on the line
|
|
|
494 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
|
|
|
495 (widget-create 'link
|
|
|
496 :notify (lambda (&rest ignore) (abort-recursive-edit))
|
|
|
497 :help-echo
|
|
|
498 (substitute-command-keys
|
|
|
499 "Click here or \\[abort-recursive-edit] to cancel")
|
|
|
500 "Cancel")
|
|
|
501 (widget-create 'link
|
|
|
502 :notify (lambda (&rest ignore) (exit-recursive-edit))
|
|
|
503 :help-echo
|
|
|
504 (substitute-command-keys
|
|
|
505 "Click here or \\[exit-recursive-edit] to finish")
|
|
|
506 "OK")
|
|
|
507 (insert "\n\n")
|
|
|
508 (epa--insert-keys keys)
|
|
|
509 (widget-setup)
|
|
|
510 (set-keymap-parent (current-local-map) widget-keymap)
|
|
|
511 (setq epa-exit-buffer-function #'abort-recursive-edit)
|
|
|
512 (goto-char (point-min))
|
|
|
513 (pop-to-buffer (current-buffer)))
|
|
|
514 (unwind-protect
|
|
|
515 (progn
|
|
|
516 (recursive-edit)
|
|
|
517 (epa--marked-keys))
|
|
|
518 (if (get-buffer-window epa-keys-buffer)
|
|
|
519 (delete-window (get-buffer-window epa-keys-buffer)))
|
|
|
520 (kill-buffer epa-keys-buffer))))
|
|
|
521
|
|
|
522 ;;;###autoload
|
|
|
523 (defun epa-select-keys (context prompt &optional names secret)
|
|
|
524 "Display a user's keyring and ask him to select keys.
|
|
|
525 CONTEXT is an epg-context.
|
|
|
526 PROMPT is a string to prompt with.
|
|
|
527 NAMES is a list of strings to be matched with keys. If it is nil, all
|
|
|
528 the keys are listed.
|
|
|
529 If SECRET is non-nil, list secret keys instead of public keys."
|
|
|
530 (let ((keys (epg-list-keys context names secret)))
|
|
93506
|
531 (epa--select-keys prompt keys)))
|
|
91647
|
532
|
|
|
533 (defun epa--show-key (key)
|
|
|
534 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
|
|
|
535 (entry (assoc (epg-sub-key-id primary-sub-key)
|
|
|
536 epa-key-buffer-alist))
|
|
|
537 (inhibit-read-only t)
|
|
|
538 buffer-read-only
|
|
|
539 pointer)
|
|
|
540 (unless entry
|
|
|
541 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
|
|
|
542 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
|
|
|
543 (unless (and (cdr entry)
|
|
|
544 (buffer-live-p (cdr entry)))
|
|
|
545 (setcdr entry (generate-new-buffer
|
|
|
546 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
|
|
|
547 (set-buffer (cdr entry))
|
|
|
548 (epa-key-mode)
|
|
|
549 (make-local-variable 'epa-key)
|
|
|
550 (setq epa-key key)
|
|
|
551 (erase-buffer)
|
|
|
552 (setq pointer (epg-key-user-id-list key))
|
|
|
553 (while pointer
|
|
|
554 (if (car pointer)
|
|
|
555 (insert " "
|
|
|
556 (if (epg-user-id-validity (car pointer))
|
|
|
557 (char-to-string
|
|
|
558 (car (rassq (epg-user-id-validity (car pointer))
|
|
|
559 epg-key-validity-alist)))
|
|
|
560 " ")
|
|
|
561 " "
|
|
|
562 (if (stringp (epg-user-id-string (car pointer)))
|
|
|
563 (epg-user-id-string (car pointer))
|
|
|
564 (epg-decode-dn (epg-user-id-string (car pointer))))
|
|
|
565 "\n"))
|
|
|
566 (setq pointer (cdr pointer)))
|
|
|
567 (setq pointer (epg-key-sub-key-list key))
|
|
|
568 (while pointer
|
|
|
569 (insert " "
|
|
|
570 (if (epg-sub-key-validity (car pointer))
|
|
|
571 (char-to-string
|
|
|
572 (car (rassq (epg-sub-key-validity (car pointer))
|
|
|
573 epg-key-validity-alist)))
|
|
|
574 " ")
|
|
|
575 " "
|
|
|
576 (epg-sub-key-id (car pointer))
|
|
|
577 " "
|
|
|
578 (format "%dbits"
|
|
|
579 (epg-sub-key-length (car pointer)))
|
|
|
580 " "
|
|
|
581 (cdr (assq (epg-sub-key-algorithm (car pointer))
|
|
|
582 epg-pubkey-algorithm-alist))
|
|
|
583 "\n\tCreated: "
|
|
|
584 (condition-case nil
|
|
|
585 (format-time-string "%Y-%m-%d"
|
|
|
586 (epg-sub-key-creation-time (car pointer)))
|
|
|
587 (error "????-??-??"))
|
|
|
588 (if (epg-sub-key-expiration-time (car pointer))
|
|
100175
|
589 (format (if (time-less-p (current-time)
|
|
|
590 (epg-sub-key-expiration-time
|
|
|
591 (car pointer)))
|
|
|
592 "\n\tExpires: %s"
|
|
|
593 "\n\tExpired: %s")
|
|
91647
|
594 (condition-case nil
|
|
|
595 (format-time-string "%Y-%m-%d"
|
|
|
596 (epg-sub-key-expiration-time
|
|
|
597 (car pointer)))
|
|
|
598 (error "????-??-??")))
|
|
|
599 "")
|
|
|
600 "\n\tCapabilities: "
|
|
|
601 (mapconcat #'symbol-name
|
|
|
602 (epg-sub-key-capability (car pointer))
|
|
|
603 " ")
|
|
|
604 "\n\tFingerprint: "
|
|
|
605 (epg-sub-key-fingerprint (car pointer))
|
|
|
606 "\n")
|
|
|
607 (setq pointer (cdr pointer)))
|
|
|
608 (goto-char (point-min))
|
|
|
609 (pop-to-buffer (current-buffer))))
|
|
|
610
|
|
|
611 (defun epa-display-info (info)
|
|
|
612 (if epa-popup-info-window
|
|
|
613 (save-selected-window
|
|
|
614 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
|
|
|
615 (setq epa-info-buffer (generate-new-buffer "*Info*")))
|
|
|
616 (if (get-buffer-window epa-info-buffer)
|
|
|
617 (delete-window (get-buffer-window epa-info-buffer)))
|
|
|
618 (save-excursion
|
|
|
619 (set-buffer epa-info-buffer)
|
|
|
620 (let ((inhibit-read-only t)
|
|
|
621 buffer-read-only)
|
|
|
622 (erase-buffer)
|
|
|
623 (insert info))
|
|
|
624 (epa-info-mode)
|
|
|
625 (goto-char (point-min)))
|
|
|
626 (if (> (window-height)
|
|
|
627 epa-info-window-height)
|
|
|
628 (set-window-buffer (split-window nil (- (window-height)
|
|
|
629 epa-info-window-height))
|
|
|
630 epa-info-buffer)
|
|
|
631 (pop-to-buffer epa-info-buffer)
|
|
|
632 (if (> (window-height) epa-info-window-height)
|
|
|
633 (shrink-window (- (window-height) epa-info-window-height)))))
|
|
|
634 (message "%s" info)))
|
|
|
635
|
|
|
636 (defun epa-display-verify-result (verify-result)
|
|
|
637 (epa-display-info (epg-verify-result-to-string verify-result)))
|
|
|
638 (make-obsolete 'epa-display-verify-result 'epa-display-info)
|
|
|
639
|
|
|
640 (defun epa-passphrase-callback-function (context key-id handback)
|
|
|
641 (if (eq key-id 'SYM)
|
|
|
642 (read-passwd "Passphrase for symmetric encryption: "
|
|
|
643 (eq (epg-context-operation context) 'encrypt))
|
|
|
644 (read-passwd
|
|
|
645 (if (eq key-id 'PIN)
|
|
|
646 "Passphrase for PIN: "
|
|
|
647 (let ((entry (assoc key-id epg-user-id-alist)))
|
|
|
648 (if entry
|
|
|
649 (format "Passphrase for %s %s: " key-id (cdr entry))
|
|
|
650 (format "Passphrase for %s: " key-id)))))))
|
|
|
651
|
|
|
652 (defun epa-progress-callback-function (context what char current total
|
|
|
653 handback)
|
|
|
654 (message "%s%d%% (%d/%d)" (or handback
|
|
|
655 (concat what ": "))
|
|
|
656 (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
|
|
|
657 current total))
|
|
|
658
|
|
|
659 ;;;###autoload
|
|
|
660 (defun epa-decrypt-file (file)
|
|
|
661 "Decrypt FILE."
|
|
|
662 (interactive "fFile: ")
|
|
|
663 (setq file (expand-file-name file))
|
|
|
664 (let* ((default-name (file-name-sans-extension file))
|
|
|
665 (plain (expand-file-name
|
|
|
666 (read-file-name
|
|
|
667 (concat "To file (default "
|
|
|
668 (file-name-nondirectory default-name)
|
|
|
669 ") ")
|
|
|
670 (file-name-directory default-name)
|
|
|
671 default-name)))
|
|
|
672 (context (epg-make-context epa-protocol)))
|
|
|
673 (epg-context-set-passphrase-callback context
|
|
|
674 #'epa-passphrase-callback-function)
|
|
|
675 (epg-context-set-progress-callback context
|
|
|
676 (cons
|
|
|
677 #'epa-progress-callback-function
|
|
|
678 (format "Decrypting %s..."
|
|
|
679 (file-name-nondirectory file))))
|
|
|
680 (message "Decrypting %s..." (file-name-nondirectory file))
|
|
|
681 (epg-decrypt-file context file plain)
|
|
|
682 (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
|
|
|
683 (file-name-nondirectory plain))
|
|
|
684 (if (epg-context-result-for context 'verify)
|
|
|
685 (epa-display-info (epg-verify-result-to-string
|
|
|
686 (epg-context-result-for context 'verify))))))
|
|
|
687
|
|
|
688 ;;;###autoload
|
|
|
689 (defun epa-verify-file (file)
|
|
|
690 "Verify FILE."
|
|
|
691 (interactive "fFile: ")
|
|
|
692 (setq file (expand-file-name file))
|
|
|
693 (let* ((context (epg-make-context epa-protocol))
|
|
|
694 (plain (if (equal (file-name-extension file) "sig")
|
|
|
695 (file-name-sans-extension file))))
|
|
|
696 (epg-context-set-progress-callback context
|
|
|
697 (cons
|
|
|
698 #'epa-progress-callback-function
|
|
|
699 (format "Verifying %s..."
|
|
|
700 (file-name-nondirectory file))))
|
|
|
701 (message "Verifying %s..." (file-name-nondirectory file))
|
|
|
702 (epg-verify-file context file plain)
|
|
|
703 (message "Verifying %s...done" (file-name-nondirectory file))
|
|
|
704 (if (epg-context-result-for context 'verify)
|
|
|
705 (epa-display-info (epg-verify-result-to-string
|
|
|
706 (epg-context-result-for context 'verify))))))
|
|
|
707
|
|
|
708 (defun epa--read-signature-type ()
|
|
|
709 (let (type c)
|
|
|
710 (while (null type)
|
|
|
711 (message "Signature type (n,c,d,?) ")
|
|
|
712 (setq c (read-char))
|
|
|
713 (cond ((eq c ?c)
|
|
|
714 (setq type 'clear))
|
|
|
715 ((eq c ?d)
|
|
|
716 (setq type 'detached))
|
|
|
717 ((eq c ??)
|
|
|
718 (with-output-to-temp-buffer "*Help*"
|
|
|
719 (save-excursion
|
|
|
720 (set-buffer standard-output)
|
|
|
721 (insert "\
|
|
|
722 n - Create a normal signature
|
|
|
723 c - Create a cleartext signature
|
|
|
724 d - Create a detached signature
|
|
|
725 ? - Show this help
|
|
|
726 "))))
|
|
|
727 (t
|
|
|
728 (setq type 'normal))))))
|
|
|
729
|
|
|
730 ;;;###autoload
|
|
|
731 (defun epa-sign-file (file signers mode)
|
|
|
732 "Sign FILE by SIGNERS keys selected."
|
|
|
733 (interactive
|
|
|
734 (let ((verbose current-prefix-arg))
|
|
|
735 (list (expand-file-name (read-file-name "File: "))
|
|
|
736 (if verbose
|
|
|
737 (epa-select-keys (epg-make-context epa-protocol)
|
|
|
738 "Select keys for signing.
|
|
|
739 If no one is selected, default secret key is used. "
|
|
|
740 nil t))
|
|
|
741 (if verbose
|
|
|
742 (epa--read-signature-type)
|
|
|
743 'clear))))
|
|
|
744 (let ((signature (concat file
|
|
|
745 (if (eq epa-protocol 'OpenPGP)
|
|
|
746 (if (or epa-armor
|
|
|
747 (not (memq mode
|
|
|
748 '(nil t normal detached))))
|
|
|
749 ".asc"
|
|
|
750 (if (memq mode '(t detached))
|
|
|
751 ".sig"
|
|
|
752 ".gpg"))
|
|
|
753 (if (memq mode '(t detached))
|
|
|
754 ".p7s"
|
|
|
755 ".p7m"))))
|
|
|
756 (context (epg-make-context epa-protocol)))
|
|
|
757 (epg-context-set-armor context epa-armor)
|
|
|
758 (epg-context-set-textmode context epa-textmode)
|
|
|
759 (epg-context-set-signers context signers)
|
|
|
760 (epg-context-set-passphrase-callback context
|
|
|
761 #'epa-passphrase-callback-function)
|
|
|
762 (epg-context-set-progress-callback context
|
|
|
763 (cons
|
|
|
764 #'epa-progress-callback-function
|
|
|
765 (format "Signing %s..."
|
|
|
766 (file-name-nondirectory file))))
|
|
|
767 (message "Signing %s..." (file-name-nondirectory file))
|
|
|
768 (epg-sign-file context file signature mode)
|
|
|
769 (message "Signing %s...wrote %s" (file-name-nondirectory file)
|
|
|
770 (file-name-nondirectory signature))))
|
|
|
771
|
|
|
772 ;;;###autoload
|
|
|
773 (defun epa-encrypt-file (file recipients)
|
|
|
774 "Encrypt FILE for RECIPIENTS."
|
|
|
775 (interactive
|
|
|
776 (list (expand-file-name (read-file-name "File: "))
|
|
|
777 (epa-select-keys (epg-make-context epa-protocol)
|
|
|
778 "Select recipients for encryption.
|
|
|
779 If no one is selected, symmetric encryption will be performed. ")))
|
|
|
780 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
|
|
|
781 (if epa-armor ".asc" ".gpg")
|
|
|
782 ".p7m")))
|
|
|
783 (context (epg-make-context epa-protocol)))
|
|
|
784 (epg-context-set-armor context epa-armor)
|
|
|
785 (epg-context-set-textmode context epa-textmode)
|
|
|
786 (epg-context-set-passphrase-callback context
|
|
|
787 #'epa-passphrase-callback-function)
|
|
|
788 (epg-context-set-progress-callback context
|
|
|
789 (cons
|
|
|
790 #'epa-progress-callback-function
|
|
|
791 (format "Encrypting %s..."
|
|
|
792 (file-name-nondirectory file))))
|
|
|
793 (message "Encrypting %s..." (file-name-nondirectory file))
|
|
|
794 (epg-encrypt-file context file recipients cipher)
|
|
|
795 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
|
|
|
796 (file-name-nondirectory cipher))))
|
|
|
797
|
|
|
798 ;;;###autoload
|
|
|
799 (defun epa-decrypt-region (start end)
|
|
|
800 "Decrypt the current region between START and END.
|
|
|
801
|
|
93506
|
802 Don't use this command in Lisp programs!
|
|
|
803 Since this function operates on regions, it does some tricks such
|
|
|
804 as coding-system detection and unibyte/multibyte conversion. If
|
|
|
805 you are sure how the data in the region should be treated, you
|
|
|
806 should consider using the string based counterpart
|
|
|
807 `epg-decrypt-string', or the file based counterpart
|
|
|
808 `epg-decrypt-file' instead.
|
|
|
809
|
|
|
810 For example:
|
|
|
811
|
|
|
812 \(let ((context (epg-make-context 'OpenPGP)))
|
|
|
813 (decode-coding-string
|
|
|
814 (epg-decrypt-string context (buffer-substring start end))
|
|
|
815 'utf-8))"
|
|
91647
|
816 (interactive "r")
|
|
|
817 (save-excursion
|
|
|
818 (let ((context (epg-make-context epa-protocol))
|
|
|
819 plain)
|
|
|
820 (epg-context-set-passphrase-callback context
|
|
|
821 #'epa-passphrase-callback-function)
|
|
|
822 (epg-context-set-progress-callback context
|
|
|
823 (cons
|
|
|
824 #'epa-progress-callback-function
|
|
|
825 "Decrypting..."))
|
|
|
826 (message "Decrypting...")
|
|
|
827 (setq plain (epg-decrypt-string context (buffer-substring start end)))
|
|
|
828 (message "Decrypting...done")
|
|
|
829 (setq plain (epa--decode-coding-string
|
|
|
830 plain
|
|
|
831 (or coding-system-for-read
|
|
|
832 (get-text-property start 'epa-coding-system-used))))
|
|
|
833 (if (y-or-n-p "Replace the original text? ")
|
|
|
834 (let ((inhibit-read-only t)
|
|
|
835 buffer-read-only)
|
|
|
836 (delete-region start end)
|
|
|
837 (goto-char start)
|
|
|
838 (insert plain))
|
|
|
839 (with-output-to-temp-buffer "*Temp*"
|
|
|
840 (set-buffer standard-output)
|
|
|
841 (insert plain)
|
|
|
842 (epa-info-mode)))
|
|
|
843 (if (epg-context-result-for context 'verify)
|
|
|
844 (epa-display-info (epg-verify-result-to-string
|
|
|
845 (epg-context-result-for context 'verify)))))))
|
|
|
846
|
|
|
847 (defun epa--find-coding-system-for-mime-charset (mime-charset)
|
|
|
848 (if (featurep 'xemacs)
|
|
|
849 (if (fboundp 'find-coding-system)
|
|
|
850 (find-coding-system mime-charset))
|
|
|
851 (let ((pointer (coding-system-list)))
|
|
|
852 (while (and pointer
|
|
|
853 (eq (coding-system-get (car pointer) 'mime-charset)
|
|
|
854 mime-charset))
|
|
|
855 (setq pointer (cdr pointer)))
|
|
|
856 pointer)))
|
|
|
857
|
|
|
858 ;;;###autoload
|
|
|
859 (defun epa-decrypt-armor-in-region (start end)
|
|
|
860 "Decrypt OpenPGP armors in the current region between START and END.
|
|
|
861
|
|
93506
|
862 Don't use this command in Lisp programs!
|
|
|
863 See the reason described in the `epa-decrypt-region' documentation."
|
|
91647
|
864 (interactive "r")
|
|
|
865 (save-excursion
|
|
|
866 (save-restriction
|
|
|
867 (narrow-to-region start end)
|
|
|
868 (goto-char start)
|
|
|
869 (let (armor-start armor-end)
|
|
|
870 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
|
|
|
871 (setq armor-start (match-beginning 0)
|
|
|
872 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
|
|
|
873 nil t))
|
|
|
874 (unless armor-end
|
|
|
875 (error "No armor tail"))
|
|
|
876 (goto-char armor-start)
|
|
|
877 (let ((coding-system-for-read
|
|
|
878 (or coding-system-for-read
|
|
|
879 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
|
|
|
880 (epa--find-coding-system-for-mime-charset
|
|
|
881 (intern (downcase (match-string 1))))))))
|
|
|
882 (goto-char armor-end)
|
|
|
883 (epa-decrypt-region armor-start armor-end)))))))
|
|
|
884
|
|
|
885 ;;;###autoload
|
|
|
886 (defun epa-verify-region (start end)
|
|
|
887 "Verify the current region between START and END.
|
|
|
888
|
|
93506
|
889 Don't use this command in Lisp programs!
|
|
|
890 Since this function operates on regions, it does some tricks such
|
|
|
891 as coding-system detection and unibyte/multibyte conversion. If
|
|
|
892 you are sure how the data in the region should be treated, you
|
|
|
893 should consider using the string based counterpart
|
|
|
894 `epg-verify-string', or the file based counterpart
|
|
|
895 `epg-verify-file' instead.
|
|
|
896
|
|
|
897 For example:
|
|
|
898
|
|
|
899 \(let ((context (epg-make-context 'OpenPGP)))
|
|
|
900 (decode-coding-string
|
|
|
901 (epg-verify-string context (buffer-substring start end))
|
|
|
902 'utf-8))"
|
|
91647
|
903 (interactive "r")
|
|
|
904 (let ((context (epg-make-context epa-protocol))
|
|
|
905 plain)
|
|
|
906 (epg-context-set-progress-callback context
|
|
|
907 (cons
|
|
|
908 #'epa-progress-callback-function
|
|
|
909 "Verifying..."))
|
|
|
910 (message "Verifying...")
|
|
|
911 (setq plain (epg-verify-string
|
|
|
912 context
|
|
|
913 (epa--encode-coding-string
|
|
|
914 (buffer-substring start end)
|
|
|
915 (or coding-system-for-write
|
|
|
916 (get-text-property start 'epa-coding-system-used)))))
|
|
|
917 (message "Verifying...done")
|
|
|
918 (setq plain (epa--decode-coding-string
|
|
|
919 plain
|
|
|
920 (or coding-system-for-read
|
|
|
921 (get-text-property start 'epa-coding-system-used))))
|
|
|
922 (if (y-or-n-p "Replace the original text? ")
|
|
|
923 (let ((inhibit-read-only t)
|
|
|
924 buffer-read-only)
|
|
|
925 (delete-region start end)
|
|
|
926 (goto-char start)
|
|
|
927 (insert plain))
|
|
|
928 (with-output-to-temp-buffer "*Temp*"
|
|
|
929 (set-buffer standard-output)
|
|
|
930 (insert plain)
|
|
|
931 (epa-info-mode)))
|
|
|
932 (if (epg-context-result-for context 'verify)
|
|
|
933 (epa-display-info (epg-verify-result-to-string
|
|
|
934 (epg-context-result-for context 'verify))))))
|
|
|
935
|
|
|
936 ;;;###autoload
|
|
|
937 (defun epa-verify-cleartext-in-region (start end)
|
|
|
938 "Verify OpenPGP cleartext signed messages in the current region
|
|
|
939 between START and END.
|
|
|
940
|
|
93506
|
941 Don't use this command in Lisp programs!
|
|
|
942 See the reason described in the `epa-verify-region' documentation."
|
|
91647
|
943 (interactive "r")
|
|
|
944 (save-excursion
|
|
|
945 (save-restriction
|
|
|
946 (narrow-to-region start end)
|
|
|
947 (goto-char start)
|
|
|
948 (let (cleartext-start cleartext-end)
|
|
|
949 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
|
|
|
950 nil t)
|
|
|
951 (setq cleartext-start (match-beginning 0))
|
|
|
952 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
|
|
|
953 nil t)
|
|
|
954 (error "Invalid cleartext signed message"))
|
|
|
955 (setq cleartext-end (re-search-forward
|
|
|
956 "^-----END PGP SIGNATURE-----$"
|
|
|
957 nil t))
|
|
|
958 (unless cleartext-end
|
|
|
959 (error "No cleartext tail"))
|
|
|
960 (epa-verify-region cleartext-start cleartext-end))))))
|
|
|
961
|
|
|
962 (eval-and-compile
|
|
|
963 (if (fboundp 'select-safe-coding-system)
|
|
|
964 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
|
|
|
965 (defun epa--select-safe-coding-system (from to)
|
|
|
966 buffer-file-coding-system)))
|
|
|
967
|
|
|
968 ;;;###autoload
|
|
|
969 (defun epa-sign-region (start end signers mode)
|
|
|
970 "Sign the current region between START and END by SIGNERS keys selected.
|
|
|
971
|
|
93506
|
972 Don't use this command in Lisp programs!
|
|
|
973 Since this function operates on regions, it does some tricks such
|
|
|
974 as coding-system detection and unibyte/multibyte conversion. If
|
|
|
975 you are sure how the data should be treated, you should consider
|
|
|
976 using the string based counterpart `epg-sign-string', or the file
|
|
|
977 based counterpart `epg-sign-file' instead.
|
|
|
978
|
|
|
979 For example:
|
|
|
980
|
|
|
981 \(let ((context (epg-make-context 'OpenPGP)))
|
|
|
982 (epg-sign-string
|
|
|
983 context
|
|
|
984 (encode-coding-string (buffer-substring start end) 'utf-8)))"
|
|
91647
|
985 (interactive
|
|
|
986 (let ((verbose current-prefix-arg))
|
|
|
987 (setq epa-last-coding-system-specified
|
|
|
988 (or coding-system-for-write
|
|
|
989 (epa--select-safe-coding-system
|
|
|
990 (region-beginning) (region-end))))
|
|
|
991 (list (region-beginning) (region-end)
|
|
|
992 (if verbose
|
|
|
993 (epa-select-keys (epg-make-context epa-protocol)
|
|
|
994 "Select keys for signing.
|
|
|
995 If no one is selected, default secret key is used. "
|
|
|
996 nil t))
|
|
|
997 (if verbose
|
|
|
998 (epa--read-signature-type)
|
|
|
999 'clear))))
|
|
|
1000 (save-excursion
|
|
|
1001 (let ((context (epg-make-context epa-protocol))
|
|
|
1002 signature)
|
|
|
1003 ;;(epg-context-set-armor context epa-armor)
|
|
|
1004 (epg-context-set-armor context t)
|
|
|
1005 ;;(epg-context-set-textmode context epa-textmode)
|
|
|
1006 (epg-context-set-textmode context t)
|
|
|
1007 (epg-context-set-signers context signers)
|
|
|
1008 (epg-context-set-passphrase-callback context
|
|
|
1009 #'epa-passphrase-callback-function)
|
|
|
1010 (epg-context-set-progress-callback context
|
|
|
1011 (cons
|
|
|
1012 #'epa-progress-callback-function
|
|
|
1013 "Signing..."))
|
|
|
1014 (message "Signing...")
|
|
|
1015 (setq signature (epg-sign-string context
|
|
|
1016 (epa--encode-coding-string
|
|
|
1017 (buffer-substring start end)
|
|
|
1018 epa-last-coding-system-specified)
|
|
|
1019 mode))
|
|
|
1020 (message "Signing...done")
|
|
|
1021 (delete-region start end)
|
|
|
1022 (goto-char start)
|
|
|
1023 (add-text-properties (point)
|
|
|
1024 (progn
|
|
|
1025 (insert (epa--decode-coding-string
|
|
|
1026 signature
|
|
|
1027 (or coding-system-for-read
|
|
|
1028 epa-last-coding-system-specified)))
|
|
|
1029 (point))
|
|
|
1030 (list 'epa-coding-system-used
|
|
|
1031 epa-last-coding-system-specified
|
|
|
1032 'front-sticky nil
|
|
|
1033 'rear-nonsticky t
|
|
|
1034 'start-open t
|
|
|
1035 'end-open t)))))
|
|
|
1036
|
|
|
1037 (eval-and-compile
|
|
|
1038 (if (fboundp 'derived-mode-p)
|
|
|
1039 (defalias 'epa--derived-mode-p 'derived-mode-p)
|
|
|
1040 (defun epa--derived-mode-p (&rest modes)
|
|
|
1041 "Non-nil if the current major mode is derived from one of MODES.
|
|
|
1042 Uses the `derived-mode-parent' property of the symbol to trace backwards."
|
|
|
1043 (let ((parent major-mode))
|
|
|
1044 (while (and (not (memq parent modes))
|
|
|
1045 (setq parent (get parent 'derived-mode-parent))))
|
|
|
1046 parent))))
|
|
|
1047
|
|
|
1048 ;;;###autoload
|
|
|
1049 (defun epa-encrypt-region (start end recipients sign signers)
|
|
|
1050 "Encrypt the current region between START and END for RECIPIENTS.
|
|
|
1051
|
|
93506
|
1052 Don't use this command in Lisp programs!
|
|
|
1053 Since this function operates on regions, it does some tricks such
|
|
|
1054 as coding-system detection and unibyte/multibyte conversion. If
|
|
|
1055 you are sure how the data should be treated, you should consider
|
|
|
1056 using the string based counterpart `epg-encrypt-string', or the
|
|
|
1057 file based counterpart `epg-encrypt-file' instead.
|
|
|
1058
|
|
|
1059 For example:
|
|
|
1060
|
|
|
1061 \(let ((context (epg-make-context 'OpenPGP)))
|
|
|
1062 (epg-encrypt-string
|
|
|
1063 context
|
|
|
1064 (encode-coding-string (buffer-substring start end) 'utf-8)
|
|
|
1065 nil))"
|
|
91647
|
1066 (interactive
|
|
|
1067 (let ((verbose current-prefix-arg)
|
|
|
1068 (context (epg-make-context epa-protocol))
|
|
|
1069 sign)
|
|
|
1070 (setq epa-last-coding-system-specified
|
|
|
1071 (or coding-system-for-write
|
|
|
1072 (epa--select-safe-coding-system
|
|
|
1073 (region-beginning) (region-end))))
|
|
|
1074 (list (region-beginning) (region-end)
|
|
|
1075 (epa-select-keys context
|
|
|
1076 "Select recipients for encryption.
|
|
|
1077 If no one is selected, symmetric encryption will be performed. ")
|
|
|
1078 (setq sign (if verbose (y-or-n-p "Sign? ")))
|
|
|
1079 (if sign
|
|
|
1080 (epa-select-keys context
|
|
|
1081 "Select keys for signing. ")))))
|
|
|
1082 (save-excursion
|
|
|
1083 (let ((context (epg-make-context epa-protocol))
|
|
|
1084 cipher)
|
|
|
1085 ;;(epg-context-set-armor context epa-armor)
|
|
|
1086 (epg-context-set-armor context t)
|
|
|
1087 ;;(epg-context-set-textmode context epa-textmode)
|
|
|
1088 (epg-context-set-textmode context t)
|
|
|
1089 (if sign
|
|
|
1090 (epg-context-set-signers context signers))
|
|
|
1091 (epg-context-set-passphrase-callback context
|
|
|
1092 #'epa-passphrase-callback-function)
|
|
|
1093 (epg-context-set-progress-callback context
|
|
|
1094 (cons
|
|
|
1095 #'epa-progress-callback-function
|
|
|
1096 "Encrypting..."))
|
|
|
1097 (message "Encrypting...")
|
|
|
1098 (setq cipher (epg-encrypt-string context
|
|
|
1099 (epa--encode-coding-string
|
|
|
1100 (buffer-substring start end)
|
|
|
1101 epa-last-coding-system-specified)
|
|
|
1102 recipients
|
|
|
1103 sign))
|
|
|
1104 (message "Encrypting...done")
|
|
|
1105 (delete-region start end)
|
|
|
1106 (goto-char start)
|
|
|
1107 (add-text-properties (point)
|
|
|
1108 (progn
|
|
|
1109 (insert cipher)
|
|
|
1110 (point))
|
|
|
1111 (list 'epa-coding-system-used
|
|
|
1112 epa-last-coding-system-specified
|
|
|
1113 'front-sticky nil
|
|
|
1114 'rear-nonsticky t
|
|
|
1115 'start-open t
|
|
|
1116 'end-open t)))))
|
|
|
1117
|
|
|
1118 ;;;###autoload
|
|
|
1119 (defun epa-delete-keys (keys &optional allow-secret)
|
|
93506
|
1120 "Delete selected KEYS."
|
|
91647
|
1121 (interactive
|
|
|
1122 (let ((keys (epa--marked-keys)))
|
|
|
1123 (unless keys
|
|
|
1124 (error "No keys selected"))
|
|
|
1125 (list keys
|
|
|
1126 (eq (nth 1 epa-list-keys-arguments) t))))
|
|
|
1127 (let ((context (epg-make-context epa-protocol)))
|
|
|
1128 (message "Deleting...")
|
|
|
1129 (epg-delete-keys context keys allow-secret)
|
|
|
1130 (message "Deleting...done")
|
|
94471
|
1131 (apply #'epa--list-keys epa-list-keys-arguments)))
|
|
91647
|
1132
|
|
|
1133 ;;;###autoload
|
|
|
1134 (defun epa-import-keys (file)
|
|
93506
|
1135 "Import keys from FILE."
|
|
91647
|
1136 (interactive "fFile: ")
|
|
|
1137 (setq file (expand-file-name file))
|
|
|
1138 (let ((context (epg-make-context epa-protocol)))
|
|
|
1139 (message "Importing %s..." (file-name-nondirectory file))
|
|
|
1140 (condition-case nil
|
|
|
1141 (progn
|
|
|
1142 (epg-import-keys-from-file context file)
|
|
|
1143 (message "Importing %s...done" (file-name-nondirectory file)))
|
|
|
1144 (error
|
|
|
1145 (message "Importing %s...failed" (file-name-nondirectory file))))
|
|
|
1146 (if (epg-context-result-for context 'import)
|
|
|
1147 (epa-display-info (epg-import-result-to-string
|
|
|
1148 (epg-context-result-for context 'import))))
|
|
|
1149 (if (eq major-mode 'epa-key-list-mode)
|
|
94471
|
1150 (apply #'epa--list-keys epa-list-keys-arguments))))
|
|
91647
|
1151
|
|
|
1152 ;;;###autoload
|
|
|
1153 (defun epa-import-keys-region (start end)
|
|
93506
|
1154 "Import keys from the region."
|
|
91647
|
1155 (interactive "r")
|
|
|
1156 (let ((context (epg-make-context epa-protocol)))
|
|
|
1157 (message "Importing...")
|
|
|
1158 (condition-case nil
|
|
|
1159 (progn
|
|
|
1160 (epg-import-keys-from-string context (buffer-substring start end))
|
|
|
1161 (message "Importing...done"))
|
|
|
1162 (error
|
|
|
1163 (message "Importing...failed")))
|
|
|
1164 (if (epg-context-result-for context 'import)
|
|
|
1165 (epa-display-info (epg-import-result-to-string
|
|
|
1166 (epg-context-result-for context 'import))))))
|
|
|
1167
|
|
|
1168 ;;;###autoload
|
|
|
1169 (defun epa-import-armor-in-region (start end)
|
|
|
1170 "Import keys in the OpenPGP armor format in the current region
|
|
93506
|
1171 between START and END."
|
|
91647
|
1172 (interactive "r")
|
|
|
1173 (save-excursion
|
|
|
1174 (save-restriction
|
|
|
1175 (narrow-to-region start end)
|
|
|
1176 (goto-char start)
|
|
|
1177 (let (armor-start armor-end)
|
|
|
1178 (while (re-search-forward
|
|
|
1179 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
|
|
|
1180 nil t)
|
|
|
1181 (setq armor-start (match-beginning 0)
|
|
|
1182 armor-end (re-search-forward
|
|
|
1183 (concat "^-----END " (match-string 1) "-----$")
|
|
|
1184 nil t))
|
|
|
1185 (unless armor-end
|
|
|
1186 (error "No armor tail"))
|
|
|
1187 (epa-import-keys-region armor-start armor-end))))))
|
|
|
1188
|
|
|
1189 ;;;###autoload
|
|
|
1190 (defun epa-export-keys (keys file)
|
|
93506
|
1191 "Export selected KEYS to FILE."
|
|
91647
|
1192 (interactive
|
|
|
1193 (let ((keys (epa--marked-keys))
|
|
|
1194 default-name)
|
|
|
1195 (unless keys
|
|
|
1196 (error "No keys selected"))
|
|
|
1197 (setq default-name
|
|
|
1198 (expand-file-name
|
|
|
1199 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
|
|
|
1200 (if epa-armor ".asc" ".gpg"))
|
|
|
1201 default-directory))
|
|
|
1202 (list keys
|
|
|
1203 (expand-file-name
|
|
|
1204 (read-file-name
|
|
|
1205 (concat "To file (default "
|
|
|
1206 (file-name-nondirectory default-name)
|
|
|
1207 ") ")
|
|
|
1208 (file-name-directory default-name)
|
|
|
1209 default-name)))))
|
|
|
1210 (let ((context (epg-make-context epa-protocol)))
|
|
|
1211 (epg-context-set-armor context epa-armor)
|
|
|
1212 (message "Exporting to %s..." (file-name-nondirectory file))
|
|
|
1213 (epg-export-keys-to-file context keys file)
|
|
|
1214 (message "Exporting to %s...done" (file-name-nondirectory file))))
|
|
|
1215
|
|
|
1216 ;;;###autoload
|
|
|
1217 (defun epa-insert-keys (keys)
|
|
93506
|
1218 "Insert selected KEYS after the point."
|
|
91647
|
1219 (interactive
|
|
|
1220 (list (epa-select-keys (epg-make-context epa-protocol)
|
|
|
1221 "Select keys to export. ")))
|
|
|
1222 (let ((context (epg-make-context epa-protocol)))
|
|
|
1223 ;;(epg-context-set-armor context epa-armor)
|
|
|
1224 (epg-context-set-armor context t)
|
|
|
1225 (insert (epg-export-keys-to-string context keys))))
|
|
|
1226
|
|
|
1227 ;; (defun epa-sign-keys (keys &optional local)
|
|
|
1228 ;; "Sign selected KEYS.
|
|
|
1229 ;; If a prefix-arg is specified, the signature is marked as non exportable.
|
|
|
1230
|
|
|
1231 ;; Don't use this command in Lisp programs!"
|
|
|
1232 ;; (interactive
|
|
|
1233 ;; (let ((keys (epa--marked-keys)))
|
|
|
1234 ;; (unless keys
|
|
|
1235 ;; (error "No keys selected"))
|
|
|
1236 ;; (list keys current-prefix-arg)))
|
|
|
1237 ;; (let ((context (epg-make-context epa-protocol)))
|
|
|
1238 ;; (epg-context-set-passphrase-callback context
|
|
|
1239 ;; #'epa-passphrase-callback-function)
|
|
|
1240 ;; (epg-context-set-progress-callback context
|
|
|
1241 ;; (cons
|
|
|
1242 ;; #'epa-progress-callback-function
|
|
|
1243 ;; "Signing keys..."))
|
|
|
1244 ;; (message "Signing keys...")
|
|
|
1245 ;; (epg-sign-keys context keys local)
|
|
|
1246 ;; (message "Signing keys...done")))
|
|
|
1247 ;; (make-obsolete 'epa-sign-keys "Do not use.")
|
|
|
1248
|
|
|
1249 (provide 'epa)
|
|
|
1250
|
|
91687
|
1251 ;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7
|
|
91647
|
1252 ;;; epa.el ends here
|
