lisp/epa.el

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