lisp/epa.el

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