code.delx.au - gnu-emacs/blob - 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     (if epa-pinentry-mode
 787         (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
 788     (message "Signing %s..." (file-name-nondirectory file))
 789     (condition-case error
 790         (epg-sign-file context file signature mode)
 791       (error
 792        (epa-display-error context)
 793        (signal (car error) (cdr error))))
 794     (message "Signing %s...wrote %s" (file-name-nondirectory file)
 795              (file-name-nondirectory signature))))
 796
 797 ;;;###autoload
 798 (defun epa-encrypt-file (file recipients)
 799   "Encrypt FILE for RECIPIENTS."
 800   (interactive
 801    (list (expand-file-name (read-file-name "File: "))
 802          (epa-select-keys (epg-make-context epa-protocol)
 803                           "Select recipients for encryption.
 804 If no one is selected, symmetric encryption will be performed.  ")))
 805   (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
 806                                  (if epa-armor ".asc" ".gpg")
 807                                ".p7m")))
 808         (context (epg-make-context epa-protocol)))
 809     (setf (epg-context-armor context) epa-armor)
 810     (setf (epg-context-textmode context) epa-textmode)
 811     (setf (epg-context-passphrase-callback context)
 812           #'epa-passphrase-callback-function)
 813     (setf (epg-context-progress-callback context)
 814           (cons
 815            #'epa-progress-callback-function
 816            (format "Encrypting %s..."
 817                    (file-name-nondirectory file))))
 818     (if epa-pinentry-mode
 819         (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
 820     (message "Encrypting %s..." (file-name-nondirectory file))
 821     (condition-case error
 822         (epg-encrypt-file context file recipients cipher)
 823       (error
 824        (epa-display-error context)
 825        (signal (car error) (cdr error))))
 826     (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
 827              (file-name-nondirectory cipher))))
 828
 829 ;;;###autoload
 830 (defun epa-decrypt-region (start end &optional make-buffer-function)
 831   "Decrypt the current region between START and END.
 832
 833 If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
 834 It should return that buffer.  If it copies the input, it should
 835 delete the text now being decrypted.  It should leave point at the
 836 proper place to insert the plaintext.
 837
 838 Be careful about using this command in Lisp programs!
 839 Since this function operates on regions, it does some tricks such
 840 as coding-system detection and unibyte/multibyte conversion.  If
 841 you are sure how the data in the region should be treated, you
 842 should consider using the string based counterpart
 843 `epg-decrypt-string', or the file based counterpart
 844 `epg-decrypt-file' instead.
 845
 846 For example:
 847
 848 \(let ((context (epg-make-context 'OpenPGP)))
 849   (decode-coding-string
 850     (epg-decrypt-string context (buffer-substring start end))
 851     'utf-8))"
 852   (interactive "r")
 853   (save-excursion
 854     (let ((context (epg-make-context epa-protocol))
 855           plain)
 856       (setf (epg-context-passphrase-callback context)
 857             #'epa-passphrase-callback-function)
 858       (setf (epg-context-progress-callback context)
 859             (cons
 860              #'epa-progress-callback-function
 861              "Decrypting..."))
 862       (if epa-pinentry-mode
 863           (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
 864       (message "Decrypting...")
 865       (condition-case error
 866           (setq plain (epg-decrypt-string context (buffer-substring start end)))
 867         (error
 868          (epa-display-error context)
 869          (signal (car error) (cdr error))))
 870       (message "Decrypting...done")
 871       (setq plain (epa--decode-coding-string
 872                    plain
 873                    (or coding-system-for-read
 874                        (get-text-property start 'epa-coding-system-used)
 875                        'undecided)))
 876       (if make-buffer-function
 877           (with-current-buffer (funcall make-buffer-function)
 878             (let ((inhibit-read-only t))
 879               (insert plain)))
 880         (if (y-or-n-p "Replace the original text? ")
 881             (let ((inhibit-read-only t))
 882               (delete-region start end)
 883               (goto-char start)
 884               (insert plain))
 885           (with-output-to-temp-buffer "*Temp*"
 886             (set-buffer standard-output)
 887             (insert plain)
 888             (epa-info-mode))))
 889       (if (epg-context-result-for context 'verify)
 890           (epa-display-info (epg-verify-result-to-string
 891                              (epg-context-result-for context 'verify)))))))
 892
 893 (defun epa--find-coding-system-for-mime-charset (mime-charset)
 894   (if (featurep 'xemacs)
 895       (if (fboundp 'find-coding-system)
 896           (find-coding-system mime-charset))
 897     ;; Find the first coding system which corresponds to MIME-CHARSET.
 898     (let ((pointer (coding-system-list)))
 899       (while (and pointer
 900                   (not (eq (coding-system-get (car pointer) 'mime-charset)
 901                            mime-charset)))
 902         (setq pointer (cdr pointer)))
 903       (car pointer))))
 904
 905 ;;;###autoload
 906 (defun epa-decrypt-armor-in-region (start end)
 907   "Decrypt OpenPGP armors in the current region between START and END.
 908
 909 Don't use this command in Lisp programs!
 910 See the reason described in the `epa-decrypt-region' documentation."
 911   (declare (interactive-only t))
 912   (interactive "r")
 913   (save-excursion
 914     (save-restriction
 915       (narrow-to-region start end)
 916       (goto-char start)
 917       (let (armor-start armor-end)
 918         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 919           (setq armor-start (match-beginning 0)
 920                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 921                                              nil t))
 922           (unless armor-end
 923             (error "Encryption armor beginning has no matching end"))
 924           (goto-char armor-start)
 925           (let ((coding-system-for-read
 926                  (or coding-system-for-read
 927                      (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 928                          (epa--find-coding-system-for-mime-charset
 929                           (intern (downcase (match-string 1))))))))
 930             (goto-char armor-end)
 931             (epa-decrypt-region armor-start armor-end)))))))
 932
 933 ;;;###autoload
 934 (defun epa-verify-region (start end)
 935   "Verify the current region between START and END.
 936
 937 Don't use this command in Lisp programs!
 938 Since this function operates on regions, it does some tricks such
 939 as coding-system detection and unibyte/multibyte conversion.  If
 940 you are sure how the data in the region should be treated, you
 941 should consider using the string based counterpart
 942 `epg-verify-string', or the file based counterpart
 943 `epg-verify-file' instead.
 944
 945 For example:
 946
 947 \(let ((context (epg-make-context 'OpenPGP)))
 948   (decode-coding-string
 949     (epg-verify-string context (buffer-substring start end))
 950     'utf-8))"
 951   (declare (interactive-only t))
 952   (interactive "r")
 953   (let ((context (epg-make-context epa-protocol))
 954         plain)
 955     (setf (epg-context-progress-callback context)
 956           (cons
 957            #'epa-progress-callback-function
 958            "Verifying..."))
 959     (message "Verifying...")
 960     (condition-case error
 961         (setq plain (epg-verify-string
 962                      context
 963                      (epa--encode-coding-string
 964                       (buffer-substring start end)
 965                       (or coding-system-for-write
 966                           (get-text-property start 'epa-coding-system-used)))))
 967       (error
 968        (epa-display-error context)
 969        (signal (car error) (cdr error))))
 970     (message "Verifying...done")
 971     (setq plain (epa--decode-coding-string
 972                  plain
 973                  (or coding-system-for-read
 974                      (get-text-property start 'epa-coding-system-used)
 975                      'undecided)))
 976     (if (y-or-n-p "Replace the original text? ")
 977         (let ((inhibit-read-only t)
 978               buffer-read-only)
 979           (delete-region start end)
 980           (goto-char start)
 981           (insert plain))
 982       (with-output-to-temp-buffer "*Temp*"
 983         (set-buffer standard-output)
 984         (insert plain)
 985         (epa-info-mode)))
 986     (if (epg-context-result-for context 'verify)
 987         (epa-display-info (epg-verify-result-to-string
 988                            (epg-context-result-for context 'verify))))))
 989
 990 ;;;###autoload
 991 (defun epa-verify-cleartext-in-region (start end)
 992   "Verify OpenPGP cleartext signed messages in the current region
 993 between START and END.
 994
 995 Don't use this command in Lisp programs!
 996 See the reason described in the `epa-verify-region' documentation."
 997   (declare (interactive-only t))
 998   (interactive "r")
 999   (save-excursion
1000     (save-restriction
1001       (narrow-to-region start end)
1002       (goto-char start)
1003       (let (cleartext-start cleartext-end)
1004         (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
1005                                   nil t)
1006           (setq cleartext-start (match-beginning 0))
1007           (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
1008                                      nil t)
1009             (error "Invalid cleartext signed message"))
1010           (setq cleartext-end (re-search-forward
1011                                "^-----END PGP SIGNATURE-----$"
1012                                nil t))
1013           (unless cleartext-end
1014             (error "No cleartext tail"))
1015           (epa-verify-region cleartext-start cleartext-end))))))
1016
1017 (defalias 'epa--select-safe-coding-system
1018   (if (fboundp 'select-safe-coding-system)
1019       #'select-safe-coding-system
1020     (lambda (_from _to)
1021       buffer-file-coding-system)))
1022
1023 ;;;###autoload
1024 (defun epa-sign-region (start end signers mode)
1025   "Sign the current region between START and END by SIGNERS keys selected.
1026
1027 Don't use this command in Lisp programs!
1028 Since this function operates on regions, it does some tricks such
1029 as coding-system detection and unibyte/multibyte conversion.  If
1030 you are sure how the data should be treated, you should consider
1031 using the string based counterpart `epg-sign-string', or the file
1032 based counterpart `epg-sign-file' instead.
1033
1034 For example:
1035
1036 \(let ((context (epg-make-context 'OpenPGP)))
1037   (epg-sign-string
1038     context
1039     (encode-coding-string (buffer-substring start end) 'utf-8)))"
1040   (declare (interactive-only t))
1041   (interactive
1042    (let ((verbose current-prefix-arg))
1043      (setq epa-last-coding-system-specified
1044            (or coding-system-for-write
1045                (epa--select-safe-coding-system
1046                 (region-beginning) (region-end))))
1047      (list (region-beginning) (region-end)
1048            (if verbose
1049                (epa-select-keys (epg-make-context epa-protocol)
1050                                 "Select keys for signing.
1051 If no one is selected, default secret key is used.  "
1052                                 nil t))
1053            (if verbose
1054                (epa--read-signature-type)
1055              'clear))))
1056   (save-excursion
1057     (let ((context (epg-make-context epa-protocol))
1058           signature)
1059       ;;(setf (epg-context-armor context) epa-armor)
1060       (setf (epg-context-armor context) t)
1061       ;;(setf (epg-context-textmode context) epa-textmode)
1062       (setf (epg-context-textmode context) t)
1063       (setf (epg-context-signers context) signers)
1064       (setf (epg-context-passphrase-callback context)
1065             #'epa-passphrase-callback-function)
1066       (setf (epg-context-progress-callback context)
1067             (cons
1068              #'epa-progress-callback-function
1069              "Signing..."))
1070       (if epa-pinentry-mode
1071           (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
1072       (message "Signing...")
1073       (condition-case error
1074           (setq signature (epg-sign-string context
1075                                            (epa--encode-coding-string
1076                                             (buffer-substring start end)
1077                                             epa-last-coding-system-specified)
1078                                            mode))
1079         (error
1080          (epa-display-error context)
1081          (signal (car error) (cdr error))))
1082       (message "Signing...done")
1083       (delete-region start end)
1084       (goto-char start)
1085       (add-text-properties (point)
1086                            (progn
1087                              (insert (epa--decode-coding-string
1088                                       signature
1089                                       (or coding-system-for-read
1090                                           epa-last-coding-system-specified)))
1091                              (point))
1092                            (list 'epa-coding-system-used
1093                                  epa-last-coding-system-specified
1094                                  'front-sticky nil
1095                                  'rear-nonsticky t
1096                                  'start-open t
1097                                  'end-open t)))))
1098
1099 (defalias 'epa--derived-mode-p
1100   (if (fboundp 'derived-mode-p)
1101       #'derived-mode-p
1102     (lambda (&rest modes)
1103       "Non-nil if the current major mode is derived from one of MODES.
1104 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1105       (let ((parent major-mode))
1106         (while (and (not (memq parent modes))
1107                     (setq parent (get parent 'derived-mode-parent))))
1108         parent))))
1109
1110 ;;;###autoload
1111 (defun epa-encrypt-region (start end recipients sign signers)
1112   "Encrypt the current region between START and END for RECIPIENTS.
1113
1114 Don't use this command in Lisp programs!
1115 Since this function operates on regions, it does some tricks such
1116 as coding-system detection and unibyte/multibyte conversion.  If
1117 you are sure how the data should be treated, you should consider
1118 using the string based counterpart `epg-encrypt-string', or the
1119 file based counterpart `epg-encrypt-file' instead.
1120
1121 For example:
1122
1123 \(let ((context (epg-make-context 'OpenPGP)))
1124   (epg-encrypt-string
1125     context
1126     (encode-coding-string (buffer-substring start end) 'utf-8)
1127     nil))"
1128   (declare (interactive-only t))
1129   (interactive
1130    (let ((verbose current-prefix-arg)
1131          (context (epg-make-context epa-protocol))
1132          sign)
1133      (setq epa-last-coding-system-specified
1134            (or coding-system-for-write
1135                (epa--select-safe-coding-system
1136                 (region-beginning) (region-end))))
1137      (list (region-beginning) (region-end)
1138            (epa-select-keys context
1139                             "Select recipients for encryption.
1140 If no one is selected, symmetric encryption will be performed.  ")
1141            (setq sign (if verbose (y-or-n-p "Sign? ")))
1142            (if sign
1143                (epa-select-keys context
1144                                 "Select keys for signing.  ")))))
1145   (save-excursion
1146     (let ((context (epg-make-context epa-protocol))
1147           cipher)
1148       ;;(setf (epg-context-armor context) epa-armor)
1149       (setf (epg-context-armor context) t)
1150       ;;(setf (epg-context-textmode context) epa-textmode)
1151       (setf (epg-context-textmode context) t)
1152       (if sign
1153           (setf (epg-context-signers context) signers))
1154       (setf (epg-context-passphrase-callback context)
1155             #'epa-passphrase-callback-function)
1156       (setf (epg-context-progress-callback context)
1157             (cons
1158              #'epa-progress-callback-function
1159              "Encrypting..."))
1160       (if epa-pinentry-mode
1161           (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
1162       (message "Encrypting...")
1163       (condition-case error
1164           (setq cipher (epg-encrypt-string context
1165                                            (epa--encode-coding-string
1166                                             (buffer-substring start end)
1167                                             epa-last-coding-system-specified)
1168                                            recipients
1169                                            sign))
1170         (error
1171          (epa-display-error context)
1172          (signal (car error) (cdr error))))
1173       (message "Encrypting...done")
1174       (delete-region start end)
1175       (goto-char start)
1176       (add-text-properties (point)
1177                            (progn
1178                              (insert cipher)
1179                              (point))
1180                            (list 'epa-coding-system-used
1181                                  epa-last-coding-system-specified
1182                                  'front-sticky nil
1183                                  'rear-nonsticky t
1184                                  'start-open t
1185                                  'end-open t)))))
1186
1187 ;;;###autoload
1188 (defun epa-delete-keys (keys &optional allow-secret)
1189   "Delete selected KEYS."
1190   (interactive
1191    (let ((keys (epa--marked-keys)))
1192      (unless keys
1193        (error "No keys selected"))
1194      (list keys
1195            (eq (nth 1 epa-list-keys-arguments) t))))
1196   (let ((context (epg-make-context epa-protocol)))
1197     (message "Deleting...")
1198     (condition-case error
1199         (epg-delete-keys context keys allow-secret)
1200       (error
1201        (epa-display-error context)
1202        (signal (car error) (cdr error))))
1203     (message "Deleting...done")
1204     (apply #'epa--list-keys epa-list-keys-arguments)))
1205
1206 ;;;###autoload
1207 (defun epa-import-keys (file)
1208   "Import keys from FILE."
1209   (interactive "fFile: ")
1210   (setq file (expand-file-name file))
1211   (let ((context (epg-make-context epa-protocol)))
1212     (message "Importing %s..." (file-name-nondirectory file))
1213     (condition-case nil
1214         (progn
1215           (epg-import-keys-from-file context file)
1216           (message "Importing %s...done" (file-name-nondirectory file)))
1217       (error
1218        (epa-display-error context)
1219        (message "Importing %s...failed" (file-name-nondirectory file))))
1220     (if (epg-context-result-for context 'import)
1221         (epa-display-info (epg-import-result-to-string
1222                            (epg-context-result-for context 'import))))
1223     ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
1224     (if (eq major-mode 'epa-key-list-mode)
1225         (apply #'epa--list-keys epa-list-keys-arguments))))
1226
1227 ;;;###autoload
1228 (defun epa-import-keys-region (start end)
1229   "Import keys from the region."
1230   (interactive "r")
1231   (let ((context (epg-make-context epa-protocol)))
1232     (message "Importing...")
1233     (condition-case nil
1234         (progn
1235           (epg-import-keys-from-string context (buffer-substring start end))
1236           (message "Importing...done"))
1237       (error
1238        (epa-display-error context)
1239        (message "Importing...failed")))
1240     (if (epg-context-result-for context 'import)
1241         (epa-display-info (epg-import-result-to-string
1242                            (epg-context-result-for context 'import))))))
1243
1244 ;;;###autoload
1245 (defun epa-import-armor-in-region (start end)
1246   "Import keys in the OpenPGP armor format in the current region
1247 between START and END."
1248   (interactive "r")
1249   (save-excursion
1250     (save-restriction
1251       (narrow-to-region start end)
1252       (goto-char start)
1253       (let (armor-start armor-end)
1254         (while (re-search-forward
1255                 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1256                 nil t)
1257           (setq armor-start (match-beginning 0)
1258                 armor-end (re-search-forward
1259                            (concat "^-----END " (match-string 1) "-----$")
1260                            nil t))
1261           (unless armor-end
1262             (error "No armor tail"))
1263           (epa-import-keys-region armor-start armor-end))))))
1264
1265 ;;;###autoload
1266 (defun epa-export-keys (keys file)
1267   "Export selected KEYS to FILE."
1268   (interactive
1269    (let ((keys (epa--marked-keys))
1270          default-name)
1271      (unless keys
1272        (error "No keys selected"))
1273      (setq default-name
1274            (expand-file-name
1275             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1276                     (if epa-armor ".asc" ".gpg"))
1277             default-directory))
1278      (list keys
1279            (expand-file-name
1280             (read-file-name
1281              (concat "To file (default "
1282                      (file-name-nondirectory default-name)
1283                      ") ")
1284              (file-name-directory default-name)
1285              default-name)))))
1286   (let ((context (epg-make-context epa-protocol)))
1287     (setf (epg-context-armor context) epa-armor)
1288     (message "Exporting to %s..." (file-name-nondirectory file))
1289     (condition-case error
1290         (epg-export-keys-to-file context keys file)
1291       (error
1292        (epa-display-error context)
1293        (signal (car error) (cdr error))))
1294     (message "Exporting to %s...done" (file-name-nondirectory file))))
1295
1296 ;;;###autoload
1297 (defun epa-insert-keys (keys)
1298   "Insert selected KEYS after the point."
1299   (interactive
1300    (list (epa-select-keys (epg-make-context epa-protocol)
1301                           "Select keys to export.
1302 If no one is selected, default public key is exported.  ")))
1303   (let ((context (epg-make-context epa-protocol)))
1304     ;;(setf (epg-context-armor context) epa-armor)
1305     (setf (epg-context-armor context) t)
1306     (condition-case error
1307         (insert (epg-export-keys-to-string context keys))
1308       (error
1309        (epa-display-error context)
1310        (signal (car error) (cdr error))))))
1311
1312 ;; (defun epa-sign-keys (keys &optional local)
1313 ;;   "Sign selected KEYS.
1314 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1315
1316 ;; Don't use this command in Lisp programs!"
1317 ;;   (declare (interactive-only t))
1318 ;;   (interactive
1319 ;;    (let ((keys (epa--marked-keys)))
1320 ;;      (unless keys
1321 ;;        (error "No keys selected"))
1322 ;;      (list keys current-prefix-arg)))
1323 ;;   (let ((context (epg-make-context epa-protocol)))
1324 ;;     (setf (epg-context-passphrase-callback context)
1325 ;;           #'epa-passphrase-callback-function)
1326 ;;     (setf (epg-context-progress-callback context)
1327 ;;           (cons
1328 ;;             #'epa-progress-callback-function
1329 ;;             "Signing keys..."))
1330 ;;     (if epa-pinentry-mode
1331 ;;         (setf (epg-context-pinentry-mode context) epa-pinentry-mode))
1332 ;;     (message "Signing keys...")
1333 ;;     (epg-sign-keys context keys local)
1334 ;;     (message "Signing keys...done")))
1335 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1336
1337 (provide 'epa)
1338
1339 ;;; epa.el ends here