epa.el

   1 ;;; epa.el --- the EasyPG Assistant
   2 ;; Copyright (C) 2006 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG
   6
   7 ;; This file is part of EasyPG.
   8
   9 ;; This program 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 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program 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
  31 (defgroup epa nil
  32   "The EasyPG Assistant"
  33   :group 'epg)
  34
  35 (defcustom epa-armor nil
  36   "If non-nil, epa commands create ASCII armored output."
  37   :type 'boolean
  38   :group 'epa)
  39
  40 (defcustom epa-textmode nil
  41   "If non-nil, epa commands treat input files as text."
  42   :type 'boolean
  43   :group 'epa)
  44
  45 (defcustom epa-popup-info-window nil
  46   "If non-nil, status information from epa commands is displayed on
  47 the separate window."
  48   :type 'boolean
  49   :group 'epa)
  50
  51 (defcustom epa-info-window-height 5
  52   "Number of lines used to display status information."
  53   :type 'integer
  54   :group 'epa)
  55
  56 (defgroup epa-faces nil
  57   "Faces for epa-mode."
  58   :group 'epa)
  59
  60 (defface epa-validity-high-face
  61   '((((class color) (background dark))
  62      (:foreground "PaleTurquoise" :bold t))
  63     (t
  64      (:bold t)))
  65   "Face used for displaying the high validity."
  66   :group 'epa-faces)
  67 (defvar epa-validity-high-face 'epa-validity-high-face)
  68
  69 (defface epa-validity-medium-face
  70   '((((class color) (background dark))
  71      (:foreground "PaleTurquoise" :italic t))
  72     (t
  73      ()))
  74   "Face used for displaying the medium validity."
  75   :group 'epa-faces)
  76 (defvar epa-validity-medium-face 'epa-validity-medium-face)
  77
  78 (defface epa-validity-low-face
  79   '((t
  80      (:italic t)))
  81   "Face used for displaying the low validity."
  82   :group 'epa-faces)
  83 (defvar epa-validity-low-face 'epa-validity-low-face)
  84
  85 (defface epa-validity-disabled-face
  86   '((t
  87      (:italic t :inverse-video t)))
  88   "Face used for displaying the disabled validity."
  89   :group 'epa-faces)
  90 (defvar epa-validity-disabled-face 'epa-validity-disabled-face)
  91
  92 (defface epa-string-face
  93   '((((class color)
  94       (background dark))
  95      (:foreground "lightyellow"))
  96     (((class color)
  97       (background light))
  98      (:foreground "blue4"))
  99     (t
 100      ()))
 101   "Face used for displaying the string."
 102   :group 'epa-faces)
 103 (defvar epa-string-face 'epa-string-face)
 104
 105 (defface epa-mark-face
 106   '((((class color) (background dark))
 107      (:foreground "orange" :bold t))
 108     (t
 109      (:foreground "red" :bold t)))
 110   "Face used for displaying the high validity."
 111   :group 'epa-faces)
 112 (defvar epa-mark-face 'epa-mark-face)
 113
 114 (defface epa-field-name-face
 115   '((((class color) (background dark))
 116      (:foreground "PaleTurquoise" :bold t))
 117     (t (:bold t)))
 118   "Face for the name of the attribute field."
 119   :group 'epa)
 120 (defvar epa-field-name-face 'epa-field-name-face)
 121
 122 (defface epa-field-body-face
 123   '((((class color) (background dark))
 124      (:foreground "turquoise" :italic t))
 125     (t (:italic t)))
 126   "Face for the body of the attribute field."
 127   :group 'epa)
 128 (defvar epa-field-body-face 'epa-field-body-face)
 129
 130 (defcustom epa-validity-face-alist
 131   '((unknown . epa-validity-disabled-face)
 132     (invalid . epa-validity-disabled-face)
 133     (disabled . epa-validity-disabled-face)
 134     (revoked . epa-validity-disabled-face)
 135     (expired . epa-validity-disabled-face)
 136     (none . epa-validity-low-face)
 137     (undefined . epa-validity-low-face)
 138     (never . epa-validity-low-face)
 139     (marginal . epa-validity-medium-face)
 140     (full . epa-validity-high-face)
 141     (ultimate . epa-validity-high-face))
 142   "An alist mapping validity values to faces."
 143   :type 'list
 144   :group 'epa)
 145
 146 (defcustom epa-font-lock-keywords
 147   '(("^\\*"
 148      (0 epa-mark-face))
 149     ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
 150      (1 epa-field-name-face)
 151      (2 epa-field-body-face)))
 152   "Default expressions to addon in epa-mode."
 153   :type '(repeat (list string))
 154   :group 'epa)
 155
 156 (defconst epa-pubkey-algorithm-letter-alist
 157   '((1 . ?R)
 158     (2 . ?r)
 159     (3 . ?s)
 160     (16 . ?g)
 161     (17 . ?D)
 162     (20 . ?G)))
 163
 164 (defvar epa-keys-buffer nil)
 165 (defvar epa-key-buffer-alist nil)
 166 (defvar epa-key nil)
 167 (defvar epa-list-keys-arguments nil)
 168 (defvar epa-info-buffer nil)
 169
 170 (defvar epa-keys-mode-map
 171   (let ((keymap (make-sparse-keymap)))
 172     (define-key keymap "m" 'epa-mark)
 173     (define-key keymap "u" 'epa-unmark)
 174     (define-key keymap [return] 'epa-toggle-mark)
 175     (define-key keymap "d" 'epa-decrypt-file)
 176     (define-key keymap "v" 'epa-verify-file)
 177     (define-key keymap "s" 'epa-sign-file)
 178     (define-key keymap "S" 'epa-sign-keys)
 179     (define-key keymap "e" 'epa-encrypt-file)
 180     (define-key keymap "r" 'epa-delete-keys)
 181     (define-key keymap "i" 'epa-import-keys)
 182     (define-key keymap "o" 'epa-export-keys)
 183     (define-key keymap "g" 'epa-list-keys)
 184     (define-key keymap "n" 'next-line)
 185     (define-key keymap "p" 'previous-line)
 186     (define-key keymap " " 'scroll-up)
 187     (define-key keymap [delete] 'scroll-down)
 188     (define-key keymap "q" 'epa-exit-buffer)
 189     keymap))
 190
 191 (defvar epa-key-mode-map
 192   (let ((keymap (make-sparse-keymap)))
 193     (define-key keymap "q" 'bury-buffer)
 194     keymap))
 195
 196 (defvar epa-info-mode-map
 197   (let ((keymap (make-sparse-keymap)))
 198     (define-key keymap "q" 'delete-window)
 199     keymap))
 200
 201 (defvar epa-exit-buffer-function #'bury-buffer)
 202
 203 (define-widget 'epa-key 'push-button
 204   "Button for representing a epg-key object."
 205   :format "%[%v%]"
 206   :button-face-get 'epa-key-widget-button-face-get
 207   :value-create 'epa-key-widget-value-create
 208   :action 'epa-key-widget-action
 209   :help-echo 'epa-key-widget-help-echo)
 210
 211 (defun epa-key-widget-action (widget &optional event)
 212   (epa-show-key (widget-get widget :value)))
 213
 214 (defun epa-key-widget-value-create (widget)
 215   (let* ((key (widget-get widget :value))
 216          (primary-sub-key (car (epg-key-sub-key-list key)))
 217          (primary-user-id (car (epg-key-user-id-list key))))
 218     (insert (format "%c "
 219                     (if (epg-sub-key-validity primary-sub-key)
 220                         (car (rassq (epg-sub-key-validity primary-sub-key)
 221                                     epg-key-validity-alist))
 222                       ? ))
 223             (epg-sub-key-id primary-sub-key)
 224             " "
 225             (if (stringp (epg-user-id-string primary-user-id))
 226                 (epg-user-id-string primary-user-id)
 227               (epg-decode-dn (epg-user-id-string primary-user-id))))))
 228
 229 (defun epa-key-widget-button-face-get (widget)
 230   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
 231                                               (widget-get widget :value))))))
 232     (if validity
 233         (cdr (assq validity epa-validity-face-alist))
 234       'default)))
 235
 236 (defun epa-key-widget-help-echo (widget)
 237   (format "Show %s"
 238           (epg-sub-key-id (car (epg-key-sub-key-list
 239                                 (widget-get widget :value))))))
 240
 241 (defun epa-keys-mode ()
 242   "Major mode for `epa-list-keys'."
 243   (kill-all-local-variables)
 244   (buffer-disable-undo)
 245   (setq major-mode 'epa-keys-mode
 246         mode-name "Keys"
 247         truncate-lines t
 248         buffer-read-only t)
 249   (use-local-map epa-keys-mode-map)
 250   (set-keymap-parent (current-local-map) widget-keymap)
 251   (make-local-variable 'font-lock-defaults)
 252   (setq font-lock-defaults '(epa-font-lock-keywords t))
 253   ;; In XEmacs, auto-initialization of font-lock is not effective
 254   ;; if buffer-file-name is not set.
 255   (font-lock-set-defaults)
 256   (widget-setup)
 257   (make-local-variable 'epa-exit-buffer-function)
 258   (run-hooks 'epa-keys-mode-hook))
 259
 260 (defun epa-key-mode ()
 261   "Major mode for `epa-show-key'."
 262   (kill-all-local-variables)
 263   (buffer-disable-undo)
 264   (setq major-mode 'epa-key-mode
 265         mode-name "Key"
 266         truncate-lines t
 267         buffer-read-only t)
 268   (use-local-map epa-key-mode-map)
 269   (make-local-variable 'font-lock-defaults)
 270   (setq font-lock-defaults '(epa-font-lock-keywords t))
 271   ;; In XEmacs, auto-initialization of font-lock is not effective
 272   ;; if buffer-file-name is not set.
 273   (font-lock-set-defaults)
 274   (make-local-variable 'epa-exit-buffer-function)
 275   (run-hooks 'epa-key-mode-hook))
 276
 277 ;;;###autoload
 278 (defun epa-list-keys (&optional name mode protocol)
 279   (interactive
 280    (if current-prefix-arg
 281        (let ((name (read-string "Pattern: "
 282                                 (if epa-list-keys-arguments
 283                                     (car epa-list-keys-arguments)))))
 284          (list (if (equal name "") nil name)
 285                (y-or-n-p "Secret keys? ")
 286                (intern (completing-read "Protocol? "
 287                                         '(("OpenPGP") ("CMS"))
 288                                         nil t))))
 289      (or epa-list-keys-arguments (list nil nil nil))))
 290   (unless (and epa-keys-buffer
 291                (buffer-live-p epa-keys-buffer))
 292     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 293   (set-buffer epa-keys-buffer)
 294   (let ((inhibit-read-only t)
 295         buffer-read-only
 296         (point (point-min))
 297         (context (epg-make-context protocol)))
 298     (unless (get-text-property point 'epa-list-keys)
 299       (setq point (next-single-property-change point 'epa-list-keys)))
 300     (when point
 301       (delete-region point
 302                      (or (next-single-property-change point 'epa-list-keys)
 303                          (point-max)))
 304       (goto-char point))
 305     (epa-insert-keys context name mode)
 306     (epa-keys-mode))
 307   (make-local-variable 'epa-list-keys-arguments)
 308   (setq epa-list-keys-arguments (list name mode protocol))
 309   (goto-char (point-min))
 310   (pop-to-buffer (current-buffer)))
 311
 312 (defun epa-insert-keys (context name mode)
 313   (save-excursion
 314     (save-restriction
 315       (narrow-to-region (point) (point))
 316       (let ((keys (epg-list-keys context name mode))
 317             point)
 318         (while keys
 319           (setq point (point))
 320           (insert "  ")
 321           (add-text-properties point (point)
 322                                (list 'epa-key (car keys)
 323                                      'front-sticky nil
 324                                      'rear-nonsticky t
 325                                      'start-open t
 326                                      'end-open t))
 327           (widget-create 'epa-key :value (car keys))
 328           (insert "\n")
 329           (setq keys (cdr keys))))
 330       (add-text-properties (point-min) (point-max)
 331                            (list 'epa-list-keys t
 332                                  'front-sticky nil
 333                                  'rear-nonsticky t
 334                                  'start-open t
 335                                  'end-open t)))))
 336
 337 (defun epa-marked-keys ()
 338   (or (save-excursion
 339         (set-buffer epa-keys-buffer)
 340         (goto-char (point-min))
 341         (let (keys key)
 342           (while (re-search-forward "^\\*" nil t)
 343             (if (setq key (get-text-property (match-beginning 0)
 344                                              'epa-key))
 345                 (setq keys (cons key keys))))
 346           (nreverse keys)))
 347       (save-excursion
 348         (beginning-of-line)
 349         (let ((key (get-text-property (point) 'epa-key)))
 350           (if key
 351               (list key))))))
 352
 353 ;;;###autoload
 354 (defun epa-select-keys (context prompt &optional names secret)
 355   "Display a user's keyring and ask him to select keys.
 356 CONTEXT is an epg-context.
 357 PROMPT is a string to prompt with.
 358 NAMES is a list of strings to be matched with keys.  If it is nil, all
 359 the keys are listed.
 360 If SECRET is non-nil, list secret keys instead of public keys."
 361   (save-excursion
 362     (unless (and epa-keys-buffer
 363                  (buffer-live-p epa-keys-buffer))
 364       (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 365     (let ((inhibit-read-only t)
 366           buffer-read-only
 367           point)
 368       (set-buffer epa-keys-buffer)
 369       (erase-buffer)
 370       (insert prompt "\n")
 371       (widget-create 'link
 372                      :notify (lambda (&rest ignore) (abort-recursive-edit))
 373                      :help-echo
 374                      (substitute-command-keys
 375                       "Click here or \\[abort-recursive-edit] to cancel")
 376                      "Cancel")
 377       (widget-create 'link
 378                      :notify (lambda (&rest ignore) (exit-recursive-edit))
 379                      :help-echo
 380                      (substitute-command-keys
 381                       "Click here or \\[exit-recursive-edit] to finish")
 382                      "OK")
 383       (insert "\n\n")
 384       (if names
 385           (while names
 386             (setq point (point))
 387             (epa-insert-keys context (car names) secret)
 388             (goto-char point)
 389             (epa-mark)
 390             (goto-char (point-max))
 391             (setq names (cdr names)))
 392         (if secret
 393             (progn
 394               (setq point (point))
 395               (epa-insert-keys context nil secret)
 396               (goto-char point)
 397               (epa-mark))
 398           (epa-insert-keys context nil nil)))
 399       (epa-keys-mode)
 400       (setq epa-exit-buffer-function #'abort-recursive-edit)
 401       (goto-char (point-min))
 402       (pop-to-buffer (current-buffer)))
 403     (unwind-protect
 404           (progn
 405             (recursive-edit)
 406             (epa-marked-keys))
 407         (if (get-buffer-window epa-keys-buffer)
 408             (delete-window (get-buffer-window epa-keys-buffer)))
 409         (kill-buffer epa-keys-buffer))))
 410
 411 (defun epa-show-key (key)
 412   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 413          (entry (assoc (epg-sub-key-id primary-sub-key)
 414                        epa-key-buffer-alist))
 415          (inhibit-read-only t)
 416          buffer-read-only
 417          pointer)
 418     (unless entry
 419       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 420             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 421     (unless (and (cdr entry)
 422                  (buffer-live-p (cdr entry)))
 423       (setcdr entry (generate-new-buffer
 424                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 425     (set-buffer (cdr entry))
 426     (make-local-variable 'epa-key)
 427     (setq epa-key key)
 428     (erase-buffer)
 429     (setq pointer (epg-key-user-id-list key))
 430     (while pointer
 431       (insert " "
 432               (if (epg-user-id-validity (car pointer))
 433                   (char-to-string
 434                    (car (rassq (epg-user-id-validity (car pointer))
 435                                epg-key-validity-alist)))
 436                 " ")
 437               " "
 438               (if (stringp (epg-user-id-string (car pointer)))
 439                   (epg-user-id-string (car pointer))
 440                 (epg-decode-dn (epg-user-id-string (car pointer))))
 441               "\n")
 442       (setq pointer (cdr pointer)))
 443     (setq pointer (epg-key-sub-key-list key))
 444     (while pointer
 445       (insert " "
 446               (if (epg-sub-key-validity (car pointer))
 447                   (char-to-string
 448                    (car (rassq (epg-sub-key-validity (car pointer))
 449                                epg-key-validity-alist)))
 450                 " ")
 451               " "
 452               (epg-sub-key-id (car pointer))
 453               " "
 454               (format "%dbits"
 455                       (epg-sub-key-length (car pointer)))
 456               " "
 457               (cdr (assq (epg-sub-key-algorithm (car pointer))
 458                          epg-pubkey-algorithm-alist))
 459               "\n\tCreated: "
 460               (format-time-string "%Y-%m-%d"
 461                                   (epg-sub-key-creation-time (car pointer)))
 462               (if (epg-sub-key-expiration-time (car pointer))
 463                   (format "\n\tExpires: %s"
 464                           (format-time-string "%Y-%m-%d"
 465                                               (epg-sub-key-expiration-time
 466                                                (car pointer))))
 467                 "")
 468               "\n\tCapabilities: "
 469               (mapconcat #'symbol-name
 470                          (epg-sub-key-capability (car pointer))
 471                          " ")
 472               "\n\tFingerprint: "
 473               (epg-sub-key-fingerprint (car pointer))
 474               "\n")
 475       (setq pointer (cdr pointer)))
 476     (goto-char (point-min))
 477     (pop-to-buffer (current-buffer))
 478     (epa-key-mode)))
 479
 480 (defun epa-show-key-notify (widget &rest ignore)
 481   (epa-show-key (widget-get widget :value)))
 482
 483 (defun epa-mark (&optional arg)
 484   "Mark the current line.
 485 If ARG is non-nil, unmark the current line."
 486   (interactive "P")
 487   (let ((inhibit-read-only t)
 488         buffer-read-only
 489         properties)
 490     (beginning-of-line)
 491     (setq properties (text-properties-at (point)))
 492     (delete-char 1)
 493     (insert (if arg " " "*"))
 494     (set-text-properties (1- (point)) (point) properties)
 495     (forward-line)))
 496
 497 (defun epa-unmark (&optional arg)
 498   "Unmark the current line.
 499 If ARG is non-nil, mark the current line."
 500   (interactive "P")
 501   (epa-mark (not arg)))
 502
 503 (defun epa-toggle-mark ()
 504   "Toggle the mark the current line."
 505   (interactive)
 506   (epa-mark (eq (char-after (save-excursion (beginning-of-line) (point))) ?*)))
 507
 508 (defun epa-exit-buffer ()
 509   "Exit the current buffer.
 510 `epa-exit-buffer-function' is called if it is set."
 511   (interactive)
 512   (funcall epa-exit-buffer-function))
 513
 514 (defun epa-display-verify-result (verify-result)
 515   (if epa-popup-info-window
 516       (progn
 517         (unless epa-info-buffer
 518           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 519         (save-excursion
 520           (set-buffer epa-info-buffer)
 521           (let ((inhibit-read-only t)
 522                 buffer-read-only)
 523             (erase-buffer)
 524             (insert (epg-verify-result-to-string verify-result)))
 525           (epa-info-mode))
 526         (pop-to-buffer epa-info-buffer)
 527         (if (> (window-height) epa-info-window-height)
 528             (shrink-window (- (window-height) epa-info-window-height)))
 529         (goto-char (point-min)))
 530     (message "%s" (epg-verify-result-to-string verify-result))))
 531
 532 (defun epa-info-mode ()
 533   "Major mode for `epa-info-buffer'."
 534   (kill-all-local-variables)
 535   (buffer-disable-undo)
 536   (setq major-mode 'epa-info-mode
 537         mode-name "Info"
 538         truncate-lines t
 539         buffer-read-only t)
 540   (use-local-map epa-info-mode-map)
 541   (run-hooks 'epa-info-mode-hook))
 542
 543 ;;;###autoload
 544 (defun epa-decrypt-file (file)
 545   "Decrypt FILE."
 546   (interactive "fFile: ")
 547   (let* ((default-name (file-name-sans-extension file))
 548          (plain (expand-file-name
 549                  (read-file-name
 550                   (concat "To file (default "
 551                           (file-name-nondirectory default-name)
 552                           ") ")
 553                   (file-name-directory default-name)
 554                   default-name)))
 555          (context (epg-make-context)))
 556     (message "Decrypting %s..." (file-name-nondirectory file))
 557     (epg-decrypt-file context file plain)
 558     (message "Decrypting %s...done" (file-name-nondirectory file))
 559     (if (epg-context-result-for context 'verify)
 560         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 561
 562 ;;;###autoload
 563 (defun epa-verify-file (file)
 564   "Verify FILE."
 565   (interactive "fFile: ")
 566   (let* ((context (epg-make-context))
 567          (plain (if (equal (file-name-extension file) "sig")
 568                     (file-name-sans-extension file))))
 569     (message "Verifying %s..." (file-name-nondirectory file))
 570     (epg-verify-file context file plain)
 571     (message "Verifying %s...done" (file-name-nondirectory file))
 572     (if (epg-context-result-for context 'verify)
 573         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 574
 575 ;;;###autoload
 576 (defun epa-sign-file (file signers mode)
 577   "Sign FILE by SIGNERS keys selected."
 578   (interactive
 579    (list (expand-file-name (read-file-name "File: "))
 580          (epa-select-keys (epg-make-context) "Select keys for signing.
 581 If no one is selected, default secret key is used.  "
 582                           nil t)
 583          (if (y-or-n-p "Make a detached signature? ")
 584              'detached
 585            (if (y-or-n-p "Make a cleartext signature? ")
 586                'clear))))
 587   (let ((signature (concat file
 588                            (if (or epa-armor
 589                                    (not (memq mode '(nil t normal detached))))
 590                                ".asc"
 591                              (if (memq mode '(t detached))
 592                                  ".sig"
 593                                ".gpg"))))
 594         (context (epg-make-context)))
 595     (epg-context-set-armor context epa-armor)
 596     (epg-context-set-textmode context epa-textmode)
 597     (epg-context-set-signers context signers)
 598     (message "Signing %s..." (file-name-nondirectory file))
 599     (epg-sign-file context file signature mode)
 600     (message "Signing %s...done" (file-name-nondirectory file))))
 601
 602 ;;;###autoload
 603 (defun epa-encrypt-file (file recipients)
 604   "Encrypt FILE for RECIPIENTS."
 605   (interactive
 606    (list (expand-file-name (read-file-name "File: "))
 607          (epa-select-keys (epg-make-context) "Select recipients for encryption.
 608 If no one is selected, symmetric encryption will be performed.  ")))
 609   (let ((cipher (concat file (if epa-armor ".asc" ".gpg")))
 610         (context (epg-make-context)))
 611     (epg-context-set-armor context epa-armor)
 612     (epg-context-set-textmode context epa-textmode)
 613     (message "Encrypting %s..." (file-name-nondirectory file))
 614     (epg-encrypt-file context file recipients cipher)
 615     (message "Encrypting %s...done" (file-name-nondirectory file))))
 616
 617 ;;;###autoload
 618 (defun epa-decrypt-region (start end)
 619   "Decrypt the current region between START and END.
 620
 621 Don't use this command in Lisp programs!"
 622   (interactive "r")
 623   (save-excursion
 624     (let ((context (epg-make-context))
 625           plain)
 626       (message "Decrypting...")
 627       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 628       (message "Decrypting...done")
 629       (delete-region start end)
 630       (goto-char start)
 631       (insert (decode-coding-string plain coding-system-for-read))
 632       (if (epg-context-result-for context 'verify)
 633           (epa-display-verify-result (epg-context-result-for context 'verify))))))
 634
 635 ;;;###autoload
 636 (defun epa-decrypt-armor-in-region (start end)
 637   "Decrypt OpenPGP armors in the current region between START and END.
 638
 639 Don't use this command in Lisp programs!"
 640   (interactive "r")
 641   (save-excursion
 642     (save-restriction
 643       (narrow-to-region start end)
 644       (goto-char start)
 645       (let (armor-start armor-end charset coding-system)
 646         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 647           (setq armor-start (match-beginning 0)
 648                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 649                                              nil t))
 650           (unless armor-end
 651             (error "No armor tail"))
 652           (goto-char armor-start)
 653           (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 654               (setq charset (match-string 1)))
 655           (if coding-system-for-read
 656               (setq coding-system coding-system-for-read)
 657             (if charset
 658                 (setq coding-system (intern (downcase charset)))
 659               (setq coding-system 'utf-8)))
 660           (let ((coding-system-for-read coding-system))
 661             (epa-decrypt-region start end)))))))
 662
 663 ;;;###autoload
 664 (defun epa-verify-region (start end)
 665   "Verify the current region between START and END.
 666
 667 Don't use this command in Lisp programs!"
 668   (interactive "r")
 669   (let ((context (epg-make-context)))
 670     (epg-verify-string context
 671                        (encode-coding-string
 672                         (buffer-substring start end)
 673                         coding-system-for-write))
 674     (if (epg-context-result-for context 'verify)
 675         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 676
 677 ;;;###autoload
 678 (defun epa-verify-armor-in-region (start end)
 679   "Verify OpenPGP armors in the current region between START and END.
 680
 681 Don't use this command in Lisp programs!"
 682   (interactive "r")
 683   (save-excursion
 684     (save-restriction
 685       (narrow-to-region start end)
 686       (goto-char start)
 687       (let (armor-start armor-end)
 688         (while (re-search-forward "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----$"
 689                                   nil t)
 690           (setq armor-start (match-beginning 0))
 691           (if (match-beginning 1)       ;cleartext signed message
 692               (progn
 693                 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 694                                            nil t)
 695                   (error "Invalid cleartext signed message"))
 696                 (setq armor-end (re-search-forward
 697                                  "^-----END PGP SIGNATURE-----$"
 698                                  nil t)))
 699             (setq armor-end (re-search-forward
 700                              "^-----END PGP MESSAGE-----$"
 701                              nil t)))
 702           (unless armor-end
 703             (error "No armor tail"))
 704           (epa-verify-region armor-start armor-end))))))
 705
 706 ;;;###autoload
 707 (defun epa-sign-region (start end signers mode)
 708   "Sign the current region between START and END by SIGNERS keys selected.
 709
 710 Don't use this command in Lisp programs!"
 711   (interactive
 712    (list (region-beginning) (region-end)
 713          (epa-select-keys (epg-make-context) "Select keys for signing.
 714 If no one is selected, default secret key is used.  "
 715                           nil t)
 716          (if (y-or-n-p "Make a detached signature? ")
 717              'detached
 718            (if (y-or-n-p "Make a cleartext signature? ")
 719                'clear))))
 720   (save-excursion
 721     (let ((context (epg-make-context))
 722           signature)
 723       (epg-context-set-armor context epa-armor)
 724       (epg-context-set-textmode context epa-textmode)
 725       (epg-context-set-signers context signers)
 726       (message "Signing...")
 727       (setq signature (epg-sign-string context
 728                                        (encode-coding-string
 729                                         (buffer-substring start end)
 730                                         coding-system-for-write)
 731                                        mode))
 732       (message "Signing...done")
 733       (delete-region start end)
 734       (insert (decode-coding-string signature coding-system-for-read)))))
 735
 736 ;;;###autoload
 737 (defun epa-encrypt-region (start end recipients)
 738   "Encrypt the current region between START and END for RECIPIENTS.
 739
 740 Don't use this command in Lisp programs!"
 741   (interactive
 742    (list (region-beginning) (region-end)
 743          (epa-select-keys (epg-make-context) "Select recipients for encryption.
 744 If no one is selected, symmetric encryption will be performed.  ")))
 745   (save-excursion
 746     (let ((context (epg-make-context))
 747           cipher)
 748       (epg-context-set-armor context epa-armor)
 749       (epg-context-set-textmode context epa-textmode)
 750       (message "Encrypting...")
 751       (setq cipher (epg-encrypt-string context
 752                                        (encode-coding-string
 753                                         (buffer-substring start end)
 754                                         coding-system-for-write)
 755                                        recipients))
 756       (message "Encrypting...done")
 757       (delete-region start end)
 758       (insert cipher))))
 759
 760 ;;;###autoload
 761 (defun epa-delete-keys (keys &optional allow-secret)
 762   "Delete selected KEYS."
 763   (interactive
 764    (let ((keys (epa-marked-keys)))
 765      (unless keys
 766        (error "No keys selected"))
 767      (list keys
 768            (eq (nth 1 epa-list-keys-arguments) t))))
 769   (let ((context (epg-make-context)))
 770     (message "Deleting...")
 771     (epg-delete-keys context keys allow-secret)
 772     (message "Deleting...done")
 773     (apply #'epa-list-keys epa-list-keys-arguments)))
 774
 775 ;;;###autoload
 776 (defun epa-import-keys (file)
 777   "Import keys from FILE."
 778   (interactive "fFile: ")
 779   (let ((context (epg-make-context)))
 780     (message "Importing %s..." (file-name-nondirectory file))
 781     (epg-import-keys-from-file context (expand-file-name file))
 782     (message "Importing %s...done" (file-name-nondirectory file))
 783     (apply #'epa-list-keys epa-list-keys-arguments)))
 784
 785 ;;;###autoload
 786 (defun epa-export-keys (keys file)
 787   "Export selected KEYS to FILE."
 788   (interactive
 789    (let ((keys (epa-marked-keys))
 790          default-name)
 791      (unless keys
 792        (error "No keys selected"))
 793      (setq default-name
 794            (expand-file-name
 795             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
 796                     (if epa-armor ".asc" ".gpg"))
 797             default-directory))
 798      (list keys
 799            (expand-file-name
 800             (read-file-name
 801              (concat "To file (default "
 802                      (file-name-nondirectory default-name)
 803                      ") ")
 804              (file-name-directory default-name)
 805              default-name)))))
 806   (let ((context (epg-make-context)))
 807     (epg-context-set-armor context epa-armor)
 808     (message "Exporting to %s..." (file-name-nondirectory file))
 809     (epg-export-keys-to-file context keys file)
 810     (message "Exporting to %s...done" (file-name-nondirectory file))))
 811
 812 ;;;###autoload
 813 (defun epa-sign-keys (keys &optional local)
 814   "Sign selected KEYS.
 815 If LOCAL is non-nil, the signature is marked as non exportable."
 816   (interactive
 817    (let ((keys (epa-marked-keys)))
 818      (unless keys
 819        (error "No keys selected"))
 820      (list keys current-prefix-arg)))
 821   (let ((context (epg-make-context)))
 822     (message "Signing keys...")
 823     (epg-sign-keys context keys local)
 824     (message "Signing keys...done")))
 825
 826 (provide 'epa)
 827
 828 ;;; epa.el ends here