lisp/epa.el

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