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