lisp/epa.el

   1 ;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2006-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: PGP, GnuPG
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'epg)
  26 (require 'font-lock)
  27 (require 'widget)
  28 (eval-when-compile (require 'wid-edit))
  29 (require 'derived)
  30
  31 (defgroup epa nil
  32   "The EasyPG Assistant"
  33   :version "23.1"
  34   :link '(custom-manual "(epa) Top")
  35   :group 'epg)
  36
  37 (defcustom epa-replace-original-text 'ask
  38   "Whether the original text shall be replaced by the decrypted.
  39
  40 If t, replace the original text without any confirmation.
  41 If nil, don't replace the original text and show the result in a new buffer.
  42 If neither t nor nil, ask user for confirmation."
  43   :version "26.1"
  44   :type '(choice (const :tag "Never" nil)
  45                  (const :tag "Ask the user" ask)
  46                  (const :tag "Always" t))
  47   :group 'epa)
  48
  49 (defcustom epa-popup-info-window t
  50   "If non-nil, display status information from epa commands in another window."
  51   :type 'boolean
  52   :group 'epa)
  53
  54 (defcustom epa-info-window-height 5
  55   "Number of lines used to display status information."
  56   :type 'integer
  57   :group 'epa)
  58
  59 (defgroup epa-faces nil
  60   "Faces for epa-mode."
  61   :version "23.1"
  62   :group 'epa)
  63
  64 (defcustom epa-mail-aliases nil
  65   "Alist of aliases of email addresses that stand for encryption keys.
  66 Each element is a list of email addresses (ALIAS EXPANSIONS...).
  67 When one of the recipients of a message being encrypted is ALIAS,
  68 instead of encrypting it for ALIAS, encrypt it for EXPANSIONS...
  69
  70 If EXPANSIONS is empty, ignore ALIAS as regards encryption.
  71 This is a handy way to avoid warnings about addresses that you don't
  72 have any key for.
  73
  74 The command `epa-mail-encrypt' uses this."
  75   :type '(repeat (cons (string :tag "Alias") (repeat (string :tag "Expansion"))))
  76   :group 'epa
  77   :version "24.4")
  78
  79 (defface epa-validity-high
  80   '((default :weight bold)
  81     (((class color) (background dark)) :foreground "PaleTurquoise"))
  82   "Face for high validity EPA information."
  83   :group 'epa-faces)
  84
  85 (defface epa-validity-medium
  86   '((default :slant italic)
  87     (((class color) (background dark)) :foreground "PaleTurquoise"))
  88   "Face for medium validity EPA information."
  89   :group 'epa-faces)
  90
  91 (defface epa-validity-low
  92   '((t :slant italic))
  93   "Face used for displaying the low validity."
  94   :group 'epa-faces)
  95
  96 (defface epa-validity-disabled
  97   '((t :slant italic :inverse-video t))
  98   "Face used for displaying the disabled validity."
  99   :group 'epa-faces)
 100
 101 (defface epa-string
 102   '((((class color) (background dark))
 103      :foreground "lightyellow")
 104     (((class color) (background light))
 105      :foreground "blue4"))
 106   "Face used for displaying the string."
 107   :group 'epa-faces)
 108
 109 (defface epa-mark
 110   '((default :weight bold)
 111     (((class color) (background dark))  :foreground "orange")
 112     (((class color) (background light)) :foreground "red"))
 113   "Face used for displaying the high validity."
 114   :group 'epa-faces)
 115
 116 (defface epa-field-name
 117   '((default :weight bold)
 118     (((class color) (background dark)) :foreground "PaleTurquoise"))
 119   "Face for the name of the attribute field."
 120   :group 'epa)
 121
 122 (defface epa-field-body
 123   '((default :slant italic)
 124     (((class color) (background dark)) :foreground "turquoise"))
 125   "Face for the body of the attribute field."
 126   :group 'epa)
 127
 128 (defcustom epa-validity-face-alist
 129   '((unknown . epa-validity-disabled)
 130     (invalid . epa-validity-disabled)
 131     (disabled . epa-validity-disabled)
 132     (revoked . epa-validity-disabled)
 133     (expired . epa-validity-disabled)
 134     (none . epa-validity-low)
 135     (undefined . epa-validity-low)
 136     (never . epa-validity-low)
 137     (marginal . epa-validity-medium)
 138     (full . epa-validity-high)
 139     (ultimate . epa-validity-high))
 140   "An alist mapping validity values to faces."
 141   :type '(repeat (cons symbol face))
 142   :group 'epa)
 143
 144 (defvar epa-font-lock-keywords
 145   '(("^\\*"
 146      (0 'epa-mark))
 147     ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
 148      (1 'epa-field-name)
 149      (2 'epa-field-body)))
 150   "Default expressions to addon in epa-mode.")
 151
 152 (defconst epa-pubkey-algorithm-letter-alist
 153   '((1 . ?R)
 154     (2 . ?r)
 155     (3 . ?s)
 156     (16 . ?g)
 157     (17 . ?D)
 158     (20 . ?G)))
 159
 160 (defvar epa-protocol 'OpenPGP
 161   "The default protocol.
 162 The value can be either OpenPGP or CMS.
 163
 164 You should bind this variable with `let', but do not set it globally.")
 165
 166 (defvar epa-armor nil
 167   "If non-nil, epa commands create ASCII armored output.
 168
 169 You should bind this variable with `let', but do not set it globally.")
 170
 171 (defvar epa-textmode nil
 172   "If non-nil, epa commands treat input files as text.
 173
 174 You should bind this variable with `let', but do not set it globally.")
 175
 176 (defvar epa-keys-buffer nil)
 177 (defvar epa-key-buffer-alist nil)
 178 (defvar epa-key nil)
 179 (defvar epa-list-keys-arguments nil)
 180 (defvar epa-info-buffer nil)
 181 (defvar epa-error-buffer nil)
 182 (defvar epa-last-coding-system-specified nil)
 183
 184 (defvar epa-key-list-mode-map
 185   (let ((keymap (make-sparse-keymap))
 186         (menu-map (make-sparse-keymap)))
 187     (define-key keymap "m" 'epa-mark-key)
 188     (define-key keymap "u" 'epa-unmark-key)
 189     (define-key keymap "d" 'epa-decrypt-file)
 190     (define-key keymap "v" 'epa-verify-file)
 191     (define-key keymap "s" 'epa-sign-file)
 192     (define-key keymap "e" 'epa-encrypt-file)
 193     (define-key keymap "r" 'epa-delete-keys)
 194     (define-key keymap "i" 'epa-import-keys)
 195     (define-key keymap "o" 'epa-export-keys)
 196     (define-key keymap "g" 'revert-buffer)
 197     (define-key keymap "n" 'next-line)
 198     (define-key keymap "p" 'previous-line)
 199     (define-key keymap " " 'scroll-up-command)
 200     (define-key keymap [?\S-\ ] 'scroll-down-command)
 201     (define-key keymap [delete] 'scroll-down-command)
 202     (define-key keymap "q" 'epa-exit-buffer)
 203     (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
 204     (define-key menu-map [epa-key-list-unmark-key]
 205       '(menu-item "Unmark Key" epa-unmark-key
 206                   :help "Unmark a key"))
 207     (define-key menu-map [epa-key-list-mark-key]
 208       '(menu-item "Mark Key" epa-mark-key
 209                   :help "Mark a key"))
 210     (define-key menu-map [separator-epa-file] '(menu-item "--"))
 211     (define-key menu-map [epa-verify-file]
 212       '(menu-item "Verify File..." epa-verify-file
 213                   :help "Verify FILE"))
 214     (define-key menu-map [epa-sign-file]
 215       '(menu-item "Sign File..." epa-sign-file
 216                   :help "Sign FILE by SIGNERS keys selected"))
 217     (define-key menu-map [epa-decrypt-file]
 218       '(menu-item "Decrypt File..." epa-decrypt-file
 219                   :help "Decrypt FILE"))
 220     (define-key menu-map [epa-encrypt-file]
 221       '(menu-item "Encrypt File..." epa-encrypt-file
 222                   :help "Encrypt FILE for RECIPIENTS"))
 223     (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
 224     (define-key menu-map [epa-key-list-delete-keys]
 225       '(menu-item "Delete Keys" epa-delete-keys
 226                   :help "Delete Marked Keys"))
 227     (define-key menu-map [epa-key-list-import-keys]
 228       '(menu-item "Import Keys" epa-import-keys
 229                   :help "Import keys from a file"))
 230     (define-key menu-map [epa-key-list-export-keys]
 231       '(menu-item "Export Keys" epa-export-keys
 232                   :help "Export marked keys to a file"))
 233     keymap))
 234
 235 (defvar epa-key-mode-map
 236   (let ((keymap (make-sparse-keymap)))
 237     (define-key keymap "q" 'epa-exit-buffer)
 238     keymap))
 239
 240 (defvar epa-info-mode-map
 241   (let ((keymap (make-sparse-keymap)))
 242     (define-key keymap "q" 'delete-window)
 243     keymap))
 244
 245 (defvar epa-exit-buffer-function #'quit-window)
 246
 247 (define-widget 'epa-key 'push-button
 248   "Button for representing an epg-key object."
 249   :format "%[%v%]"
 250   :button-face-get 'epa--key-widget-button-face-get
 251   :value-create 'epa--key-widget-value-create
 252   :action 'epa--key-widget-action
 253   :help-echo 'epa--key-widget-help-echo)
 254
 255 (defun epa--key-widget-action (widget &optional _event)
 256   (save-selected-window
 257     (epa--show-key (widget-get widget :value))))
 258
 259 (defun epa--key-widget-value-create (widget)
 260   (let* ((key (widget-get widget :value))
 261          (primary-sub-key (car (epg-key-sub-key-list key)))
 262          (primary-user-id (car (epg-key-user-id-list key))))
 263     (insert (format "%c "
 264                     (if (epg-sub-key-validity primary-sub-key)
 265                         (car (rassq (epg-sub-key-validity primary-sub-key)
 266                                     epg-key-validity-alist))
 267                       ? ))
 268             (epg-sub-key-id primary-sub-key)
 269             " "
 270             (if primary-user-id
 271                 (if (stringp (epg-user-id-string primary-user-id))
 272                     (epg-user-id-string primary-user-id)
 273                   (epg-decode-dn (epg-user-id-string primary-user-id)))
 274               ""))))
 275
 276 (defun epa--key-widget-button-face-get (widget)
 277   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
 278                                               (widget-get widget :value))))))
 279     (if validity
 280         (cdr (assq validity epa-validity-face-alist))
 281       'default)))
 282
 283 (defun epa--key-widget-help-echo (widget)
 284   (format "Show %s"
 285           (epg-sub-key-id (car (epg-key-sub-key-list
 286                                 (widget-get widget :value))))))
 287
 288 (define-derived-mode epa-key-list-mode special-mode "Keys"
 289   "Major mode for `epa-list-keys'."
 290   (buffer-disable-undo)
 291   (setq truncate-lines t
 292         buffer-read-only t)
 293   (setq-local font-lock-defaults '(epa-font-lock-keywords t))
 294   ;; In XEmacs, auto-initialization of font-lock is not effective
 295   ;; if buffer-file-name is not set.
 296   (font-lock-set-defaults)
 297   (make-local-variable 'epa-exit-buffer-function)
 298   (setq-local revert-buffer-function #'epa--key-list-revert-buffer))
 299
 300 (define-derived-mode epa-key-mode special-mode "Key"
 301   "Major mode for a key description."
 302   (buffer-disable-undo)
 303   (setq truncate-lines t
 304         buffer-read-only t)
 305   (setq-local font-lock-defaults '(epa-font-lock-keywords t))
 306   ;; In XEmacs, auto-initialization of font-lock is not effective
 307   ;; if buffer-file-name is not set.
 308   (font-lock-set-defaults)
 309   (make-local-variable 'epa-exit-buffer-function))
 310
 311 (define-derived-mode epa-info-mode special-mode "Info"
 312   "Major mode for `epa-info-buffer'."
 313   (buffer-disable-undo)
 314   (setq truncate-lines t
 315         buffer-read-only t))
 316
 317 (defun epa-mark-key (&optional arg)
 318   "Mark a key on the current line.
 319 If ARG is non-nil, unmark the key."
 320   (interactive "P")
 321   (let ((inhibit-read-only t)
 322         buffer-read-only
 323         properties)
 324     (beginning-of-line)
 325     (unless (get-text-property (point) 'epa-key)
 326       (error "No key on this line"))
 327     (setq properties (text-properties-at (point)))
 328     (delete-char 1)
 329     (insert (if arg " " "*"))
 330     (set-text-properties (1- (point)) (point) properties)
 331     (forward-line)))
 332
 333 (defun epa-unmark-key (&optional arg)
 334   "Unmark a key on the current line.
 335 If ARG is non-nil, mark the key."
 336   (interactive "P")
 337   (epa-mark-key (not arg)))
 338
 339 (defun epa-exit-buffer ()
 340   "Exit the current buffer.
 341 `epa-exit-buffer-function' is called if it is set."
 342   (interactive)
 343   (funcall epa-exit-buffer-function))
 344
 345 (defun epa--insert-keys (keys)
 346   (save-excursion
 347     (save-restriction
 348       (narrow-to-region (point) (point))
 349       (let (point)
 350         (while keys
 351           (setq point (point))
 352           (insert "  ")
 353           (add-text-properties point (point)
 354                                (list 'epa-key (car keys)
 355                                      'front-sticky nil
 356                                      'rear-nonsticky t
 357                                      'start-open t
 358                                      'end-open t))
 359           (widget-create 'epa-key :value (car keys))
 360           (insert "\n")
 361           (setq keys (cdr keys))))
 362       (add-text-properties (point-min) (point-max)
 363                            (list 'epa-list-keys t
 364                                  'front-sticky nil
 365                                  'rear-nonsticky t
 366                                  'start-open t
 367                                  'end-open t)))))
 368
 369 (defun epa--list-keys (name secret)
 370   (unless (and epa-keys-buffer
 371                (buffer-live-p epa-keys-buffer))
 372     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 373   (set-buffer epa-keys-buffer)
 374   (epa-key-list-mode)
 375   (let ((inhibit-read-only t)
 376         buffer-read-only
 377         (point (point-min))
 378         (context (epg-make-context epa-protocol)))
 379     (unless (get-text-property point 'epa-list-keys)
 380       (setq point (next-single-property-change point 'epa-list-keys)))
 381     (when point
 382       (delete-region point
 383                      (or (next-single-property-change point 'epa-list-keys)
 384                          (point-max)))
 385       (goto-char point))
 386     (epa--insert-keys (epg-list-keys context name secret))
 387     (widget-setup)
 388     (set-keymap-parent (current-local-map) widget-keymap))
 389   (make-local-variable 'epa-list-keys-arguments)
 390   (setq epa-list-keys-arguments (list name secret))
 391   (goto-char (point-min))
 392   (pop-to-buffer (current-buffer)))
 393
 394 ;;;###autoload
 395 (defun epa-list-keys (&optional name)
 396   "List all keys matched with NAME from the public keyring."
 397   (interactive
 398    (if current-prefix-arg
 399        (let ((name (read-string "Pattern: "
 400                                 (if epa-list-keys-arguments
 401                                     (car epa-list-keys-arguments)))))
 402          (list (if (equal name "") nil name)))
 403      (list nil)))
 404   (epa--list-keys name nil))
 405
 406 ;;;###autoload
 407 (defun epa-list-secret-keys (&optional name)
 408   "List all keys matched with NAME from the private keyring."
 409   (interactive
 410    (if current-prefix-arg
 411        (let ((name (read-string "Pattern: "
 412                                 (if epa-list-keys-arguments
 413                                     (car epa-list-keys-arguments)))))
 414          (list (if (equal name "") nil name)))
 415      (list nil)))
 416   (epa--list-keys name t))
 417
 418 (defun epa--key-list-revert-buffer (&optional _ignore-auto _noconfirm)
 419   (apply #'epa--list-keys epa-list-keys-arguments))
 420
 421 (defun epa--marked-keys ()
 422   (or (with-current-buffer epa-keys-buffer
 423         (goto-char (point-min))
 424         (let (keys key)
 425           (while (re-search-forward "^\\*" nil t)
 426             (if (setq key (get-text-property (match-beginning 0)
 427                                              'epa-key))
 428                 (setq keys (cons key keys))))
 429           (nreverse keys)))
 430       (let ((key (get-text-property (point-at-bol) 'epa-key)))
 431         (if key
 432             (list key)))))
 433
 434 (defun epa--select-keys (prompt keys)
 435   (unless (and epa-keys-buffer
 436                (buffer-live-p epa-keys-buffer))
 437     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 438   (with-current-buffer epa-keys-buffer
 439     (epa-key-list-mode)
 440     ;; C-c C-c is the usual way to finish the selection (bug#11159).
 441     (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
 442     (let ((inhibit-read-only t)
 443           buffer-read-only)
 444       (erase-buffer)
 445       (insert prompt "\n"
 446               (substitute-command-keys "\
 447 - `\\[epa-mark-key]' to mark a key on the line
 448 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
 449       (widget-create 'link
 450                      :notify (lambda (&rest _ignore) (abort-recursive-edit))
 451                      :help-echo
 452                      "Click here or \\[abort-recursive-edit] to cancel"
 453                      "Cancel")
 454       (widget-create 'link
 455                      :notify (lambda (&rest _ignore) (exit-recursive-edit))
 456                      :help-echo
 457                      "Click here or \\[exit-recursive-edit] to finish"
 458                      "OK")
 459       (insert "\n\n")
 460       (epa--insert-keys keys)
 461       (widget-setup)
 462       (set-keymap-parent (current-local-map) widget-keymap)
 463       (setq epa-exit-buffer-function #'abort-recursive-edit)
 464       (goto-char (point-min))
 465       (let ((display-buffer-mark-dedicated 'soft))
 466         (pop-to-buffer (current-buffer))))
 467     (unwind-protect
 468         (progn
 469           (recursive-edit)
 470           (epa--marked-keys))
 471       (kill-buffer epa-keys-buffer))))
 472
 473 ;;;###autoload
 474 (defun epa-select-keys (context prompt &optional names secret)
 475   "Display a user's keyring and ask him to select keys.
 476 CONTEXT is an epg-context.
 477 PROMPT is a string to prompt with.
 478 NAMES is a list of strings to be matched with keys.  If it is nil, all
 479 the keys are listed.
 480 If SECRET is non-nil, list secret keys instead of public keys."
 481   (let ((keys (epg-list-keys context names secret)))
 482     (epa--select-keys prompt keys)))
 483
 484 (defun epa--show-key (key)
 485   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 486          (entry (assoc (epg-sub-key-id primary-sub-key)
 487                        epa-key-buffer-alist))
 488          (inhibit-read-only t)
 489          buffer-read-only
 490          pointer)
 491     (unless entry
 492       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 493             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 494     (unless (and (cdr entry)
 495                  (buffer-live-p (cdr entry)))
 496       (setcdr entry (generate-new-buffer
 497                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 498     (set-buffer (cdr entry))
 499     (epa-key-mode)
 500     (make-local-variable 'epa-key)
 501     (setq epa-key key)
 502     (erase-buffer)
 503     (setq pointer (epg-key-user-id-list key))
 504     (while pointer
 505       (if (car pointer)
 506           (insert " "
 507                   (if (epg-user-id-validity (car pointer))
 508                       (char-to-string
 509                        (car (rassq (epg-user-id-validity (car pointer))
 510                                    epg-key-validity-alist)))
 511                     " ")
 512                   " "
 513                   (if (stringp (epg-user-id-string (car pointer)))
 514                       (epg-user-id-string (car pointer))
 515                     (epg-decode-dn (epg-user-id-string (car pointer))))
 516                   "\n"))
 517       (setq pointer (cdr pointer)))
 518     (setq pointer (epg-key-sub-key-list key))
 519     (while pointer
 520       (insert " "
 521               (if (epg-sub-key-validity (car pointer))
 522                   (char-to-string
 523                    (car (rassq (epg-sub-key-validity (car pointer))
 524                                epg-key-validity-alist)))
 525                 " ")
 526               " "
 527               (epg-sub-key-id (car pointer))
 528               " "
 529               (format "%dbits"
 530                       (epg-sub-key-length (car pointer)))
 531               " "
 532               (cdr (assq (epg-sub-key-algorithm (car pointer))
 533                          epg-pubkey-algorithm-alist))
 534               "\n\tCreated: "
 535               (condition-case nil
 536                   (format-time-string "%Y-%m-%d"
 537                                       (epg-sub-key-creation-time (car pointer)))
 538                 (error "????-??-??"))
 539               (if (epg-sub-key-expiration-time (car pointer))
 540                   (format (if (time-less-p nil
 541                                            (epg-sub-key-expiration-time
 542                                             (car pointer)))
 543                               "\n\tExpires: %s"
 544                             "\n\tExpired: %s")
 545                           (condition-case nil
 546                               (format-time-string "%Y-%m-%d"
 547                                                   (epg-sub-key-expiration-time
 548                                                    (car pointer)))
 549                             (error "????-??-??")))
 550                 "")
 551               "\n\tCapabilities: "
 552               (mapconcat #'symbol-name
 553                          (epg-sub-key-capability (car pointer))
 554                          " ")
 555               "\n\tFingerprint: "
 556               (epg-sub-key-fingerprint (car pointer))
 557               "\n")
 558       (setq pointer (cdr pointer)))
 559     (goto-char (point-min))
 560     (pop-to-buffer (current-buffer))))
 561
 562 (defun epa-display-info (info)
 563   (if epa-popup-info-window
 564       (save-selected-window
 565         (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
 566           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 567         (if (get-buffer-window epa-info-buffer)
 568             (delete-window (get-buffer-window epa-info-buffer)))
 569         (with-current-buffer epa-info-buffer
 570           (let ((inhibit-read-only t)
 571                 buffer-read-only)
 572             (erase-buffer)
 573             (insert info))
 574           (epa-info-mode)
 575           (goto-char (point-min)))
 576         (if (> (window-height)
 577                epa-info-window-height)
 578             (set-window-buffer (split-window nil (- (window-height)
 579                                                     epa-info-window-height))
 580                                epa-info-buffer)
 581           (pop-to-buffer epa-info-buffer)
 582           (if (> (window-height) epa-info-window-height)
 583               (shrink-window (- (window-height) epa-info-window-height)))))
 584     (message "%s" info)))
 585
 586 (defun epa-display-error (context)
 587   (unless (equal (epg-context-error-output context) "")
 588     (let ((buffer (get-buffer-create "*Error*")))
 589       (save-selected-window
 590         (unless (and epa-error-buffer (buffer-live-p epa-error-buffer))
 591           (setq epa-error-buffer (generate-new-buffer "*Error*")))
 592         (if (get-buffer-window epa-error-buffer)
 593             (delete-window (get-buffer-window epa-error-buffer)))
 594         (with-current-buffer buffer
 595           (let ((inhibit-read-only t)
 596                 buffer-read-only)
 597             (erase-buffer)
 598             (insert (format
 599                      (pcase (epg-context-operation context)
 600                        (`decrypt "Error while decrypting with \"%s\":")
 601                        (`verify "Error while verifying with \"%s\":")
 602                        (`sign "Error while signing with \"%s\":")
 603                        (`encrypt "Error while encrypting with \"%s\":")
 604                        (`import-keys "Error while importing keys with \"%s\":")
 605                        (`export-keys "Error while exporting keys with \"%s\":")
 606                        (_ "Error while executing \"%s\":\n\n"))
 607                      (epg-context-program context))
 608                     "\n\n"
 609                     (epg-context-error-output context)))
 610           (epa-info-mode)
 611           (goto-char (point-min)))
 612         (display-buffer buffer)))))
 613
 614 (defun epa-display-verify-result (verify-result)
 615   (declare (obsolete epa-display-info "23.1"))
 616   (epa-display-info (epg-verify-result-to-string verify-result)))
 617
 618 (defun epa-passphrase-callback-function (context key-id handback)
 619   (if (eq key-id 'SYM)
 620       (read-passwd
 621        (format "Passphrase for symmetric encryption%s: "
 622                ;; Add the file name to the prompt, if any.
 623                (if (stringp handback)
 624                    (format " for %s" handback)
 625                  ""))
 626        (eq (epg-context-operation context) 'encrypt))
 627     (read-passwd
 628      (if (eq key-id 'PIN)
 629          "Passphrase for PIN: "
 630        (let ((entry (assoc key-id epg-user-id-alist)))
 631          (if entry
 632              (format "Passphrase for %s %s: " key-id (cdr entry))
 633            (format "Passphrase for %s: " key-id)))))))
 634
 635 (defun epa-progress-callback-function (_context what _char current total
 636                                                 handback)
 637   (let ((prompt (or handback
 638                     (format "Processing %s: " what))))
 639     ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
 640     ;; the total amount is not known. The condition TOTAL && CUR ==
 641     ;; TOTAL may be used to detect the end of an operation.
 642     (if (> total 0)
 643         (if (= current total)
 644             (message "%s...done" prompt)
 645           (message "%s...%d%%" prompt
 646                    (floor (* 100.0 current) total)))
 647       (message "%s..." prompt))))
 648
 649 (defun epa-read-file-name (input)
 650   "Interactively read an output file name based on INPUT file name."
 651   (setq input (file-name-sans-extension (expand-file-name input)))
 652   (expand-file-name
 653    (read-file-name
 654     (concat "To file (default " (file-name-nondirectory input) ") ")
 655     (file-name-directory input)
 656     input)))
 657
 658 ;;;###autoload
 659 (defun epa-decrypt-file (decrypt-file &optional plain-file)
 660   "Decrypt DECRYPT-FILE into PLAIN-FILE.
 661 If you do not specify PLAIN-FILE, this functions prompts for the value to use."
 662   (interactive
 663    (let* ((file (read-file-name "File to decrypt: "))
 664           (plain (epa-read-file-name file)))
 665      (list file plain)))
 666   (or plain-file (setq plain-file (epa-read-file-name decrypt-file)))
 667   (setq decrypt-file (expand-file-name decrypt-file))
 668   (let ((context (epg-make-context epa-protocol)))
 669     (epg-context-set-passphrase-callback context
 670                                          #'epa-passphrase-callback-function)
 671     (epg-context-set-progress-callback context
 672                                        (cons
 673                                         #'epa-progress-callback-function
 674                                         (format "Decrypting %s..."
 675                                                 (file-name-nondirectory decrypt-file))))
 676     (message "Decrypting %s..." (file-name-nondirectory decrypt-file))
 677     (condition-case error
 678         (epg-decrypt-file context decrypt-file plain-file)
 679       (error
 680        (epa-display-error context)
 681        (signal (car error) (cdr error))))
 682     (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file)
 683              (file-name-nondirectory plain-file))
 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     (condition-case error
 703         (epg-verify-file context file plain)
 704       (error
 705        (epa-display-error context)
 706        (signal (car error) (cdr error))))
 707     (message "Verifying %s...done" (file-name-nondirectory file))
 708     (if (epg-context-result-for context 'verify)
 709         (epa-display-info (epg-verify-result-to-string
 710                            (epg-context-result-for context 'verify))))))
 711
 712 (defun epa--read-signature-type ()
 713   (let (type c)
 714     (while (null type)
 715       (message "Signature type (n,c,d,?) ")
 716       (setq c (read-char))
 717       (cond ((eq c ?c)
 718              (setq type 'clear))
 719             ((eq c ?d)
 720              (setq type 'detached))
 721             ((eq c ??)
 722              (with-output-to-temp-buffer "*Help*"
 723                (with-current-buffer standard-output
 724                  (insert "\
 725 n - Create a normal signature
 726 c - Create a cleartext signature
 727 d - Create a detached signature
 728 ? - Show this help
 729 "))))
 730             (t
 731              (setq type 'normal))))
 732     type))
 733
 734 ;;;###autoload
 735 (defun epa-sign-file (file signers mode)
 736   "Sign FILE by SIGNERS keys selected."
 737   (interactive
 738    (let ((verbose current-prefix-arg))
 739      (list (expand-file-name (read-file-name "File: "))
 740            (if verbose
 741                (epa-select-keys (epg-make-context epa-protocol)
 742                                 "Select keys for signing.
 743 If no one is selected, default secret key is used.  "
 744                                 nil t))
 745            (if verbose
 746                (epa--read-signature-type)
 747              'clear))))
 748   (let ((signature (concat file
 749                            (if (eq epa-protocol 'OpenPGP)
 750                                (if (or epa-armor
 751                                        (not (memq mode
 752                                                   '(nil t normal detached))))
 753                                    ".asc"
 754                                  (if (memq mode '(t detached))
 755                                      ".sig"
 756                                    ".gpg"))
 757                              (if (memq mode '(t detached))
 758                                  ".p7s"
 759                                ".p7m"))))
 760         (context (epg-make-context epa-protocol)))
 761     (setf (epg-context-armor context) epa-armor)
 762     (setf (epg-context-textmode context) epa-textmode)
 763     (setf (epg-context-signers context) signers)
 764     (epg-context-set-passphrase-callback context
 765                                          #'epa-passphrase-callback-function)
 766     (epg-context-set-progress-callback context
 767                                        (cons
 768                                         #'epa-progress-callback-function
 769                                         (format "Signing %s..."
 770                                                 (file-name-nondirectory file))))
 771     (message "Signing %s..." (file-name-nondirectory file))
 772     (condition-case error
 773         (epg-sign-file context file signature mode)
 774       (error
 775        (epa-display-error context)
 776        (signal (car error) (cdr error))))
 777     (message "Signing %s...wrote %s" (file-name-nondirectory file)
 778              (file-name-nondirectory signature))))
 779
 780 ;;;###autoload
 781 (defun epa-encrypt-file (file recipients)
 782   "Encrypt FILE for RECIPIENTS."
 783   (interactive
 784    (list (expand-file-name (read-file-name "File: "))
 785          (epa-select-keys (epg-make-context epa-protocol)
 786                           "Select recipients for encryption.
 787 If no one is selected, symmetric encryption will be performed.  ")))
 788   (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
 789                                  (if epa-armor ".asc" ".gpg")
 790                                ".p7m")))
 791         (context (epg-make-context epa-protocol)))
 792     (setf (epg-context-armor context) epa-armor)
 793     (setf (epg-context-textmode context) epa-textmode)
 794     (epg-context-set-passphrase-callback context
 795                                          #'epa-passphrase-callback-function)
 796     (epg-context-set-progress-callback context
 797                                        (cons
 798                                         #'epa-progress-callback-function
 799                                         (format "Encrypting %s..."
 800                                                 (file-name-nondirectory file))))
 801     (message "Encrypting %s..." (file-name-nondirectory file))
 802     (condition-case error
 803         (epg-encrypt-file context file recipients cipher)
 804       (error
 805        (epa-display-error context)
 806        (signal (car error) (cdr error))))
 807     (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
 808              (file-name-nondirectory cipher))))
 809
 810 ;;;###autoload
 811 (defun epa-decrypt-region (start end &optional make-buffer-function)
 812   "Decrypt the current region between START and END.
 813
 814 If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
 815 It should return that buffer.  If it copies the input, it should
 816 delete the text now being decrypted.  It should leave point at the
 817 proper place to insert the plaintext.
 818
 819 Be careful about using this command in Lisp programs!
 820 Since this function operates on regions, it does some tricks such
 821 as coding-system detection and unibyte/multibyte conversion.  If
 822 you are sure how the data in the region should be treated, you
 823 should consider using the string based counterpart
 824 `epg-decrypt-string', or the file based counterpart
 825 `epg-decrypt-file' instead.
 826
 827 For example:
 828
 829 \(let ((context (epg-make-context \\='OpenPGP)))
 830   (decode-coding-string
 831     (epg-decrypt-string context (buffer-substring start end))
 832     \\='utf-8))"
 833   (interactive "r")
 834   (save-excursion
 835     (let ((context (epg-make-context epa-protocol))
 836           plain)
 837       (epg-context-set-passphrase-callback context
 838                                            #'epa-passphrase-callback-function)
 839       (epg-context-set-progress-callback context
 840                                          (cons
 841                                           #'epa-progress-callback-function
 842                                           "Decrypting..."))
 843       (message "Decrypting...")
 844       (condition-case error
 845           (setq plain (epg-decrypt-string context (buffer-substring start end)))
 846         (error
 847          (epa-display-error context)
 848          (signal (car error) (cdr error))))
 849       (message "Decrypting...done")
 850       (setq plain (decode-coding-string
 851                    plain
 852                    (or coding-system-for-read
 853                        (get-text-property start 'epa-coding-system-used)
 854                        'undecided)))
 855       (if make-buffer-function
 856           (with-current-buffer (funcall make-buffer-function)
 857             (let ((inhibit-read-only t))
 858               (insert plain)))
 859         (if (or (eq epa-replace-original-text t)
 860                 (and epa-replace-original-text
 861                      (y-or-n-p "Replace the original text? ")))
 862             (let ((inhibit-read-only t))
 863               (delete-region start end)
 864               (goto-char start)
 865               (insert plain))
 866           (with-output-to-temp-buffer "*Temp*"
 867             (set-buffer standard-output)
 868             (insert plain)
 869             (epa-info-mode))))
 870       (if (epg-context-result-for context 'verify)
 871           (epa-display-info (epg-verify-result-to-string
 872                              (epg-context-result-for context 'verify)))))))
 873
 874 (defun epa--find-coding-system-for-mime-charset (mime-charset)
 875   (if (featurep 'xemacs)
 876       (if (fboundp 'find-coding-system)
 877           (find-coding-system mime-charset))
 878     ;; Find the first coding system which corresponds to MIME-CHARSET.
 879     (let ((pointer (coding-system-list)))
 880       (while (and pointer
 881                   (not (eq (coding-system-get (car pointer) 'mime-charset)
 882                            mime-charset)))
 883         (setq pointer (cdr pointer)))
 884       (car pointer))))
 885
 886 ;;;###autoload
 887 (defun epa-decrypt-armor-in-region (start end)
 888   "Decrypt OpenPGP armors in the current region between START and END.
 889
 890 Don't use this command in Lisp programs!
 891 See the reason described in the `epa-decrypt-region' documentation."
 892   (declare (interactive-only t))
 893   (interactive "r")
 894   (save-excursion
 895     (save-restriction
 896       (narrow-to-region start end)
 897       (goto-char start)
 898       (let (armor-start armor-end)
 899         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 900           (setq armor-start (match-beginning 0)
 901                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 902                                              nil t))
 903           (unless armor-end
 904             (error "Encryption armor beginning has no matching end"))
 905           (goto-char armor-start)
 906           (let ((coding-system-for-read
 907                  (or coding-system-for-read
 908                      (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 909                          (epa--find-coding-system-for-mime-charset
 910                           (intern (downcase (match-string 1))))))))
 911             (goto-char armor-end)
 912             (epa-decrypt-region armor-start armor-end)))))))
 913
 914 ;;;###autoload
 915 (defun epa-verify-region (start end)
 916   "Verify the current region between START and END.
 917
 918 Don't use this command in Lisp programs!
 919 Since this function operates on regions, it does some tricks such
 920 as coding-system detection and unibyte/multibyte conversion.  If
 921 you are sure how the data in the region should be treated, you
 922 should consider using the string based counterpart
 923 `epg-verify-string', or the file based counterpart
 924 `epg-verify-file' instead.
 925
 926 For example:
 927
 928 \(let ((context (epg-make-context \\='OpenPGP)))
 929   (decode-coding-string
 930     (epg-verify-string context (buffer-substring start end))
 931     \\='utf-8))"
 932   (declare (interactive-only t))
 933   (interactive "r")
 934   (let ((context (epg-make-context epa-protocol))
 935         plain)
 936     (setf (epg-context-progress-callback context)
 937           (cons
 938            #'epa-progress-callback-function
 939            "Verifying..."))
 940     (message "Verifying...")
 941     (condition-case error
 942         (setq plain (epg-verify-string
 943                      context
 944                      (encode-coding-string
 945                       (buffer-substring start end)
 946                       (or coding-system-for-write
 947                           (get-text-property start 'epa-coding-system-used)))))
 948       (error
 949        (epa-display-error context)
 950        (signal (car error) (cdr error))))
 951     (message "Verifying...done")
 952     (setq plain (decode-coding-string
 953                  plain
 954                  (or coding-system-for-read
 955                      (get-text-property start 'epa-coding-system-used)
 956                      'undecided)))
 957     (if (or (eq epa-replace-original-text t)
 958             (and epa-replace-original-text
 959                  (y-or-n-p "Replace the original text? ")))
 960         (let ((inhibit-read-only t)
 961               buffer-read-only)
 962           (delete-region start end)
 963           (goto-char start)
 964           (insert plain))
 965       (with-output-to-temp-buffer "*Temp*"
 966         (set-buffer standard-output)
 967         (insert plain)
 968         (epa-info-mode)))
 969     (if (epg-context-result-for context 'verify)
 970         (epa-display-info (epg-verify-result-to-string
 971                            (epg-context-result-for context 'verify))))))
 972
 973 ;;;###autoload
 974 (defun epa-verify-cleartext-in-region (start end)
 975   "Verify OpenPGP cleartext signed messages in the current region
 976 between START and END.
 977
 978 Don't use this command in Lisp programs!
 979 See the reason described in the `epa-verify-region' documentation."
 980   (declare (interactive-only t))
 981   (interactive "r")
 982   (save-excursion
 983     (save-restriction
 984       (narrow-to-region start end)
 985       (goto-char start)
 986       (let (cleartext-start cleartext-end)
 987         (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
 988                                   nil t)
 989           (setq cleartext-start (match-beginning 0))
 990           (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 991                                      nil t)
 992             (error "Invalid cleartext signed message"))
 993           (setq cleartext-end (re-search-forward
 994                                "^-----END PGP SIGNATURE-----$"
 995                                nil t))
 996           (unless cleartext-end
 997             (error "No cleartext tail"))
 998           (epa-verify-region cleartext-start cleartext-end))))))
 999
1000 ;;;###autoload
1001 (defun epa-sign-region (start end signers mode)
1002   "Sign the current region between START and END by SIGNERS keys selected.
1003
1004 Don't use this command in Lisp programs!
1005 Since this function operates on regions, it does some tricks such
1006 as coding-system detection and unibyte/multibyte conversion.  If
1007 you are sure how the data should be treated, you should consider
1008 using the string based counterpart `epg-sign-string', or the file
1009 based counterpart `epg-sign-file' instead.
1010
1011 For example:
1012
1013 \(let ((context (epg-make-context \\='OpenPGP)))
1014   (epg-sign-string
1015     context
1016     (encode-coding-string (buffer-substring start end) \\='utf-8)))"
1017   (declare (interactive-only t))
1018   (interactive
1019    (let ((verbose current-prefix-arg))
1020      (setq epa-last-coding-system-specified
1021            (or coding-system-for-write
1022                (select-safe-coding-system
1023                 (region-beginning) (region-end))))
1024      (list (region-beginning) (region-end)
1025            (if verbose
1026                (epa-select-keys (epg-make-context epa-protocol)
1027                                 "Select keys for signing.
1028 If no one is selected, default secret key is used.  "
1029                                 nil t))
1030            (if verbose
1031                (epa--read-signature-type)
1032              'clear))))
1033   (save-excursion
1034     (let ((context (epg-make-context epa-protocol))
1035           signature)
1036       ;;(setf (epg-context-armor context) epa-armor)
1037       (setf (epg-context-armor context) t)
1038       ;;(setf (epg-context-textmode context) epa-textmode)
1039       (setf (epg-context-textmode context) t)
1040       (setf (epg-context-signers context) signers)
1041       (epg-context-set-passphrase-callback context
1042                                            #'epa-passphrase-callback-function)
1043       (epg-context-set-progress-callback context
1044                                          (cons
1045                                           #'epa-progress-callback-function
1046                                           "Signing..."))
1047       (message "Signing...")
1048       (condition-case error
1049           (setq signature (epg-sign-string context
1050                                            (encode-coding-string
1051                                             (buffer-substring start end)
1052                                             epa-last-coding-system-specified)
1053                                            mode))
1054         (error
1055          (epa-display-error context)
1056          (signal (car error) (cdr error))))
1057       (message "Signing...done")
1058       (delete-region start end)
1059       (goto-char start)
1060       (add-text-properties (point)
1061                            (progn
1062                              (insert (decode-coding-string
1063                                       signature
1064                                       (or coding-system-for-read
1065                                           epa-last-coding-system-specified)))
1066                              (point))
1067                            (list 'epa-coding-system-used
1068                                  epa-last-coding-system-specified
1069                                  'front-sticky nil
1070                                  'rear-nonsticky t
1071                                  'start-open t
1072                                  'end-open t)))))
1073
1074 (defalias 'epa--derived-mode-p
1075   (if (fboundp 'derived-mode-p)
1076       #'derived-mode-p
1077     (lambda (&rest modes)
1078       "Non-nil if the current major mode is derived from one of MODES.
1079 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1080       (let ((parent major-mode))
1081         (while (and (not (memq parent modes))
1082                     (setq parent (get parent 'derived-mode-parent))))
1083         parent))))
1084
1085 ;;;###autoload
1086 (defun epa-encrypt-region (start end recipients sign signers)
1087   "Encrypt the current region between START and END for RECIPIENTS.
1088
1089 Don't use this command in Lisp programs!
1090 Since this function operates on regions, it does some tricks such
1091 as coding-system detection and unibyte/multibyte conversion.  If
1092 you are sure how the data should be treated, you should consider
1093 using the string based counterpart `epg-encrypt-string', or the
1094 file based counterpart `epg-encrypt-file' instead.
1095
1096 For example:
1097
1098 \(let ((context (epg-make-context \\='OpenPGP)))
1099   (epg-encrypt-string
1100     context
1101     (encode-coding-string (buffer-substring start end) \\='utf-8)
1102     nil))"
1103   (declare (interactive-only t))
1104   (interactive
1105    (let ((verbose current-prefix-arg)
1106          (context (epg-make-context epa-protocol))
1107          sign)
1108      (setq epa-last-coding-system-specified
1109            (or coding-system-for-write
1110                (select-safe-coding-system
1111                 (region-beginning) (region-end))))
1112      (list (region-beginning) (region-end)
1113            (epa-select-keys context
1114                             "Select recipients for encryption.
1115 If no one is selected, symmetric encryption will be performed.  ")
1116            (setq sign (if verbose (y-or-n-p "Sign? ")))
1117            (if sign
1118                (epa-select-keys context
1119                                 "Select keys for signing.  ")))))
1120   (save-excursion
1121     (let ((context (epg-make-context epa-protocol))
1122           cipher)
1123       ;;(setf (epg-context-armor context) epa-armor)
1124       (setf (epg-context-armor context) t)
1125       ;;(setf (epg-context-textmode context) epa-textmode)
1126       (setf (epg-context-textmode context) t)
1127       (if sign
1128           (setf (epg-context-signers context) signers))
1129       (epg-context-set-passphrase-callback context
1130                                            #'epa-passphrase-callback-function)
1131       (epg-context-set-progress-callback context
1132                                          (cons
1133                                           #'epa-progress-callback-function
1134                                           "Encrypting..."))
1135       (message "Encrypting...")
1136       (condition-case error
1137           (setq cipher (epg-encrypt-string context
1138                                            (encode-coding-string
1139                                             (buffer-substring start end)
1140                                             epa-last-coding-system-specified)
1141                                            recipients
1142                                            sign))
1143         (error
1144          (epa-display-error context)
1145          (signal (car error) (cdr error))))
1146       (message "Encrypting...done")
1147       (delete-region start end)
1148       (goto-char start)
1149       (add-text-properties (point)
1150                            (progn
1151                              (insert cipher)
1152                              (point))
1153                            (list 'epa-coding-system-used
1154                                  epa-last-coding-system-specified
1155                                  'front-sticky nil
1156                                  'rear-nonsticky t
1157                                  'start-open t
1158                                  'end-open t)))))
1159
1160 ;;;###autoload
1161 (defun epa-delete-keys (keys &optional allow-secret)
1162   "Delete selected KEYS."
1163   (interactive
1164    (let ((keys (epa--marked-keys)))
1165      (unless keys
1166        (error "No keys selected"))
1167      (list keys
1168            (eq (nth 1 epa-list-keys-arguments) t))))
1169   (let ((context (epg-make-context epa-protocol)))
1170     (message "Deleting...")
1171     (condition-case error
1172         (epg-delete-keys context keys allow-secret)
1173       (error
1174        (epa-display-error context)
1175        (signal (car error) (cdr error))))
1176     (message "Deleting...done")
1177     (apply #'epa--list-keys epa-list-keys-arguments)))
1178
1179 ;;;###autoload
1180 (defun epa-import-keys (file)
1181   "Import keys from FILE."
1182   (interactive "fFile: ")
1183   (setq file (expand-file-name file))
1184   (let ((context (epg-make-context epa-protocol)))
1185     (message "Importing %s..." (file-name-nondirectory file))
1186     (condition-case nil
1187         (progn
1188           (epg-import-keys-from-file context file)
1189           (message "Importing %s...done" (file-name-nondirectory file)))
1190       (error
1191        (epa-display-error context)
1192        (message "Importing %s...failed" (file-name-nondirectory file))))
1193     (if (epg-context-result-for context 'import)
1194         (epa-display-info (epg-import-result-to-string
1195                            (epg-context-result-for context 'import))))
1196     ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
1197     (if (eq major-mode 'epa-key-list-mode)
1198         (apply #'epa--list-keys epa-list-keys-arguments))))
1199
1200 ;;;###autoload
1201 (defun epa-import-keys-region (start end)
1202   "Import keys from the region."
1203   (interactive "r")
1204   (let ((context (epg-make-context epa-protocol)))
1205     (message "Importing...")
1206     (condition-case nil
1207         (progn
1208           (epg-import-keys-from-string context (buffer-substring start end))
1209           (message "Importing...done"))
1210       (error
1211        (epa-display-error context)
1212        (message "Importing...failed")))
1213     (if (epg-context-result-for context 'import)
1214         (epa-display-info (epg-import-result-to-string
1215                            (epg-context-result-for context 'import))))))
1216
1217 ;;;###autoload
1218 (defun epa-import-armor-in-region (start end)
1219   "Import keys in the OpenPGP armor format in the current region
1220 between START and END."
1221   (interactive "r")
1222   (save-excursion
1223     (save-restriction
1224       (narrow-to-region start end)
1225       (goto-char start)
1226       (let (armor-start armor-end)
1227         (while (re-search-forward
1228                 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1229                 nil t)
1230           (setq armor-start (match-beginning 0)
1231                 armor-end (re-search-forward
1232                            (concat "^-----END " (match-string 1) "-----$")
1233                            nil t))
1234           (unless armor-end
1235             (error "No armor tail"))
1236           (epa-import-keys-region armor-start armor-end))))))
1237
1238 ;;;###autoload
1239 (defun epa-export-keys (keys file)
1240   "Export selected KEYS to FILE."
1241   (interactive
1242    (let ((keys (epa--marked-keys))
1243          default-name)
1244      (unless keys
1245        (error "No keys selected"))
1246      (setq default-name
1247            (expand-file-name
1248             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1249                     (if epa-armor ".asc" ".gpg"))
1250             default-directory))
1251      (list keys
1252            (expand-file-name
1253             (read-file-name
1254              (concat "To file (default "
1255                      (file-name-nondirectory default-name)
1256                      ") ")
1257              (file-name-directory default-name)
1258              default-name)))))
1259   (let ((context (epg-make-context epa-protocol)))
1260     (setf (epg-context-armor context) epa-armor)
1261     (message "Exporting to %s..." (file-name-nondirectory file))
1262     (condition-case error
1263         (epg-export-keys-to-file context keys file)
1264       (error
1265        (epa-display-error context)
1266        (signal (car error) (cdr error))))
1267     (message "Exporting to %s...done" (file-name-nondirectory file))))
1268
1269 ;;;###autoload
1270 (defun epa-insert-keys (keys)
1271   "Insert selected KEYS after the point."
1272   (interactive
1273    (list (epa-select-keys (epg-make-context epa-protocol)
1274                           "Select keys to export.
1275 If no one is selected, default public key is exported.  ")))
1276   (let ((context (epg-make-context epa-protocol)))
1277     ;;(setf (epg-context-armor context) epa-armor)
1278     (setf (epg-context-armor context) t)
1279     (condition-case error
1280         (insert (epg-export-keys-to-string context keys))
1281       (error
1282        (epa-display-error context)
1283        (signal (car error) (cdr error))))))
1284
1285 ;; (defun epa-sign-keys (keys &optional local)
1286 ;;   "Sign selected KEYS.
1287 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1288
1289 ;; Don't use this command in Lisp programs!"
1290 ;;   (declare (interactive-only t))
1291 ;;   (interactive
1292 ;;    (let ((keys (epa--marked-keys)))
1293 ;;      (unless keys
1294 ;;        (error "No keys selected"))
1295 ;;      (list keys current-prefix-arg)))
1296 ;;   (let ((context (epg-make-context epa-protocol)))
1297 ;;     (epg-context-set-passphrase-callback context
1298 ;;                                          #'epa-passphrase-callback-function)
1299 ;;     (epg-context-set-progress-callback context
1300 ;;                                        (cons
1301 ;;                                          #'epa-progress-callback-function
1302 ;;                                          "Signing keys..."))
1303 ;;     (message "Signing keys...")
1304 ;;     (epg-sign-keys context keys local)
1305 ;;     (message "Signing keys...done")))
1306 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1307
1308 (provide 'epa)
1309
1310 ;;; epa.el ends here