epa.el

   1 ;;; epa.el --- the EasyPG Assistant
   2 ;; Copyright (C) 2006 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG
   6
   7 ;; This file is part of EasyPG.
   8
   9 ;; This program 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 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program 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
  31 (defgroup epa nil
  32   "The EasyPG Assistant"
  33   :group 'epg)
  34
  35 (defcustom epa-armor nil
  36   "If non-nil, epa commands create ASCII armored output."
  37   :type 'boolean
  38   :group 'epa)
  39
  40 (defcustom epa-textmode nil
  41   "If non-nil, epa commands treat input files as text."
  42   :type 'boolean
  43   :group 'epa)
  44
  45 (defcustom epa-popup-info-window t
  46   "If non-nil, status information from epa commands is displayed on
  47 the separate window."
  48   :type 'boolean
  49   :group 'epa)
  50
  51 (defcustom epa-info-window-height 5
  52   "Number of lines used to display status information."
  53   :type 'integer
  54   :group 'epa)
  55
  56 (defgroup epa-faces nil
  57   "Faces for epa-mode."
  58   :group 'epa)
  59
  60 (defface epa-validity-high-face
  61   '((((class color) (background dark))
  62      (:foreground "PaleTurquoise" :bold t))
  63     (t
  64      (:bold t)))
  65   "Face used for displaying the high validity."
  66   :group 'epa-faces)
  67 (defvar epa-validity-high-face 'epa-validity-high-face)
  68
  69 (defface epa-validity-medium-face
  70   '((((class color) (background dark))
  71      (:foreground "PaleTurquoise" :italic t))
  72     (t
  73      ()))
  74   "Face used for displaying the medium validity."
  75   :group 'epa-faces)
  76 (defvar epa-validity-medium-face 'epa-validity-medium-face)
  77
  78 (defface epa-validity-low-face
  79   '((t
  80      (:italic t)))
  81   "Face used for displaying the low validity."
  82   :group 'epa-faces)
  83 (defvar epa-validity-low-face 'epa-validity-low-face)
  84
  85 (defface epa-validity-disabled-face
  86   '((t
  87      (:italic t :inverse-video t)))
  88   "Face used for displaying the disabled validity."
  89   :group 'epa-faces)
  90 (defvar epa-validity-disabled-face 'epa-validity-disabled-face)
  91
  92 (defface epa-string-face
  93   '((((class color)
  94       (background dark))
  95      (:foreground "lightyellow"))
  96     (((class color)
  97       (background light))
  98      (:foreground "blue4"))
  99     (t
 100      ()))
 101   "Face used for displaying the string."
 102   :group 'epa-faces)
 103 (defvar epa-string-face 'epa-string-face)
 104
 105 (defface epa-mark-face
 106   '((((class color) (background dark))
 107      (:foreground "orange" :bold t))
 108     (t
 109      (:foreground "red" :bold t)))
 110   "Face used for displaying the high validity."
 111   :group 'epa-faces)
 112 (defvar epa-mark-face 'epa-mark-face)
 113
 114 (defface epa-field-name-face
 115   '((((class color) (background dark))
 116      (:foreground "PaleTurquoise" :bold t))
 117     (t (:bold t)))
 118   "Face for the name of the attribute field."
 119   :group 'epa)
 120 (defvar epa-field-name-face 'epa-field-name-face)
 121
 122 (defface epa-field-body-face
 123   '((((class color) (background dark))
 124      (:foreground "turquoise" :italic t))
 125     (t (:italic t)))
 126   "Face for the body of the attribute field."
 127   :group 'epa)
 128 (defvar epa-field-body-face 'epa-field-body-face)
 129
 130 (defcustom epa-validity-face-alist
 131   '((unknown . epa-validity-disabled-face)
 132     (invalid . epa-validity-disabled-face)
 133     (disabled . epa-validity-disabled-face)
 134     (revoked . epa-validity-disabled-face)
 135     (expired . epa-validity-disabled-face)
 136     (none . epa-validity-low-face)
 137     (undefined . epa-validity-low-face)
 138     (never . epa-validity-low-face)
 139     (marginal . epa-validity-medium-face)
 140     (full . epa-validity-high-face)
 141     (ultimate . epa-validity-high-face))
 142   "An alist mapping validity values to faces."
 143   :type 'list
 144   :group 'epa)
 145
 146 (defcustom epa-font-lock-keywords
 147   '(("^\\*"
 148      (0 epa-mark-face))
 149     ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
 150      (1 epa-field-name-face)
 151      (2 epa-field-body-face)))
 152   "Default expressions to addon in epa-mode."
 153   :type '(repeat (list string))
 154   :group 'epa)
 155
 156 (defconst epa-pubkey-algorithm-letter-alist
 157   '((1 . ?R)
 158     (2 . ?r)
 159     (3 . ?s)
 160     (16 . ?g)
 161     (17 . ?D)
 162     (20 . ?G)))
 163
 164 (defvar epa-keys-buffer nil)
 165 (defvar epa-key-buffer-alist nil)
 166 (defvar epa-key nil)
 167 (defvar epa-list-keys-arguments nil)
 168
 169 (defvar epa-keys-mode-map
 170   (let ((keymap (make-sparse-keymap)))
 171     (define-key keymap "m" 'epa-mark)
 172     (define-key keymap "u" 'epa-unmark)
 173     (define-key keymap "d" 'epa-decrypt-file)
 174     (define-key keymap "v" 'epa-verify-file)
 175     (define-key keymap "s" 'epa-sign-file)
 176     (define-key keymap "S" 'epa-sign-keys)
 177     (define-key keymap "e" 'epa-encrypt-file)
 178     (define-key keymap "r" 'epa-delete-keys)
 179     (define-key keymap "i" 'epa-import-keys)
 180     (define-key keymap "o" 'epa-export-keys)
 181     (define-key keymap "g" 'epa-list-keys)
 182     (define-key keymap "n" 'next-line)
 183     (define-key keymap "p" 'previous-line)
 184     (define-key keymap " " 'scroll-up)
 185     (define-key keymap [delete] 'scroll-down)
 186     (define-key keymap "q" 'epa-exit-buffer)
 187     keymap))
 188
 189 (defvar epa-exit-buffer-function #'bury-buffer)
 190
 191 (define-widget 'epa-key 'push-button
 192   "Button for representing a epg-key object."
 193   :format "%[%v%]"
 194   :button-face-get 'epa-key-widget-button-face-get
 195   :value-create 'epa-key-widget-value-create
 196   :action 'epa-key-widget-action
 197   :help-echo 'epa-key-widget-help-echo)
 198
 199 (defun epa-key-widget-action (widget &optional event)
 200   (epa-show-key (widget-get widget :value)))
 201
 202 (defun epa-key-widget-value-create (widget)
 203   (let* ((key (widget-get widget :value))
 204          (primary-sub-key (car (epg-key-sub-key-list key)))
 205          (primary-user-id (car (epg-key-user-id-list key))))
 206     (insert (format "%c "
 207                     (if (epg-sub-key-validity primary-sub-key)
 208                         (car (rassq (epg-sub-key-validity primary-sub-key)
 209                                     epg-key-validity-alist))
 210                       ? ))
 211             (epg-sub-key-id primary-sub-key)
 212             " "
 213             (if (stringp (epg-user-id-string primary-user-id))
 214                 (epg-user-id-string primary-user-id)
 215               (epg-decode-dn (epg-user-id-string primary-user-id))))))
 216
 217 (defun epa-key-widget-button-face-get (widget)
 218   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
 219                                               (widget-get widget :value))))))
 220     (if validity
 221         (cdr (assq validity epa-validity-face-alist))
 222       'default)))
 223
 224 (defun epa-key-widget-help-echo (widget)
 225   (format "Show %s"
 226           (epg-sub-key-id (car (epg-key-sub-key-list
 227                                 (widget-get widget :value))))))
 228
 229 (defun epa--temp-buffer-show-function (buffer)
 230   (save-selected-window
 231     (let ((window (or (get-buffer-window buffer)
 232                       (progn
 233                         (select-window (get-largest-window))
 234                         (split-window-vertically)))))
 235       (set-window-buffer window buffer)
 236       (if window
 237           (select-window window))
 238       (unless (pos-visible-in-window-p (point-max))
 239         (enlarge-window (- epa-info-window-height (window-height))))
 240       (let ((height (window-height)))
 241         (if (> height epa-info-window-height)
 242             (shrink-window (- height epa-info-window-height)))
 243         (set-window-start window (point-min)))
 244       (with-current-buffer buffer
 245         (setq buffer-read-only t)))))
 246
 247 (defun epa-display-verify-result (verify-result)
 248   (if epa-popup-info-window
 249       (let ((temp-buffer-show-function #'epa--temp-buffer-show-function))
 250         (with-output-to-temp-buffer "*Info*"
 251           (save-excursion
 252             (set-buffer standard-output)
 253             (insert (epg-verify-result-to-string verify-result)))))
 254     (message "%s" (epg-verify-result-to-string verify-result))))
 255
 256 (defun epa-keys-mode ()
 257   "Major mode for `epa-list-keys'."
 258   (kill-all-local-variables)
 259   (buffer-disable-undo)
 260   (setq major-mode 'epa-keys-mode
 261         mode-name "Keys"
 262         truncate-lines t
 263         buffer-read-only t)
 264   (use-local-map epa-keys-mode-map)
 265   (set-keymap-parent (current-local-map) widget-keymap)
 266   (make-local-variable 'font-lock-defaults)
 267   (setq font-lock-defaults '(epa-font-lock-keywords t))
 268   ;; In XEmacs, auto-initialization of font-lock is not effective
 269   ;; if buffer-file-name is not set.
 270   (font-lock-set-defaults)
 271   (widget-setup)
 272   (make-local-variable 'epa-exit-buffer-function)
 273   (run-hooks 'epa-keys-mode-hook))
 274
 275 (defvar epa-key-mode-map
 276   (let ((keymap (make-sparse-keymap)))
 277     (define-key keymap "q" 'bury-buffer)
 278     keymap))
 279
 280 (defun epa-key-mode ()
 281   "Major mode for `epa-show-key'."
 282   (kill-all-local-variables)
 283   (buffer-disable-undo)
 284   (setq major-mode 'epa-key-mode
 285         mode-name "Key"
 286         truncate-lines t
 287         buffer-read-only t)
 288   (use-local-map epa-key-mode-map)
 289   (make-local-variable 'font-lock-defaults)
 290   (setq font-lock-defaults '(epa-font-lock-keywords t))
 291   ;; In XEmacs, auto-initialization of font-lock is not effective
 292   ;; if buffer-file-name is not set.
 293   (font-lock-set-defaults)
 294   (make-local-variable 'epa-exit-buffer-function)
 295   (run-hooks 'epa-key-mode-hook))
 296
 297 ;;;###autoload
 298 (defun epa-list-keys (&optional name mode protocol)
 299   (interactive
 300    (if current-prefix-arg
 301        (let ((name (read-string "Pattern: "
 302                                 (if epa-list-keys-arguments
 303                                     (car epa-list-keys-arguments)))))
 304          (list (if (equal name "") nil name)
 305                (y-or-n-p "Secret keys? ")
 306                (intern (completing-read "Protocol? "
 307                                         '(("OpenPGP") ("CMS"))
 308                                         nil t))))
 309      (or epa-list-keys-arguments (list nil nil nil))))
 310   (unless (and epa-keys-buffer
 311                (buffer-live-p epa-keys-buffer))
 312     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 313   (set-buffer epa-keys-buffer)
 314   (let ((inhibit-read-only t)
 315         buffer-read-only
 316         (point (point-min))
 317         (context (epg-make-context protocol)))
 318     (unless (get-text-property point 'epa-list-keys)
 319       (setq point (next-single-property-change point 'epa-list-keys)))
 320     (when point
 321       (delete-region point
 322                      (or (next-single-property-change point 'epa-list-keys)
 323                          (point-max)))
 324       (goto-char point))
 325     (epa-insert-keys context name mode)
 326     (epa-keys-mode))
 327   (make-local-variable 'epa-list-keys-arguments)
 328   (setq epa-list-keys-arguments (list name mode protocol))
 329   (goto-char (point-min))
 330   (pop-to-buffer (current-buffer)))
 331
 332 (defun epa-insert-keys (context name mode)
 333   (save-excursion
 334     (save-restriction
 335       (narrow-to-region (point) (point))
 336       (let ((keys (epg-list-keys context name mode))
 337             point)
 338         (while keys
 339           (setq point (point))
 340           (insert "  ")
 341           (add-text-properties point (point)
 342                                (list 'epa-key (car keys)
 343                                      'front-sticky nil
 344                                      'rear-nonsticky t
 345                                      'start-open t
 346                                      'end-open t))
 347           (widget-create 'epa-key :value (car keys))
 348           (insert "\n")
 349           (setq keys (cdr keys))))
 350       (add-text-properties (point-min) (point-max)
 351                            (list 'epa-list-keys t
 352                                  'front-sticky nil
 353                                  'rear-nonsticky t
 354                                  'start-open t
 355                                  'end-open t)))))
 356
 357 (defun epa-marked-keys ()
 358   (or (save-excursion
 359         (set-buffer epa-keys-buffer)
 360         (goto-char (point-min))
 361         (let (keys key)
 362           (while (re-search-forward "^\\*" nil t)
 363             (if (setq key (get-text-property (match-beginning 0)
 364                                              'epa-key))
 365                 (setq keys (cons key keys))))
 366           (nreverse keys)))
 367       (save-excursion
 368         (beginning-of-line)
 369         (let ((key (get-text-property (point) 'epa-key)))
 370           (if key
 371               (list key))))))
 372
 373 ;;;###autoload
 374 (defun epa-select-keys (context prompt &optional names secret)
 375   "Display a user's keyring and ask him to select keys.
 376 CONTEXT is an epg-context.
 377 PROMPT is a string to prompt with.
 378 NAMES is a list of strings to be matched with keys.  If it is nil, all
 379 the keys are listed.
 380 If SECRET is non-nil, list secret keys instead of public keys."
 381   (save-excursion
 382     (unless (and epa-keys-buffer
 383                  (buffer-live-p epa-keys-buffer))
 384       (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 385     (let ((inhibit-read-only t)
 386           buffer-read-only
 387           point)
 388       (set-buffer epa-keys-buffer)
 389       (erase-buffer)
 390       (insert prompt "\n")
 391       (widget-create 'link
 392                      :notify (lambda (&rest ignore) (abort-recursive-edit))
 393                      :help-echo
 394                      (substitute-command-keys
 395                       "Click here or \\[abort-recursive-edit] to cancel")
 396                      "Cancel")
 397       (widget-create 'link
 398                      :notify (lambda (&rest ignore) (exit-recursive-edit))
 399                      :help-echo
 400                      (substitute-command-keys
 401                       "Click here or \\[exit-recursive-edit] to finish")
 402                      "OK")
 403       (insert "\n\n")
 404       (if names
 405           (while names
 406             (setq point (point))
 407             (epa-insert-keys context (car names) secret)
 408             (goto-char point)
 409             (epa-mark)
 410             (goto-char (point-max))
 411             (setq names (cdr names)))
 412         (epa-insert-keys context nil secret))
 413       (epa-keys-mode)
 414       (setq epa-exit-buffer-function #'abort-recursive-edit)
 415       (goto-char (point-min))
 416       (pop-to-buffer (current-buffer)))
 417     (unwind-protect
 418           (progn
 419             (recursive-edit)
 420             (epa-marked-keys))
 421         (if (get-buffer-window epa-keys-buffer)
 422             (delete-window (get-buffer-window epa-keys-buffer)))
 423         (kill-buffer epa-keys-buffer))))
 424
 425 (defun epa-show-key (key)
 426   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 427          (entry (assoc (epg-sub-key-id primary-sub-key)
 428                        epa-key-buffer-alist))
 429          (inhibit-read-only t)
 430          buffer-read-only
 431          pointer)
 432     (unless entry
 433       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 434             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 435     (unless (and (cdr entry)
 436                  (buffer-live-p (cdr entry)))
 437       (setcdr entry (generate-new-buffer
 438                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 439     (set-buffer (cdr entry))
 440     (make-local-variable 'epa-key)
 441     (setq epa-key key)
 442     (erase-buffer)
 443     (setq pointer (epg-key-user-id-list key))
 444     (while pointer
 445       (insert " "
 446               (if (epg-user-id-validity (car pointer))
 447                   (char-to-string
 448                    (car (rassq (epg-user-id-validity (car pointer))
 449                                epg-key-validity-alist)))
 450                 " ")
 451               " "
 452               (if (stringp (epg-user-id-string (car pointer)))
 453                   (epg-user-id-string (car pointer))
 454                 (epg-decode-dn (epg-user-id-string (car pointer))))
 455               "\n")
 456       (setq pointer (cdr pointer)))
 457     (setq pointer (epg-key-sub-key-list key))
 458     (while pointer
 459       (insert " "
 460               (if (epg-sub-key-validity (car pointer))
 461                   (char-to-string
 462                    (car (rassq (epg-sub-key-validity (car pointer))
 463                                epg-key-validity-alist)))
 464                 " ")
 465               " "
 466               (epg-sub-key-id (car pointer))
 467               " "
 468               (format "%dbits"
 469                       (epg-sub-key-length (car pointer)))
 470               " "
 471               (cdr (assq (epg-sub-key-algorithm (car pointer))
 472                          epg-pubkey-algorithm-alist))
 473               "\n\tCreated: "
 474               (epg-sub-key-creation-time (car pointer))
 475               (if (epg-sub-key-expiration-time (car pointer))
 476                   (format "\n\tExpires: %s" (epg-sub-key-expiration-time
 477                                              (car pointer)))
 478                 "")
 479               "\n\tCapabilities: "
 480               (mapconcat #'symbol-name
 481                          (epg-sub-key-capability (car pointer))
 482                          " ")
 483               "\n\tFingerprint: "
 484               (epg-sub-key-fingerprint (car pointer))
 485               "\n")
 486       (setq pointer (cdr pointer)))
 487     (goto-char (point-min))
 488     (pop-to-buffer (current-buffer))
 489     (epa-key-mode)))
 490
 491 (defun epa-show-key-notify (widget &rest ignore)
 492   (epa-show-key (widget-get widget :value)))
 493
 494 (defun epa-mark (&optional arg)
 495   "Mark the current line.
 496 If ARG is non-nil, unmark the current line."
 497   (interactive "P")
 498   (let ((inhibit-read-only t)
 499         buffer-read-only
 500         properties)
 501     (beginning-of-line)
 502     (setq properties (text-properties-at (point)))
 503     (delete-char 1)
 504     (insert (if arg " " "*"))
 505     (set-text-properties (1- (point)) (point) properties)
 506     (forward-line)))
 507
 508 (defun epa-unmark (&optional arg)
 509   "Unmark the current line.
 510 If ARG is non-nil, mark the current line."
 511   (interactive "P")
 512   (epa-mark (not arg)))
 513
 514 (defun epa-exit-buffer ()
 515   "Exit the current buffer.
 516 `epa-exit-buffer-function' is called if it is set."
 517   (interactive)
 518   (funcall epa-exit-buffer-function))
 519
 520 ;;;###autoload
 521 (defun epa-decrypt-file (file)
 522   "Decrypt FILE."
 523   (interactive "fFile: ")
 524   (let* ((default-name (file-name-sans-extension file))
 525          (plain (expand-file-name
 526                  (read-file-name
 527                   (concat "To file (default "
 528                           (file-name-nondirectory default-name)
 529                           ") ")
 530                   (file-name-directory default-name)
 531                   default-name)))
 532          (context (epg-make-context)))
 533     (message "Decrypting %s..." (file-name-nondirectory file))
 534     (epg-decrypt-file context file plain)
 535     (message "Decrypting %s...done" (file-name-nondirectory file))
 536     (if (epg-context-result-for context 'verify)
 537         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 538
 539 ;;;###autoload
 540 (defun epa-verify-file (file)
 541   "Verify FILE."
 542   (interactive "fFile: ")
 543   (let* ((context (epg-make-context))
 544          (plain (if (equal (file-name-extension file) "sig")
 545                     (file-name-sans-extension file))))
 546     (message "Verifying %s..." (file-name-nondirectory file))
 547     (epg-verify-file context file plain)
 548     (message "Verifying %s...done" (file-name-nondirectory file))
 549     (if (epg-context-result-for context 'verify)
 550         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 551
 552 ;;;###autoload
 553 (defun epa-sign-file (file signers mode)
 554   "Sign FILE by SIGNERS keys selected."
 555   (interactive
 556    (list (expand-file-name (read-file-name "File: "))
 557          (epa-select-keys (epg-make-context) "Select keys for signing.
 558 If no one is selected, default secret key is used.  "
 559                           nil t)
 560          (if (y-or-n-p "Make a detached signature? ")
 561              'detached
 562            (if (y-or-n-p "Make a cleartext signature? ")
 563                'clear))))
 564   (let ((signature (concat file
 565                            (if (or epa-armor
 566                                    (not (memq mode '(nil t normal detached))))
 567                                ".asc"
 568                              (if (memq mode '(t detached))
 569                                  ".sig"
 570                                ".gpg"))))
 571         (context (epg-make-context)))
 572     (epg-context-set-armor context epa-armor)
 573     (epg-context-set-textmode context epa-textmode)
 574     (epg-context-set-signers context signers)
 575     (message "Signing %s..." (file-name-nondirectory file))
 576     (epg-sign-file context file signature mode)
 577     (message "Signing %s...done" (file-name-nondirectory file))))
 578
 579 ;;;###autoload
 580 (defun epa-encrypt-file (file recipients)
 581   "Encrypt FILE for RECIPIENTS."
 582   (interactive
 583    (list (expand-file-name (read-file-name "File: "))
 584          (epa-select-keys (epg-make-context) "Select recipents for encryption.
 585 If no one is selected, symmetric encryption will be performed.  ")))
 586   (let ((cipher (concat file (if epa-armor ".asc" ".gpg")))
 587         (context (epg-make-context)))
 588     (epg-context-set-armor context epa-armor)
 589     (epg-context-set-textmode context epa-textmode)
 590     (message "Encrypting %s..." (file-name-nondirectory file))
 591     (epg-encrypt-file context file recipients cipher)
 592     (message "Encrypting %s...done" (file-name-nondirectory file))))
 593
 594 ;;;###autoload
 595 (defun epa-decrypt-region (start end)
 596   "Decrypt the current region between START and END.
 597
 598 Don't use this command in Lisp programs!"
 599   (interactive "r")
 600   (save-excursion
 601     (let ((context (epg-make-context))
 602           plain)
 603       (message "Decrypting...")
 604       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 605       (message "Decrypting...done")
 606       (delete-region start end)
 607       (goto-char start)
 608       (insert (decode-coding-string plain coding-system-for-read))
 609       (if (epg-context-result-for context 'verify)
 610           (epa-display-verify-result (epg-context-result-for context 'verify))))))
 611
 612 ;;;###autoload
 613 (defun epa-decrypt-armor-in-region (start end)
 614   "Decrypt OpenPGP armors in the current region between START and END.
 615
 616 Don't use this command in Lisp programs!"
 617   (interactive "r")
 618   (save-excursion
 619     (save-restriction
 620       (narrow-to-region start end)
 621       (goto-char start)
 622       (let (armor-start armor-end charset coding-system)
 623         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 624           (setq armor-start (match-beginning 0)
 625                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 626                                              nil t))
 627           (unless armor-end
 628             (error "No armor tail"))
 629           (goto-char armor-start)
 630           (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 631               (setq charset (match-string 1)))
 632           (if coding-system-for-read
 633               (setq coding-system coding-system-for-read)
 634             (if charset
 635                 (setq coding-system (intern (downcase charset)))
 636               (setq coding-system 'utf-8)))
 637           (let ((coding-system-for-read coding-system))
 638             (epa-decrypt-region start end)))))))
 639
 640 ;;;###autoload
 641 (defun epa-verify-region (start end)
 642   "Verify the current region between START and END.
 643
 644 Don't use this command in Lisp programs!"
 645   (interactive "r")
 646   (let ((context (epg-make-context)))
 647     (epg-verify-string context
 648                        (encode-coding-string
 649                         (buffer-substring start end)
 650                         coding-system-for-write))
 651     (if (epg-context-result-for context 'verify)
 652         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 653
 654 ;;;###autoload
 655 (defun epa-verify-armor-in-region (start end)
 656   "Verify OpenPGP armors in the current region between START and END.
 657
 658 Don't use this command in Lisp programs!"
 659   (interactive "r")
 660   (save-excursion
 661     (save-restriction
 662       (narrow-to-region start end)
 663       (goto-char start)
 664       (let (armor-start armor-end)
 665         (while (re-search-forward "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----$"
 666                                   nil t)
 667           (setq armor-start (match-beginning 0))
 668           (if (match-beginning 1)       ;cleartext signed message
 669               (progn
 670                 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 671                                            nil t)
 672                   (error "Invalid cleartext signed message"))
 673                 (setq armor-end (re-search-forward
 674                                  "^-----END PGP SIGNATURE-----$"
 675                                  nil t)))
 676             (setq armor-end (re-search-forward
 677                              "^-----END PGP MESSAGE-----$"
 678                              nil t)))
 679           (unless armor-end
 680             (error "No armor tail"))
 681           (epa-verify-region armor-start armor-end))))))
 682
 683 ;;;###autoload
 684 (defun epa-sign-region (start end signers mode)
 685   "Sign the current region between START and END by SIGNERS keys selected.
 686
 687 Don't use this command in Lisp programs!"
 688   (interactive
 689    (list (region-beginning) (region-end)
 690          (epa-select-keys (epg-make-context) "Select keys for signing.
 691 If no one is selected, default secret key is used.  "
 692                           nil t)
 693          (if (y-or-n-p "Make a detached signature? ")
 694              'detached
 695            (if (y-or-n-p "Make a cleartext signature? ")
 696                'clear))))
 697   (save-excursion
 698     (let ((context (epg-make-context))
 699           signature)
 700       (epg-context-set-armor context epa-armor)
 701       (epg-context-set-textmode context epa-textmode)
 702       (epg-context-set-signers context signers)
 703       (message "Signing...")
 704       (setq signature (epg-sign-string context
 705                                        (encode-coding-string
 706                                         (buffer-substring start end)
 707                                         coding-system-for-write)
 708                                        mode))
 709       (message "Signing...done")
 710       (delete-region start end)
 711       (insert (decode-coding-string signature coding-system-for-read)))))
 712
 713 ;;;###autoload
 714 (defun epa-encrypt-region (start end recipients)
 715   "Encrypt the current region between START and END for RECIPIENTS.
 716
 717 Don't use this command in Lisp programs!"
 718   (interactive
 719    (list (region-beginning) (region-end)
 720          (epa-select-keys (epg-make-context) "Select recipents for encryption.
 721 If no one is selected, symmetric encryption will be performed.  ")))
 722   (save-excursion
 723     (let ((context (epg-make-context))
 724           cipher)
 725       (epg-context-set-armor context epa-armor)
 726       (epg-context-set-textmode context epa-textmode)
 727       (message "Encrypting...")
 728       (setq cipher (epg-encrypt-string context
 729                                        (encode-coding-string
 730                                         (buffer-substring start end)
 731                                         coding-system-for-write)
 732                                        recipients))
 733       (message "Encrypting...done")
 734       (delete-region start end)
 735       (insert cipher))))
 736
 737 ;;;###autoload
 738 (defun epa-delete-keys (keys &optional allow-secret)
 739   "Delete selected KEYS."
 740   (interactive
 741    (let ((keys (epa-marked-keys)))
 742      (unless keys
 743        (error "No keys selected"))
 744      (list keys
 745            (eq (nth 1 epa-list-keys-arguments) t))))
 746   (let ((context (epg-make-context)))
 747     (message "Deleting...")
 748     (epg-delete-keys context keys allow-secret)
 749     (message "Deleting...done")
 750     (apply #'epa-list-keys epa-list-keys-arguments)))
 751
 752 ;;;###autoload
 753 (defun epa-import-keys (file)
 754   "Import keys from FILE."
 755   (interactive "fFile: ")
 756   (let ((context (epg-make-context)))
 757     (message "Importing %s..." (file-name-nondirectory file))
 758     (epg-import-keys-from-file context (expand-file-name file))
 759     (message "Importing %s...done" (file-name-nondirectory file))
 760     (apply #'epa-list-keys epa-list-keys-arguments)))
 761
 762 ;;;###autoload
 763 (defun epa-export-keys (keys file)
 764   "Export selected KEYS to FILE."
 765   (interactive
 766    (let ((keys (epa-marked-keys))
 767          default-name)
 768      (unless keys
 769        (error "No keys selected"))
 770      (setq default-name
 771            (expand-file-name
 772             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
 773                     (if epa-armor ".asc" ".gpg"))
 774             default-directory))
 775      (list keys
 776            (expand-file-name
 777             (read-file-name
 778              (concat "To file (default "
 779                      (file-name-nondirectory default-name)
 780                      ") ")
 781              (file-name-directory default-name)
 782              default-name)))))
 783   (let ((context (epg-make-context)))
 784     (epg-context-set-armor context epa-armor)
 785     (message "Exporting to %s..." (file-name-nondirectory file))
 786     (epg-export-keys-to-file context keys file)
 787     (message "Exporting to %s...done" (file-name-nondirectory file))))
 788
 789 ;;;###autoload
 790 (defun epa-sign-keys (keys &optional local)
 791   "Sign selected KEYS.
 792 If LOCAL is non-nil, the signature is marked as non exportable."
 793   (interactive
 794    (let ((keys (epa-marked-keys)))
 795      (unless keys
 796        (error "No keys selected"))
 797      (list keys current-prefix-arg)))
 798   (let ((context (epg-make-context)))
 799     (message "Signing keys...")
 800     (epg-sign-keys context keys local)
 801     (message "Signing keys...done")))
 802
 803 (provide 'epa)
 804
 805 ;;; epa.el ends here