lisp/epa.el

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