lisp/epa.el

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