lisp/epa.el

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