Re-indent.
[emacs.git] / lisp / epa.el
blob21c4e70a9e1f0622e527576a268dbade72bbf671
1 ;;; epa.el --- the EasyPG Assistant
2 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of GNU Emacs.
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.
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.
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.
24 ;;; Code:
26 (require 'epg)
27 (require 'font-lock)
28 (require 'widget)
29 (eval-when-compile (require 'wid-edit))
30 (require 'derived)
32 (defgroup epa nil
33 "The EasyPG Assistant"
34 :version "23.1"
35 :group 'epg)
37 (defcustom epa-popup-info-window t
38 "If non-nil, status information from epa commands is displayed on
39 the separate window."
40 :type 'boolean
41 :group 'epa)
43 (defcustom epa-info-window-height 5
44 "Number of lines used to display status information."
45 :type 'integer
46 :group 'epa)
48 (defcustom epa-global-minor-modes '(epa-global-dired-mode
49 epa-global-mail-mode
50 epa-file-mode)
51 "Globally defined minor modes to hook into other modes."
52 :type '(repeat symbol)
53 :group 'epa)
55 (defgroup epa-faces nil
56 "Faces for epa-mode."
57 :version "23.1"
58 :group 'epa)
60 (defface epa-validity-high
61 `((((class color) (background dark))
62 (:foreground "PaleTurquoise"
63 ,@(if (assq ':weight custom-face-attributes)
64 '(:weight bold)
65 '(:bold t))))
67 (,@(if (assq ':weight custom-face-attributes)
68 '(:weight bold)
69 '(:bold t)))))
70 "Face used for displaying the high validity."
71 :group 'epa-faces)
73 (defface epa-validity-medium
74 `((((class color) (background dark))
75 (:foreground "PaleTurquoise"
76 ,@(if (assq ':slant custom-face-attributes)
77 '(:slant italic)
78 '(:italic t))))
80 (,@(if (assq ':slant custom-face-attributes)
81 '(:slant italic)
82 '(:italic t)))))
83 "Face used for displaying the medium validity."
84 :group 'epa-faces)
86 (defface epa-validity-low
87 `((t
88 (,@(if (assq ':slant custom-face-attributes)
89 '(:slant italic)
90 '(:italic t)))))
91 "Face used for displaying the low validity."
92 :group 'epa-faces)
94 (defface epa-validity-disabled
95 `((t
96 (,@(if (assq ':slant custom-face-attributes)
97 '(:slant italic)
98 '(:italic t))
99 :inverse-video t)))
100 "Face used for displaying the disabled validity."
101 :group 'epa-faces)
103 (defface epa-string
104 '((((class color) (background dark))
105 (:foreground "lightyellow"))
106 (((class color) (background light))
107 (:foreground "blue4")))
108 "Face used for displaying the string."
109 :group 'epa-faces)
111 (defface epa-mark
112 `((((class color) (background dark))
113 (:foreground "orange"
114 ,@(if (assq ':weight custom-face-attributes)
115 '(:weight bold)
116 '(:bold t))))
117 (((class color) (background light))
118 (:foreground "red"
119 ,@(if (assq ':weight custom-face-attributes)
120 '(:weight bold)
121 '(:bold t))))
123 (,@(if (assq ':weight custom-face-attributes)
124 '(:weight bold)
125 '(:bold t)))))
126 "Face used for displaying the high validity."
127 :group 'epa-faces)
129 (defface epa-field-name
130 `((((class color) (background dark))
131 (:foreground "PaleTurquoise"
132 ,@(if (assq ':weight custom-face-attributes)
133 '(:weight bold)
134 '(:bold t))))
136 (,@(if (assq ':weight custom-face-attributes)
137 '(:weight bold)
138 '(:bold t)))))
139 "Face for the name of the attribute field."
140 :group 'epa)
142 (defface epa-field-body
143 `((((class color) (background dark))
144 (:foreground "turquoise"
145 ,@(if (assq ':slant custom-face-attributes)
146 '(:slant italic)
147 '(:italic t))))
149 (,@(if (assq ':slant custom-face-attributes)
150 '(:slant italic)
151 '(:italic t)))))
152 "Face for the body of the attribute field."
153 :group 'epa)
155 (defcustom epa-validity-face-alist
156 '((unknown . epa-validity-disabled)
157 (invalid . epa-validity-disabled)
158 (disabled . epa-validity-disabled)
159 (revoked . epa-validity-disabled)
160 (expired . epa-validity-disabled)
161 (none . epa-validity-low)
162 (undefined . epa-validity-low)
163 (never . epa-validity-low)
164 (marginal . epa-validity-medium)
165 (full . epa-validity-high)
166 (ultimate . epa-validity-high))
167 "An alist mapping validity values to faces."
168 :type '(repeat (cons symbol face))
169 :group 'epa)
171 (defvar epa-font-lock-keywords
172 '(("^\\*"
173 (0 'epa-mark))
174 ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
175 (1 'epa-field-name)
176 (2 'epa-field-body)))
177 "Default expressions to addon in epa-mode.")
179 (defconst epa-pubkey-algorithm-letter-alist
180 '((1 . ?R)
181 (2 . ?r)
182 (3 . ?s)
183 (16 . ?g)
184 (17 . ?D)
185 (20 . ?G)))
187 (defvar epa-protocol 'OpenPGP
188 "*The default protocol.
189 The value can be either OpenPGP or CMS.
191 You should bind this variable with `let', but do not set it globally.")
193 (defvar epa-armor nil
194 "*If non-nil, epa commands create ASCII armored output.
196 You should bind this variable with `let', but do not set it globally.")
198 (defvar epa-textmode nil
199 "*If non-nil, epa commands treat input files as text.
201 You should bind this variable with `let', but do not set it globally.")
203 (defvar epa-keys-buffer nil)
204 (defvar epa-key-buffer-alist nil)
205 (defvar epa-key nil)
206 (defvar epa-list-keys-arguments nil)
207 (defvar epa-info-buffer nil)
208 (defvar epa-last-coding-system-specified nil)
210 (defvar epa-key-list-mode-map
211 (let ((keymap (make-sparse-keymap)))
212 (define-key keymap "m" 'epa-mark-key)
213 (define-key keymap "u" 'epa-unmark-key)
214 (define-key keymap "d" 'epa-decrypt-file)
215 (define-key keymap "v" 'epa-verify-file)
216 (define-key keymap "s" 'epa-sign-file)
217 (define-key keymap "e" 'epa-encrypt-file)
218 (define-key keymap "r" 'epa-delete-keys)
219 (define-key keymap "i" 'epa-import-keys)
220 (define-key keymap "o" 'epa-export-keys)
221 (define-key keymap "g" 'revert-buffer)
222 (define-key keymap "n" 'next-line)
223 (define-key keymap "p" 'previous-line)
224 (define-key keymap " " 'scroll-up)
225 (define-key keymap [delete] 'scroll-down)
226 (define-key keymap "q" 'epa-exit-buffer)
227 keymap))
229 (defvar epa-key-mode-map
230 (let ((keymap (make-sparse-keymap)))
231 (define-key keymap "q" 'epa-exit-buffer)
232 keymap))
234 (defvar epa-info-mode-map
235 (let ((keymap (make-sparse-keymap)))
236 (define-key keymap "q" 'delete-window)
237 keymap))
239 (defvar epa-menu nil)
241 (defconst epa-menu-items
242 '("Encryption/Decryption"
243 ("Decrypt"
244 ["File" epa-decrypt-file
245 :help "Decrypt a file"]
246 ["Region" epa-decrypt-region
247 :help "Decrypt the current region"])
248 ("Verify"
249 ["File" epa-verify-file
250 :help "Verify digital signature of a file"]
251 ["Region" epa-verify-region
252 :help "Verify digital signature of the current region"])
253 ("Sign"
254 ["File" epa-sign-file
255 :help "Create digital signature of a file"]
256 ["Region" epa-sign-region
257 :help "Create digital signature of the current region"])
258 ("Encrypt"
259 ["File" epa-encrypt-file
260 :help "Encrypt a file"]
261 ["Region" epa-encrypt-region
262 :help "Encrypt the current region"])
263 "----"
264 ["Browse keyring" epa-list-keys
265 :help "Browse your public keyring"]
266 ("Import keys"
267 ["File" epa-import-keys
268 :help "Import public keys from a file"]
269 ["Region" epa-import-keys-region
270 :help "Import public keys from the current region"])
271 ("Export key"
272 ["To a File" epa-export-keys
273 :help "Export public keys to a file"]
274 ["To a Buffer" epa-insert-keys
275 :help "Insert public keys after the current point"])))
277 (defvar epa-exit-buffer-function #'bury-buffer)
279 (define-widget 'epa-key 'push-button
280 "Button for representing a epg-key object."
281 :format "%[%v%]"
282 :button-face-get 'epa--key-widget-button-face-get
283 :value-create 'epa--key-widget-value-create
284 :action 'epa--key-widget-action
285 :help-echo 'epa--key-widget-help-echo)
287 (defun epa--key-widget-action (widget &optional event)
288 (epa--show-key (widget-get widget :value)))
290 (defun epa--key-widget-value-create (widget)
291 (let* ((key (widget-get widget :value))
292 (primary-sub-key (car (epg-key-sub-key-list key)))
293 (primary-user-id (car (epg-key-user-id-list key))))
294 (insert (format "%c "
295 (if (epg-sub-key-validity primary-sub-key)
296 (car (rassq (epg-sub-key-validity primary-sub-key)
297 epg-key-validity-alist))
298 ? ))
299 (epg-sub-key-id primary-sub-key)
301 (if primary-user-id
302 (if (stringp (epg-user-id-string primary-user-id))
303 (epg-user-id-string primary-user-id)
304 (epg-decode-dn (epg-user-id-string primary-user-id)))
305 ""))))
307 (defun epa--key-widget-button-face-get (widget)
308 (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
309 (widget-get widget :value))))))
310 (if validity
311 (cdr (assq validity epa-validity-face-alist))
312 'default)))
314 (defun epa--key-widget-help-echo (widget)
315 (format "Show %s"
316 (epg-sub-key-id (car (epg-key-sub-key-list
317 (widget-get widget :value))))))
319 (eval-and-compile
320 (if (fboundp 'encode-coding-string)
321 (defalias 'epa--encode-coding-string 'encode-coding-string)
322 (defalias 'epa--encode-coding-string 'identity)))
324 (eval-and-compile
325 (if (fboundp 'decode-coding-string)
326 (defalias 'epa--decode-coding-string 'decode-coding-string)
327 (defalias 'epa--decode-coding-string 'identity)))
329 (defun epa-key-list-mode ()
330 "Major mode for `epa-list-keys'."
331 (kill-all-local-variables)
332 (buffer-disable-undo)
333 (setq major-mode 'epa-key-list-mode
334 mode-name "Keys"
335 truncate-lines t
336 buffer-read-only t)
337 (use-local-map epa-key-list-mode-map)
338 (make-local-variable 'font-lock-defaults)
339 (setq font-lock-defaults '(epa-font-lock-keywords t))
340 ;; In XEmacs, auto-initialization of font-lock is not effective
341 ;; if buffer-file-name is not set.
342 (font-lock-set-defaults)
343 (make-local-variable 'epa-exit-buffer-function)
344 (make-local-variable 'revert-buffer-function)
345 (setq revert-buffer-function 'epa--key-list-revert-buffer)
346 (run-hooks 'epa-key-list-mode-hook))
348 (defun epa-key-mode ()
349 "Major mode for a key description."
350 (kill-all-local-variables)
351 (buffer-disable-undo)
352 (setq major-mode 'epa-key-mode
353 mode-name "Key"
354 truncate-lines t
355 buffer-read-only t)
356 (use-local-map epa-key-mode-map)
357 (make-local-variable 'font-lock-defaults)
358 (setq font-lock-defaults '(epa-font-lock-keywords t))
359 ;; In XEmacs, auto-initialization of font-lock is not effective
360 ;; if buffer-file-name is not set.
361 (font-lock-set-defaults)
362 (make-local-variable 'epa-exit-buffer-function)
363 (run-hooks 'epa-key-mode-hook))
365 (defun epa-info-mode ()
366 "Major mode for `epa-info-buffer'."
367 (kill-all-local-variables)
368 (buffer-disable-undo)
369 (setq major-mode 'epa-info-mode
370 mode-name "Info"
371 truncate-lines t
372 buffer-read-only t)
373 (use-local-map epa-info-mode-map)
374 (run-hooks 'epa-info-mode-hook))
376 (defun epa-mark-key (&optional arg)
377 "Mark a key on the current line.
378 If ARG is non-nil, unmark the key."
379 (interactive "P")
380 (let ((inhibit-read-only t)
381 buffer-read-only
382 properties)
383 (beginning-of-line)
384 (unless (get-text-property (point) 'epa-key)
385 (error "No key on this line"))
386 (setq properties (text-properties-at (point)))
387 (delete-char 1)
388 (insert (if arg " " "*"))
389 (set-text-properties (1- (point)) (point) properties)
390 (forward-line)))
392 (defun epa-unmark-key (&optional arg)
393 "Unmark a key on the current line.
394 If ARG is non-nil, mark the key."
395 (interactive "P")
396 (epa-mark-key (not arg)))
398 (defun epa-exit-buffer ()
399 "Exit the current buffer.
400 `epa-exit-buffer-function' is called if it is set."
401 (interactive)
402 (funcall epa-exit-buffer-function))
404 (defun epa--insert-keys (keys)
405 (save-excursion
406 (save-restriction
407 (narrow-to-region (point) (point))
408 (let (point)
409 (while keys
410 (setq point (point))
411 (insert " ")
412 (add-text-properties point (point)
413 (list 'epa-key (car keys)
414 'front-sticky nil
415 'rear-nonsticky t
416 'start-open t
417 'end-open t))
418 (widget-create 'epa-key :value (car keys))
419 (insert "\n")
420 (setq keys (cdr keys))))
421 (add-text-properties (point-min) (point-max)
422 (list 'epa-list-keys t
423 'front-sticky nil
424 'rear-nonsticky t
425 'start-open t
426 'end-open t)))))
428 (defun epa--list-keys (name secret)
429 (unless (and epa-keys-buffer
430 (buffer-live-p epa-keys-buffer))
431 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
432 (set-buffer epa-keys-buffer)
433 (epa-key-list-mode)
434 (let ((inhibit-read-only t)
435 buffer-read-only
436 (point (point-min))
437 (context (epg-make-context epa-protocol)))
438 (unless (get-text-property point 'epa-list-keys)
439 (setq point (next-single-property-change point 'epa-list-keys)))
440 (when point
441 (delete-region point
442 (or (next-single-property-change point 'epa-list-keys)
443 (point-max)))
444 (goto-char point))
445 (epa--insert-keys (epg-list-keys context name secret))
446 (widget-setup)
447 (set-keymap-parent (current-local-map) widget-keymap))
448 (make-local-variable 'epa-list-keys-arguments)
449 (setq epa-list-keys-arguments (list name secret))
450 (goto-char (point-min))
451 (pop-to-buffer (current-buffer)))
453 ;;;###autoload
454 (defun epa-list-keys (&optional name)
455 "List all keys matched with NAME from the public keyring."
456 (interactive
457 (if current-prefix-arg
458 (let ((name (read-string "Pattern: "
459 (if epa-list-keys-arguments
460 (car epa-list-keys-arguments)))))
461 (list (if (equal name "") nil name)))
462 (list nil)))
463 (epa--list-keys name nil))
465 ;;;###autoload
466 (defun epa-list-secret-keys (&optional name)
467 "List all keys matched with NAME from the private keyring."
468 (interactive
469 (if current-prefix-arg
470 (let ((name (read-string "Pattern: "
471 (if epa-list-keys-arguments
472 (car epa-list-keys-arguments)))))
473 (list (if (equal name "") nil name)))
474 (list nil)))
475 (epa--list-keys name t))
477 (defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm)
478 (apply #'epa--list-keys epa-list-keys-arguments))
480 (defun epa--marked-keys ()
481 (or (save-excursion
482 (set-buffer epa-keys-buffer)
483 (goto-char (point-min))
484 (let (keys key)
485 (while (re-search-forward "^\\*" nil t)
486 (if (setq key (get-text-property (match-beginning 0)
487 'epa-key))
488 (setq keys (cons key keys))))
489 (nreverse keys)))
490 (save-excursion
491 (beginning-of-line)
492 (let ((key (get-text-property (point) 'epa-key)))
493 (if key
494 (list key))))))
496 (defun epa--select-keys (prompt keys)
497 (save-excursion
498 (unless (and epa-keys-buffer
499 (buffer-live-p epa-keys-buffer))
500 (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
501 (set-buffer epa-keys-buffer)
502 (epa-key-list-mode)
503 (let ((inhibit-read-only t)
504 buffer-read-only)
505 (erase-buffer)
506 (insert prompt "\n"
507 (substitute-command-keys "\
508 - `\\[epa-mark-key]' to mark a key on the line
509 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
510 (widget-create 'link
511 :notify (lambda (&rest ignore) (abort-recursive-edit))
512 :help-echo
513 (substitute-command-keys
514 "Click here or \\[abort-recursive-edit] to cancel")
515 "Cancel")
516 (widget-create 'link
517 :notify (lambda (&rest ignore) (exit-recursive-edit))
518 :help-echo
519 (substitute-command-keys
520 "Click here or \\[exit-recursive-edit] to finish")
521 "OK")
522 (insert "\n\n")
523 (epa--insert-keys keys)
524 (widget-setup)
525 (set-keymap-parent (current-local-map) widget-keymap)
526 (setq epa-exit-buffer-function #'abort-recursive-edit)
527 (goto-char (point-min))
528 (pop-to-buffer (current-buffer)))
529 (unwind-protect
530 (progn
531 (recursive-edit)
532 (epa--marked-keys))
533 (if (get-buffer-window epa-keys-buffer)
534 (delete-window (get-buffer-window epa-keys-buffer)))
535 (kill-buffer epa-keys-buffer))))
537 ;;;###autoload
538 (defun epa-select-keys (context prompt &optional names secret)
539 "Display a user's keyring and ask him to select keys.
540 CONTEXT is an epg-context.
541 PROMPT is a string to prompt with.
542 NAMES is a list of strings to be matched with keys. If it is nil, all
543 the keys are listed.
544 If SECRET is non-nil, list secret keys instead of public keys."
545 (let ((keys (epg-list-keys context names secret)))
546 (if (> (length keys) 1)
547 (epa--select-keys prompt keys)
548 keys)))
550 (defun epa--show-key (key)
551 (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
552 (entry (assoc (epg-sub-key-id primary-sub-key)
553 epa-key-buffer-alist))
554 (inhibit-read-only t)
555 buffer-read-only
556 pointer)
557 (unless entry
558 (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
559 epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
560 (unless (and (cdr entry)
561 (buffer-live-p (cdr entry)))
562 (setcdr entry (generate-new-buffer
563 (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
564 (set-buffer (cdr entry))
565 (epa-key-mode)
566 (make-local-variable 'epa-key)
567 (setq epa-key key)
568 (erase-buffer)
569 (setq pointer (epg-key-user-id-list key))
570 (while pointer
571 (if (car pointer)
572 (insert " "
573 (if (epg-user-id-validity (car pointer))
574 (char-to-string
575 (car (rassq (epg-user-id-validity (car pointer))
576 epg-key-validity-alist)))
577 " ")
579 (if (stringp (epg-user-id-string (car pointer)))
580 (epg-user-id-string (car pointer))
581 (epg-decode-dn (epg-user-id-string (car pointer))))
582 "\n"))
583 (setq pointer (cdr pointer)))
584 (setq pointer (epg-key-sub-key-list key))
585 (while pointer
586 (insert " "
587 (if (epg-sub-key-validity (car pointer))
588 (char-to-string
589 (car (rassq (epg-sub-key-validity (car pointer))
590 epg-key-validity-alist)))
591 " ")
593 (epg-sub-key-id (car pointer))
595 (format "%dbits"
596 (epg-sub-key-length (car pointer)))
598 (cdr (assq (epg-sub-key-algorithm (car pointer))
599 epg-pubkey-algorithm-alist))
600 "\n\tCreated: "
601 (condition-case nil
602 (format-time-string "%Y-%m-%d"
603 (epg-sub-key-creation-time (car pointer)))
604 (error "????-??-??"))
605 (if (epg-sub-key-expiration-time (car pointer))
606 (format "\n\tExpires: %s"
607 (condition-case nil
608 (format-time-string "%Y-%m-%d"
609 (epg-sub-key-expiration-time
610 (car pointer)))
611 (error "????-??-??")))
613 "\n\tCapabilities: "
614 (mapconcat #'symbol-name
615 (epg-sub-key-capability (car pointer))
616 " ")
617 "\n\tFingerprint: "
618 (epg-sub-key-fingerprint (car pointer))
619 "\n")
620 (setq pointer (cdr pointer)))
621 (goto-char (point-min))
622 (pop-to-buffer (current-buffer))))
624 (defun epa-display-info (info)
625 (if epa-popup-info-window
626 (save-selected-window
627 (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
628 (setq epa-info-buffer (generate-new-buffer "*Info*")))
629 (if (get-buffer-window epa-info-buffer)
630 (delete-window (get-buffer-window epa-info-buffer)))
631 (save-excursion
632 (set-buffer epa-info-buffer)
633 (let ((inhibit-read-only t)
634 buffer-read-only)
635 (erase-buffer)
636 (insert info))
637 (epa-info-mode)
638 (goto-char (point-min)))
639 (if (> (window-height)
640 epa-info-window-height)
641 (set-window-buffer (split-window nil (- (window-height)
642 epa-info-window-height))
643 epa-info-buffer)
644 (pop-to-buffer epa-info-buffer)
645 (if (> (window-height) epa-info-window-height)
646 (shrink-window (- (window-height) epa-info-window-height)))))
647 (message "%s" info)))
649 (defun epa-display-verify-result (verify-result)
650 (epa-display-info (epg-verify-result-to-string verify-result)))
651 (make-obsolete 'epa-display-verify-result 'epa-display-info)
653 (defun epa-passphrase-callback-function (context key-id handback)
654 (if (eq key-id 'SYM)
655 (read-passwd "Passphrase for symmetric encryption: "
656 (eq (epg-context-operation context) 'encrypt))
657 (read-passwd
658 (if (eq key-id 'PIN)
659 "Passphrase for PIN: "
660 (let ((entry (assoc key-id epg-user-id-alist)))
661 (if entry
662 (format "Passphrase for %s %s: " key-id (cdr entry))
663 (format "Passphrase for %s: " key-id)))))))
665 (defun epa-progress-callback-function (context what char current total
666 handback)
667 (message "%s%d%% (%d/%d)" (or handback
668 (concat what ": "))
669 (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
670 current total))
672 ;;;###autoload
673 (defun epa-decrypt-file (file)
674 "Decrypt FILE."
675 (interactive "fFile: ")
676 (setq file (expand-file-name file))
677 (let* ((default-name (file-name-sans-extension file))
678 (plain (expand-file-name
679 (read-file-name
680 (concat "To file (default "
681 (file-name-nondirectory default-name)
682 ") ")
683 (file-name-directory default-name)
684 default-name)))
685 (context (epg-make-context epa-protocol)))
686 (epg-context-set-passphrase-callback context
687 #'epa-passphrase-callback-function)
688 (epg-context-set-progress-callback context
689 (cons
690 #'epa-progress-callback-function
691 (format "Decrypting %s..."
692 (file-name-nondirectory file))))
693 (message "Decrypting %s..." (file-name-nondirectory file))
694 (epg-decrypt-file context file plain)
695 (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
696 (file-name-nondirectory plain))
697 (if (epg-context-result-for context 'verify)
698 (epa-display-info (epg-verify-result-to-string
699 (epg-context-result-for context 'verify))))))
701 ;;;###autoload
702 (defun epa-verify-file (file)
703 "Verify FILE."
704 (interactive "fFile: ")
705 (setq file (expand-file-name file))
706 (let* ((context (epg-make-context epa-protocol))
707 (plain (if (equal (file-name-extension file) "sig")
708 (file-name-sans-extension file))))
709 (epg-context-set-progress-callback context
710 (cons
711 #'epa-progress-callback-function
712 (format "Verifying %s..."
713 (file-name-nondirectory file))))
714 (message "Verifying %s..." (file-name-nondirectory file))
715 (epg-verify-file context file plain)
716 (message "Verifying %s...done" (file-name-nondirectory file))
717 (if (epg-context-result-for context 'verify)
718 (epa-display-info (epg-verify-result-to-string
719 (epg-context-result-for context 'verify))))))
721 (defun epa--read-signature-type ()
722 (let (type c)
723 (while (null type)
724 (message "Signature type (n,c,d,?) ")
725 (setq c (read-char))
726 (cond ((eq c ?c)
727 (setq type 'clear))
728 ((eq c ?d)
729 (setq type 'detached))
730 ((eq c ??)
731 (with-output-to-temp-buffer "*Help*"
732 (save-excursion
733 (set-buffer standard-output)
734 (insert "\
735 n - Create a normal signature
736 c - Create a cleartext signature
737 d - Create a detached signature
738 ? - Show this help
739 "))))
741 (setq type 'normal))))))
743 ;;;###autoload
744 (defun epa-sign-file (file signers mode)
745 "Sign FILE by SIGNERS keys selected."
746 (interactive
747 (let ((verbose current-prefix-arg))
748 (list (expand-file-name (read-file-name "File: "))
749 (if verbose
750 (epa-select-keys (epg-make-context epa-protocol)
751 "Select keys for signing.
752 If no one is selected, default secret key is used. "
753 nil t))
754 (if verbose
755 (epa--read-signature-type)
756 'clear))))
757 (let ((signature (concat file
758 (if (eq epa-protocol 'OpenPGP)
759 (if (or epa-armor
760 (not (memq mode
761 '(nil t normal detached))))
762 ".asc"
763 (if (memq mode '(t detached))
764 ".sig"
765 ".gpg"))
766 (if (memq mode '(t detached))
767 ".p7s"
768 ".p7m"))))
769 (context (epg-make-context epa-protocol)))
770 (epg-context-set-armor context epa-armor)
771 (epg-context-set-textmode context epa-textmode)
772 (epg-context-set-signers context signers)
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 (format "Signing %s..."
779 (file-name-nondirectory file))))
780 (message "Signing %s..." (file-name-nondirectory file))
781 (epg-sign-file context file signature mode)
782 (message "Signing %s...wrote %s" (file-name-nondirectory file)
783 (file-name-nondirectory signature))))
785 ;;;###autoload
786 (defun epa-encrypt-file (file recipients)
787 "Encrypt FILE for RECIPIENTS."
788 (interactive
789 (list (expand-file-name (read-file-name "File: "))
790 (epa-select-keys (epg-make-context epa-protocol)
791 "Select recipients for encryption.
792 If no one is selected, symmetric encryption will be performed. ")))
793 (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
794 (if epa-armor ".asc" ".gpg")
795 ".p7m")))
796 (context (epg-make-context epa-protocol)))
797 (epg-context-set-armor context epa-armor)
798 (epg-context-set-textmode context epa-textmode)
799 (epg-context-set-passphrase-callback context
800 #'epa-passphrase-callback-function)
801 (epg-context-set-progress-callback context
802 (cons
803 #'epa-progress-callback-function
804 (format "Encrypting %s..."
805 (file-name-nondirectory file))))
806 (message "Encrypting %s..." (file-name-nondirectory file))
807 (epg-encrypt-file context file recipients cipher)
808 (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
809 (file-name-nondirectory cipher))))
811 ;;;###autoload
812 (defun epa-decrypt-region (start end)
813 "Decrypt the current region between START and END.
815 Don't use this command in Lisp programs!"
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)))))))
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)))
858 ;;;###autoload
859 (defun epa-decrypt-armor-in-region (start end)
860 "Decrypt OpenPGP armors in the current region between START and END.
862 Don't use this command in Lisp programs!"
863 (interactive "r")
864 (save-excursion
865 (save-restriction
866 (narrow-to-region start end)
867 (goto-char start)
868 (let (armor-start armor-end)
869 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
870 (setq armor-start (match-beginning 0)
871 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
872 nil t))
873 (unless armor-end
874 (error "No armor tail"))
875 (goto-char armor-start)
876 (let ((coding-system-for-read
877 (or coding-system-for-read
878 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
879 (epa--find-coding-system-for-mime-charset
880 (intern (downcase (match-string 1))))))))
881 (goto-char armor-end)
882 (epa-decrypt-region armor-start armor-end)))))))
884 ;;;###autoload
885 (defun epa-verify-region (start end)
886 "Verify the current region between START and END.
888 Don't use this command in Lisp programs!"
889 (interactive "r")
890 (let ((context (epg-make-context epa-protocol))
891 plain)
892 (epg-context-set-progress-callback context
893 (cons
894 #'epa-progress-callback-function
895 "Verifying..."))
896 (message "Verifying...")
897 (setq plain (epg-verify-string
898 context
899 (epa--encode-coding-string
900 (buffer-substring start end)
901 (or coding-system-for-write
902 (get-text-property start 'epa-coding-system-used)))))
903 (message "Verifying...done")
904 (setq plain (epa--decode-coding-string
905 plain
906 (or coding-system-for-read
907 (get-text-property start 'epa-coding-system-used))))
908 (if (y-or-n-p "Replace the original text? ")
909 (let ((inhibit-read-only t)
910 buffer-read-only)
911 (delete-region start end)
912 (goto-char start)
913 (insert plain))
914 (with-output-to-temp-buffer "*Temp*"
915 (set-buffer standard-output)
916 (insert plain)
917 (epa-info-mode)))
918 (if (epg-context-result-for context 'verify)
919 (epa-display-info (epg-verify-result-to-string
920 (epg-context-result-for context 'verify))))))
922 ;;;###autoload
923 (defun epa-verify-cleartext-in-region (start end)
924 "Verify OpenPGP cleartext signed messages in the current region
925 between START and END.
927 Don't use this command in Lisp programs!"
928 (interactive "r")
929 (save-excursion
930 (save-restriction
931 (narrow-to-region start end)
932 (goto-char start)
933 (let (cleartext-start cleartext-end)
934 (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
935 nil t)
936 (setq cleartext-start (match-beginning 0))
937 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
938 nil t)
939 (error "Invalid cleartext signed message"))
940 (setq cleartext-end (re-search-forward
941 "^-----END PGP SIGNATURE-----$"
942 nil t))
943 (unless cleartext-end
944 (error "No cleartext tail"))
945 (epa-verify-region cleartext-start cleartext-end))))))
947 (eval-and-compile
948 (if (fboundp 'select-safe-coding-system)
949 (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
950 (defun epa--select-safe-coding-system (from to)
951 buffer-file-coding-system)))
953 ;;;###autoload
954 (defun epa-sign-region (start end signers mode)
955 "Sign the current region between START and END by SIGNERS keys selected.
957 Don't use this command in Lisp programs!"
958 (interactive
959 (let ((verbose current-prefix-arg))
960 (setq epa-last-coding-system-specified
961 (or coding-system-for-write
962 (epa--select-safe-coding-system
963 (region-beginning) (region-end))))
964 (list (region-beginning) (region-end)
965 (if verbose
966 (epa-select-keys (epg-make-context epa-protocol)
967 "Select keys for signing.
968 If no one is selected, default secret key is used. "
969 nil t))
970 (if verbose
971 (epa--read-signature-type)
972 'clear))))
973 (save-excursion
974 (let ((context (epg-make-context epa-protocol))
975 signature)
976 ;;(epg-context-set-armor context epa-armor)
977 (epg-context-set-armor context t)
978 ;;(epg-context-set-textmode context epa-textmode)
979 (epg-context-set-textmode context t)
980 (epg-context-set-signers context signers)
981 (epg-context-set-passphrase-callback context
982 #'epa-passphrase-callback-function)
983 (epg-context-set-progress-callback context
984 (cons
985 #'epa-progress-callback-function
986 "Signing..."))
987 (message "Signing...")
988 (setq signature (epg-sign-string context
989 (epa--encode-coding-string
990 (buffer-substring start end)
991 epa-last-coding-system-specified)
992 mode))
993 (message "Signing...done")
994 (delete-region start end)
995 (goto-char start)
996 (add-text-properties (point)
997 (progn
998 (insert (epa--decode-coding-string
999 signature
1000 (or coding-system-for-read
1001 epa-last-coding-system-specified)))
1002 (point))
1003 (list 'epa-coding-system-used
1004 epa-last-coding-system-specified
1005 'front-sticky nil
1006 'rear-nonsticky t
1007 'start-open t
1008 'end-open t)))))
1010 (eval-and-compile
1011 (if (fboundp 'derived-mode-p)
1012 (defalias 'epa--derived-mode-p 'derived-mode-p)
1013 (defun epa--derived-mode-p (&rest modes)
1014 "Non-nil if the current major mode is derived from one of MODES.
1015 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1016 (let ((parent major-mode))
1017 (while (and (not (memq parent modes))
1018 (setq parent (get parent 'derived-mode-parent))))
1019 parent))))
1021 ;;;###autoload
1022 (defun epa-encrypt-region (start end recipients sign signers)
1023 "Encrypt the current region between START and END for RECIPIENTS.
1025 Don't use this command in Lisp programs!"
1026 (interactive
1027 (let ((verbose current-prefix-arg)
1028 (context (epg-make-context epa-protocol))
1029 sign)
1030 (setq epa-last-coding-system-specified
1031 (or coding-system-for-write
1032 (epa--select-safe-coding-system
1033 (region-beginning) (region-end))))
1034 (list (region-beginning) (region-end)
1035 (epa-select-keys context
1036 "Select recipients for encryption.
1037 If no one is selected, symmetric encryption will be performed. ")
1038 (setq sign (if verbose (y-or-n-p "Sign? ")))
1039 (if sign
1040 (epa-select-keys context
1041 "Select keys for signing. ")))))
1042 (save-excursion
1043 (let ((context (epg-make-context epa-protocol))
1044 cipher)
1045 ;;(epg-context-set-armor context epa-armor)
1046 (epg-context-set-armor context t)
1047 ;;(epg-context-set-textmode context epa-textmode)
1048 (epg-context-set-textmode context t)
1049 (if sign
1050 (epg-context-set-signers context signers))
1051 (epg-context-set-passphrase-callback context
1052 #'epa-passphrase-callback-function)
1053 (epg-context-set-progress-callback context
1054 (cons
1055 #'epa-progress-callback-function
1056 "Encrypting..."))
1057 (message "Encrypting...")
1058 (setq cipher (epg-encrypt-string context
1059 (epa--encode-coding-string
1060 (buffer-substring start end)
1061 epa-last-coding-system-specified)
1062 recipients
1063 sign))
1064 (message "Encrypting...done")
1065 (delete-region start end)
1066 (goto-char start)
1067 (add-text-properties (point)
1068 (progn
1069 (insert cipher)
1070 (point))
1071 (list 'epa-coding-system-used
1072 epa-last-coding-system-specified
1073 'front-sticky nil
1074 'rear-nonsticky t
1075 'start-open t
1076 'end-open t)))))
1078 ;;;###autoload
1079 (defun epa-delete-keys (keys &optional allow-secret)
1080 "Delete selected KEYS.
1082 Don't use this command in Lisp programs!"
1083 (interactive
1084 (let ((keys (epa--marked-keys)))
1085 (unless keys
1086 (error "No keys selected"))
1087 (list keys
1088 (eq (nth 1 epa-list-keys-arguments) t))))
1089 (let ((context (epg-make-context epa-protocol)))
1090 (message "Deleting...")
1091 (epg-delete-keys context keys allow-secret)
1092 (message "Deleting...done")
1093 (apply #'epa-list-keys epa-list-keys-arguments)))
1095 ;;;###autoload
1096 (defun epa-import-keys (file)
1097 "Import keys from FILE.
1099 Don't use this command in Lisp programs!"
1100 (interactive "fFile: ")
1101 (setq file (expand-file-name file))
1102 (let ((context (epg-make-context epa-protocol)))
1103 (message "Importing %s..." (file-name-nondirectory file))
1104 (condition-case nil
1105 (progn
1106 (epg-import-keys-from-file context file)
1107 (message "Importing %s...done" (file-name-nondirectory file)))
1108 (error
1109 (message "Importing %s...failed" (file-name-nondirectory file))))
1110 (if (epg-context-result-for context 'import)
1111 (epa-display-info (epg-import-result-to-string
1112 (epg-context-result-for context 'import))))
1113 (if (eq major-mode 'epa-key-list-mode)
1114 (apply #'epa-list-keys epa-list-keys-arguments))))
1116 ;;;###autoload
1117 (defun epa-import-keys-region (start end)
1118 "Import keys from the region.
1120 Don't use this command in Lisp programs!"
1121 (interactive "r")
1122 (let ((context (epg-make-context epa-protocol)))
1123 (message "Importing...")
1124 (condition-case nil
1125 (progn
1126 (epg-import-keys-from-string context (buffer-substring start end))
1127 (message "Importing...done"))
1128 (error
1129 (message "Importing...failed")))
1130 (if (epg-context-result-for context 'import)
1131 (epa-display-info (epg-import-result-to-string
1132 (epg-context-result-for context 'import))))))
1134 ;;;###autoload
1135 (defun epa-import-armor-in-region (start end)
1136 "Import keys in the OpenPGP armor format in the current region
1137 between START and END.
1139 Don't use this command in Lisp programs!"
1140 (interactive "r")
1141 (save-excursion
1142 (save-restriction
1143 (narrow-to-region start end)
1144 (goto-char start)
1145 (let (armor-start armor-end)
1146 (while (re-search-forward
1147 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1148 nil t)
1149 (setq armor-start (match-beginning 0)
1150 armor-end (re-search-forward
1151 (concat "^-----END " (match-string 1) "-----$")
1152 nil t))
1153 (unless armor-end
1154 (error "No armor tail"))
1155 (epa-import-keys-region armor-start armor-end))))))
1157 ;;;###autoload
1158 (defun epa-export-keys (keys file)
1159 "Export selected KEYS to FILE.
1161 Don't use this command in Lisp programs!"
1162 (interactive
1163 (let ((keys (epa--marked-keys))
1164 default-name)
1165 (unless keys
1166 (error "No keys selected"))
1167 (setq default-name
1168 (expand-file-name
1169 (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1170 (if epa-armor ".asc" ".gpg"))
1171 default-directory))
1172 (list keys
1173 (expand-file-name
1174 (read-file-name
1175 (concat "To file (default "
1176 (file-name-nondirectory default-name)
1177 ") ")
1178 (file-name-directory default-name)
1179 default-name)))))
1180 (let ((context (epg-make-context epa-protocol)))
1181 (epg-context-set-armor context epa-armor)
1182 (message "Exporting to %s..." (file-name-nondirectory file))
1183 (epg-export-keys-to-file context keys file)
1184 (message "Exporting to %s...done" (file-name-nondirectory file))))
1186 ;;;###autoload
1187 (defun epa-insert-keys (keys)
1188 "Insert selected KEYS after the point.
1190 Don't use this command in Lisp programs!"
1191 (interactive
1192 (list (epa-select-keys (epg-make-context epa-protocol)
1193 "Select keys to export. ")))
1194 (let ((context (epg-make-context epa-protocol)))
1195 ;;(epg-context-set-armor context epa-armor)
1196 (epg-context-set-armor context t)
1197 (insert (epg-export-keys-to-string context keys))))
1199 ;; (defun epa-sign-keys (keys &optional local)
1200 ;; "Sign selected KEYS.
1201 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1203 ;; Don't use this command in Lisp programs!"
1204 ;; (interactive
1205 ;; (let ((keys (epa--marked-keys)))
1206 ;; (unless keys
1207 ;; (error "No keys selected"))
1208 ;; (list keys current-prefix-arg)))
1209 ;; (let ((context (epg-make-context epa-protocol)))
1210 ;; (epg-context-set-passphrase-callback context
1211 ;; #'epa-passphrase-callback-function)
1212 ;; (epg-context-set-progress-callback context
1213 ;; (cons
1214 ;; #'epa-progress-callback-function
1215 ;; "Signing keys..."))
1216 ;; (message "Signing keys...")
1217 ;; (epg-sign-keys context keys local)
1218 ;; (message "Signing keys...done")))
1219 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1221 ;;;###autoload
1222 (define-minor-mode epa-mode
1223 "Minor mode to hook EasyPG into various modes.
1224 See `epa-global-minor-modes'."
1225 :global t :init-value nil :group 'epa :version "23.1"
1226 (unless epa-menu
1227 (easy-menu-define epa-menu nil "EasyPG Assistant global menu"
1228 epa-menu-items))
1229 (easy-menu-remove-item nil '("Tools") "Encryption/Decryption")
1230 (if epa-mode
1231 (easy-menu-add-item nil '("Tools") epa-menu))
1232 (let ((modes epa-global-minor-modes)
1233 symbol)
1234 (while modes
1235 (setq symbol (car modes))
1236 (if (and symbol
1237 (fboundp symbol))
1238 (funcall symbol epa-mode)
1239 (message "`%S' not found" (car modes)))
1240 (setq modes (cdr modes)))))
1242 (provide 'epa)
1244 ;; arch-tag: 38d20ced-20d5-4137-b17a-f206335423d7
1245 ;;; epa.el ends here