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 t
  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 "d" 'epa-decrypt-file)
 175     (define-key keymap "v" 'epa-verify-file)
 176     (define-key keymap "s" 'epa-sign-file)
 177     (define-key keymap "S" 'epa-sign-keys)
 178     (define-key keymap "e" 'epa-encrypt-file)
 179     (define-key keymap "r" 'epa-delete-keys)
 180     (define-key keymap "i" 'epa-import-keys)
 181     (define-key keymap "o" 'epa-export-keys)
 182     (define-key keymap "g" 'epa-list-keys)
 183     (define-key keymap "n" 'next-line)
 184     (define-key keymap "p" 'previous-line)
 185     (define-key keymap " " 'scroll-up)
 186     (define-key keymap [delete] 'scroll-down)
 187     (define-key keymap "q" 'epa-exit-buffer)
 188     keymap))
 189
 190 (defvar epa-exit-buffer-function #'bury-buffer)
 191
 192 (define-widget 'epa-key 'push-button
 193   "Button for representing a epg-key object."
 194   :format "%[%v%]"
 195   :button-face-get 'epa-key-widget-button-face-get
 196   :value-create 'epa-key-widget-value-create
 197   :action 'epa-key-widget-action
 198   :help-echo 'epa-key-widget-help-echo)
 199
 200 (defun epa-key-widget-action (widget &optional event)
 201   (epa-show-key (widget-get widget :value)))
 202
 203 (defun epa-key-widget-value-create (widget)
 204   (let* ((key (widget-get widget :value))
 205          (primary-sub-key (car (epg-key-sub-key-list key)))
 206          (primary-user-id (car (epg-key-user-id-list key))))
 207     (insert (format "%c "
 208                     (if (epg-sub-key-validity primary-sub-key)
 209                         (car (rassq (epg-sub-key-validity primary-sub-key)
 210                                     epg-key-validity-alist))
 211                       ? ))
 212             (epg-sub-key-id primary-sub-key)
 213             " "
 214             (if (stringp (epg-user-id-string primary-user-id))
 215                 (epg-user-id-string primary-user-id)
 216               (epg-decode-dn (epg-user-id-string primary-user-id))))))
 217
 218 (defun epa-key-widget-button-face-get (widget)
 219   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
 220                                               (widget-get widget :value))))))
 221     (if validity
 222         (cdr (assq validity epa-validity-face-alist))
 223       'default)))
 224
 225 (defun epa-key-widget-help-echo (widget)
 226   (format "Show %s"
 227           (epg-sub-key-id (car (epg-key-sub-key-list
 228                                 (widget-get widget :value))))))
 229
 230 (defun epa--temp-buffer-show-function (buffer)
 231   (save-selected-window
 232     (let ((window (or (get-buffer-window buffer)
 233                       (progn
 234                         (select-window (get-largest-window))
 235                         (split-window-vertically)))))
 236       (set-window-buffer window buffer)
 237       (if window
 238           (select-window window))
 239       (unless (pos-visible-in-window-p (point-max))
 240         (enlarge-window (- epa-info-window-height (window-height))))
 241       (let ((height (window-height)))
 242         (if (> height epa-info-window-height)
 243             (shrink-window (- height epa-info-window-height)))
 244         (set-window-start window (point-min)))
 245       (with-current-buffer buffer
 246         (setq buffer-read-only t)))))
 247
 248 (defun epa-display-verify-result (verify-result)
 249   (if epa-popup-info-window
 250       (let ((temp-buffer-show-function #'epa--temp-buffer-show-function))
 251         (unless epa-info-buffer
 252           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 253         (with-output-to-temp-buffer epa-info-buffer
 254           (save-excursion
 255             (set-buffer standard-output)
 256             (insert (epg-verify-result-to-string verify-result)))))
 257     (message "%s" (epg-verify-result-to-string verify-result))))
 258
 259 (defun epa-keys-mode ()
 260   "Major mode for `epa-list-keys'."
 261   (kill-all-local-variables)
 262   (buffer-disable-undo)
 263   (setq major-mode 'epa-keys-mode
 264         mode-name "Keys"
 265         truncate-lines t
 266         buffer-read-only t)
 267   (use-local-map epa-keys-mode-map)
 268   (set-keymap-parent (current-local-map) widget-keymap)
 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   (widget-setup)
 275   (make-local-variable 'epa-exit-buffer-function)
 276   (run-hooks 'epa-keys-mode-hook))
 277
 278 (defvar epa-key-mode-map
 279   (let ((keymap (make-sparse-keymap)))
 280     (define-key keymap "q" 'bury-buffer)
 281     keymap))
 282
 283 (defun epa-key-mode ()
 284   "Major mode for `epa-show-key'."
 285   (kill-all-local-variables)
 286   (buffer-disable-undo)
 287   (setq major-mode 'epa-key-mode
 288         mode-name "Key"
 289         truncate-lines t
 290         buffer-read-only t)
 291   (use-local-map epa-key-mode-map)
 292   (make-local-variable 'font-lock-defaults)
 293   (setq font-lock-defaults '(epa-font-lock-keywords t))
 294   ;; In XEmacs, auto-initialization of font-lock is not effective
 295   ;; if buffer-file-name is not set.
 296   (font-lock-set-defaults)
 297   (make-local-variable 'epa-exit-buffer-function)
 298   (run-hooks 'epa-key-mode-hook))
 299
 300 ;;;###autoload
 301 (defun epa-list-keys (&optional name mode protocol)
 302   (interactive
 303    (if current-prefix-arg
 304        (let ((name (read-string "Pattern: "
 305                                 (if epa-list-keys-arguments
 306                                     (car epa-list-keys-arguments)))))
 307          (list (if (equal name "") nil name)
 308                (y-or-n-p "Secret keys? ")
 309                (intern (completing-read "Protocol? "
 310                                         '(("OpenPGP") ("CMS"))
 311                                         nil t))))
 312      (or epa-list-keys-arguments (list nil nil nil))))
 313   (unless (and epa-keys-buffer
 314                (buffer-live-p epa-keys-buffer))
 315     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 316   (set-buffer epa-keys-buffer)
 317   (let ((inhibit-read-only t)
 318         buffer-read-only
 319         (point (point-min))
 320         (context (epg-make-context protocol)))
 321     (unless (get-text-property point 'epa-list-keys)
 322       (setq point (next-single-property-change point 'epa-list-keys)))
 323     (when point
 324       (delete-region point
 325                      (or (next-single-property-change point 'epa-list-keys)
 326                          (point-max)))
 327       (goto-char point))
 328     (epa-insert-keys context name mode)
 329     (epa-keys-mode))
 330   (make-local-variable 'epa-list-keys-arguments)
 331   (setq epa-list-keys-arguments (list name mode protocol))
 332   (goto-char (point-min))
 333   (pop-to-buffer (current-buffer)))
 334
 335 (defun epa-insert-keys (context name mode)
 336   (save-excursion
 337     (save-restriction
 338       (narrow-to-region (point) (point))
 339       (let ((keys (epg-list-keys context name mode))
 340             point)
 341         (while keys
 342           (setq point (point))
 343           (insert "  ")
 344           (add-text-properties point (point)
 345                                (list 'epa-key (car keys)
 346                                      'front-sticky nil
 347                                      'rear-nonsticky t
 348                                      'start-open t
 349                                      'end-open t))
 350           (widget-create 'epa-key :value (car keys))
 351           (insert "\n")
 352           (setq keys (cdr keys))))
 353       (add-text-properties (point-min) (point-max)
 354                            (list 'epa-list-keys t
 355                                  'front-sticky nil
 356                                  'rear-nonsticky t
 357                                  'start-open t
 358                                  'end-open t)))))
 359
 360 (defun epa-marked-keys ()
 361   (or (save-excursion
 362         (set-buffer epa-keys-buffer)
 363         (goto-char (point-min))
 364         (let (keys key)
 365           (while (re-search-forward "^\\*" nil t)
 366             (if (setq key (get-text-property (match-beginning 0)
 367                                              'epa-key))
 368                 (setq keys (cons key keys))))
 369           (nreverse keys)))
 370       (save-excursion
 371         (beginning-of-line)
 372         (let ((key (get-text-property (point) 'epa-key)))
 373           (if key
 374               (list key))))))
 375
 376 ;;;###autoload
 377 (defun epa-select-keys (context prompt &optional names secret)
 378   "Display a user's keyring and ask him to select keys.
 379 CONTEXT is an epg-context.
 380 PROMPT is a string to prompt with.
 381 NAMES is a list of strings to be matched with keys.  If it is nil, all
 382 the keys are listed.
 383 If SECRET is non-nil, list secret keys instead of public keys."
 384   (save-excursion
 385     (unless (and epa-keys-buffer
 386                  (buffer-live-p epa-keys-buffer))
 387       (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 388     (let ((inhibit-read-only t)
 389           buffer-read-only
 390           point)
 391       (set-buffer epa-keys-buffer)
 392       (erase-buffer)
 393       (insert prompt "\n")
 394       (widget-create 'link
 395                      :notify (lambda (&rest ignore) (abort-recursive-edit))
 396                      :help-echo
 397                      (substitute-command-keys
 398                       "Click here or \\[abort-recursive-edit] to cancel")
 399                      "Cancel")
 400       (widget-create 'link
 401                      :notify (lambda (&rest ignore) (exit-recursive-edit))
 402                      :help-echo
 403                      (substitute-command-keys
 404                       "Click here or \\[exit-recursive-edit] to finish")
 405                      "OK")
 406       (insert "\n\n")
 407       (if names
 408           (while names
 409             (setq point (point))
 410             (epa-insert-keys context (car names) secret)
 411             (goto-char point)
 412             (epa-mark)
 413             (goto-char (point-max))
 414             (setq names (cdr names)))
 415         (epa-insert-keys context nil secret))
 416       (epa-keys-mode)
 417       (setq epa-exit-buffer-function #'abort-recursive-edit)
 418       (goto-char (point-min))
 419       (pop-to-buffer (current-buffer)))
 420     (unwind-protect
 421           (progn
 422             (recursive-edit)
 423             (epa-marked-keys))
 424         (if (get-buffer-window epa-keys-buffer)
 425             (delete-window (get-buffer-window epa-keys-buffer)))
 426         (kill-buffer epa-keys-buffer))))
 427
 428 (defun epa-show-key (key)
 429   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 430          (entry (assoc (epg-sub-key-id primary-sub-key)
 431                        epa-key-buffer-alist))
 432          (inhibit-read-only t)
 433          buffer-read-only
 434          pointer)
 435     (unless entry
 436       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 437             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 438     (unless (and (cdr entry)
 439                  (buffer-live-p (cdr entry)))
 440       (setcdr entry (generate-new-buffer
 441                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 442     (set-buffer (cdr entry))
 443     (make-local-variable 'epa-key)
 444     (setq epa-key key)
 445     (erase-buffer)
 446     (setq pointer (epg-key-user-id-list key))
 447     (while pointer
 448       (insert " "
 449               (if (epg-user-id-validity (car pointer))
 450                   (char-to-string
 451                    (car (rassq (epg-user-id-validity (car pointer))
 452                                epg-key-validity-alist)))
 453                 " ")
 454               " "
 455               (if (stringp (epg-user-id-string (car pointer)))
 456                   (epg-user-id-string (car pointer))
 457                 (epg-decode-dn (epg-user-id-string (car pointer))))
 458               "\n")
 459       (setq pointer (cdr pointer)))
 460     (setq pointer (epg-key-sub-key-list key))
 461     (while pointer
 462       (insert " "
 463               (if (epg-sub-key-validity (car pointer))
 464                   (char-to-string
 465                    (car (rassq (epg-sub-key-validity (car pointer))
 466                                epg-key-validity-alist)))
 467                 " ")
 468               " "
 469               (epg-sub-key-id (car pointer))
 470               " "
 471               (format "%dbits"
 472                       (epg-sub-key-length (car pointer)))
 473               " "
 474               (cdr (assq (epg-sub-key-algorithm (car pointer))
 475                          epg-pubkey-algorithm-alist))
 476               "\n\tCreated: "
 477               (epg-sub-key-creation-time (car pointer))
 478               (if (epg-sub-key-expiration-time (car pointer))
 479                   (format "\n\tExpires: %s" (epg-sub-key-expiration-time
 480                                              (car pointer)))
 481                 "")
 482               "\n\tCapabilities: "
 483               (mapconcat #'symbol-name
 484                          (epg-sub-key-capability (car pointer))
 485                          " ")
 486               "\n\tFingerprint: "
 487               (epg-sub-key-fingerprint (car pointer))
 488               "\n")
 489       (setq pointer (cdr pointer)))
 490     (goto-char (point-min))
 491     (pop-to-buffer (current-buffer))
 492     (epa-key-mode)))
 493
 494 (defun epa-show-key-notify (widget &rest ignore)
 495   (epa-show-key (widget-get widget :value)))
 496
 497 (defun epa-mark (&optional arg)
 498   "Mark the current line.
 499 If ARG is non-nil, unmark the current line."
 500   (interactive "P")
 501   (let ((inhibit-read-only t)
 502         buffer-read-only
 503         properties)
 504     (beginning-of-line)
 505     (setq properties (text-properties-at (point)))
 506     (delete-char 1)
 507     (insert (if arg " " "*"))
 508     (set-text-properties (1- (point)) (point) properties)
 509     (forward-line)))
 510
 511 (defun epa-unmark (&optional arg)
 512   "Unmark the current line.
 513 If ARG is non-nil, mark the current line."
 514   (interactive "P")
 515   (epa-mark (not arg)))
 516
 517 (defun epa-exit-buffer ()
 518   "Exit the current buffer.
 519 `epa-exit-buffer-function' is called if it is set."
 520   (interactive)
 521   (funcall epa-exit-buffer-function))
 522
 523 ;;;###autoload
 524 (defun epa-decrypt-file (file)
 525   "Decrypt FILE."
 526   (interactive "fFile: ")
 527   (let* ((default-name (file-name-sans-extension file))
 528          (plain (expand-file-name
 529                  (read-file-name
 530                   (concat "To file (default "
 531                           (file-name-nondirectory default-name)
 532                           ") ")
 533                   (file-name-directory default-name)
 534                   default-name)))
 535          (context (epg-make-context)))
 536     (message "Decrypting %s..." (file-name-nondirectory file))
 537     (epg-decrypt-file context file plain)
 538     (message "Decrypting %s...done" (file-name-nondirectory file))
 539     (if (epg-context-result-for context 'verify)
 540         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 541
 542 ;;;###autoload
 543 (defun epa-verify-file (file)
 544   "Verify FILE."
 545   (interactive "fFile: ")
 546   (let* ((context (epg-make-context))
 547          (plain (if (equal (file-name-extension file) "sig")
 548                     (file-name-sans-extension file))))
 549     (message "Verifying %s..." (file-name-nondirectory file))
 550     (epg-verify-file context file plain)
 551     (message "Verifying %s...done" (file-name-nondirectory file))
 552     (if (epg-context-result-for context 'verify)
 553         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 554
 555 ;;;###autoload
 556 (defun epa-sign-file (file signers mode)
 557   "Sign FILE by SIGNERS keys selected."
 558   (interactive
 559    (list (expand-file-name (read-file-name "File: "))
 560          (epa-select-keys (epg-make-context) "Select keys for signing.
 561 If no one is selected, default secret key is used.  "
 562                           nil t)
 563          (if (y-or-n-p "Make a detached signature? ")
 564              'detached
 565            (if (y-or-n-p "Make a cleartext signature? ")
 566                'clear))))
 567   (let ((signature (concat file
 568                            (if (or epa-armor
 569                                    (not (memq mode '(nil t normal detached))))
 570                                ".asc"
 571                              (if (memq mode '(t detached))
 572                                  ".sig"
 573                                ".gpg"))))
 574         (context (epg-make-context)))
 575     (epg-context-set-armor context epa-armor)
 576     (epg-context-set-textmode context epa-textmode)
 577     (epg-context-set-signers context signers)
 578     (message "Signing %s..." (file-name-nondirectory file))
 579     (epg-sign-file context file signature mode)
 580     (message "Signing %s...done" (file-name-nondirectory file))))
 581
 582 ;;;###autoload
 583 (defun epa-encrypt-file (file recipients)
 584   "Encrypt FILE for RECIPIENTS."
 585   (interactive
 586    (list (expand-file-name (read-file-name "File: "))
 587          (epa-select-keys (epg-make-context) "Select recipents for encryption.
 588 If no one is selected, symmetric encryption will be performed.  ")))
 589   (let ((cipher (concat file (if epa-armor ".asc" ".gpg")))
 590         (context (epg-make-context)))
 591     (epg-context-set-armor context epa-armor)
 592     (epg-context-set-textmode context epa-textmode)
 593     (message "Encrypting %s..." (file-name-nondirectory file))
 594     (epg-encrypt-file context file recipients cipher)
 595     (message "Encrypting %s...done" (file-name-nondirectory file))))
 596
 597 ;;;###autoload
 598 (defun epa-decrypt-region (start end)
 599   "Decrypt the current region between START and END.
 600
 601 Don't use this command in Lisp programs!"
 602   (interactive "r")
 603   (save-excursion
 604     (let ((context (epg-make-context))
 605           plain)
 606       (message "Decrypting...")
 607       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 608       (message "Decrypting...done")
 609       (delete-region start end)
 610       (goto-char start)
 611       (insert (decode-coding-string plain coding-system-for-read))
 612       (if (epg-context-result-for context 'verify)
 613           (epa-display-verify-result (epg-context-result-for context 'verify))))))
 614
 615 ;;;###autoload
 616 (defun epa-decrypt-armor-in-region (start end)
 617   "Decrypt OpenPGP armors in the current region between START and END.
 618
 619 Don't use this command in Lisp programs!"
 620   (interactive "r")
 621   (save-excursion
 622     (save-restriction
 623       (narrow-to-region start end)
 624       (goto-char start)
 625       (let (armor-start armor-end charset coding-system)
 626         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 627           (setq armor-start (match-beginning 0)
 628                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 629                                              nil t))
 630           (unless armor-end
 631             (error "No armor tail"))
 632           (goto-char armor-start)
 633           (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 634               (setq charset (match-string 1)))
 635           (if coding-system-for-read
 636               (setq coding-system coding-system-for-read)
 637             (if charset
 638                 (setq coding-system (intern (downcase charset)))
 639               (setq coding-system 'utf-8)))
 640           (let ((coding-system-for-read coding-system))
 641             (epa-decrypt-region start end)))))))
 642
 643 ;;;###autoload
 644 (defun epa-verify-region (start end)
 645   "Verify the current region between START and END.
 646
 647 Don't use this command in Lisp programs!"
 648   (interactive "r")
 649   (let ((context (epg-make-context)))
 650     (epg-verify-string context
 651                        (encode-coding-string
 652                         (buffer-substring start end)
 653                         coding-system-for-write))
 654     (if (epg-context-result-for context 'verify)
 655         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 656
 657 ;;;###autoload
 658 (defun epa-verify-armor-in-region (start end)
 659   "Verify OpenPGP armors in the current region between START and END.
 660
 661 Don't use this command in Lisp programs!"
 662   (interactive "r")
 663   (save-excursion
 664     (save-restriction
 665       (narrow-to-region start end)
 666       (goto-char start)
 667       (let (armor-start armor-end)
 668         (while (re-search-forward "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----$"
 669                                   nil t)
 670           (setq armor-start (match-beginning 0))
 671           (if (match-beginning 1)       ;cleartext signed message
 672               (progn
 673                 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 674                                            nil t)
 675                   (error "Invalid cleartext signed message"))
 676                 (setq armor-end (re-search-forward
 677                                  "^-----END PGP SIGNATURE-----$"
 678                                  nil t)))
 679             (setq armor-end (re-search-forward
 680                              "^-----END PGP MESSAGE-----$"
 681                              nil t)))
 682           (unless armor-end
 683             (error "No armor tail"))
 684           (epa-verify-region armor-start armor-end))))))
 685
 686 ;;;###autoload
 687 (defun epa-sign-region (start end signers mode)
 688   "Sign the current region between START and END by SIGNERS keys selected.
 689
 690 Don't use this command in Lisp programs!"
 691   (interactive
 692    (list (region-beginning) (region-end)
 693          (epa-select-keys (epg-make-context) "Select keys for signing.
 694 If no one is selected, default secret key is used.  "
 695                           nil t)
 696          (if (y-or-n-p "Make a detached signature? ")
 697              'detached
 698            (if (y-or-n-p "Make a cleartext signature? ")
 699                'clear))))
 700   (save-excursion
 701     (let ((context (epg-make-context))
 702           signature)
 703       (epg-context-set-armor context epa-armor)
 704       (epg-context-set-textmode context epa-textmode)
 705       (epg-context-set-signers context signers)
 706       (message "Signing...")
 707       (setq signature (epg-sign-string context
 708                                        (encode-coding-string
 709                                         (buffer-substring start end)
 710                                         coding-system-for-write)
 711                                        mode))
 712       (message "Signing...done")
 713       (delete-region start end)
 714       (insert (decode-coding-string signature coding-system-for-read)))))
 715
 716 ;;;###autoload
 717 (defun epa-encrypt-region (start end recipients)
 718   "Encrypt the current region between START and END for RECIPIENTS.
 719
 720 Don't use this command in Lisp programs!"
 721   (interactive
 722    (list (region-beginning) (region-end)
 723          (epa-select-keys (epg-make-context) "Select recipents for encryption.
 724 If no one is selected, symmetric encryption will be performed.  ")))
 725   (save-excursion
 726     (let ((context (epg-make-context))
 727           cipher)
 728       (epg-context-set-armor context epa-armor)
 729       (epg-context-set-textmode context epa-textmode)
 730       (message "Encrypting...")
 731       (setq cipher (epg-encrypt-string context
 732                                        (encode-coding-string
 733                                         (buffer-substring start end)
 734                                         coding-system-for-write)
 735                                        recipients))
 736       (message "Encrypting...done")
 737       (delete-region start end)
 738       (insert cipher))))
 739
 740 ;;;###autoload
 741 (defun epa-delete-keys (keys &optional allow-secret)
 742   "Delete selected KEYS."
 743   (interactive
 744    (let ((keys (epa-marked-keys)))
 745      (unless keys
 746        (error "No keys selected"))
 747      (list keys
 748            (eq (nth 1 epa-list-keys-arguments) t))))
 749   (let ((context (epg-make-context)))
 750     (message "Deleting...")
 751     (epg-delete-keys context keys allow-secret)
 752     (message "Deleting...done")
 753     (apply #'epa-list-keys epa-list-keys-arguments)))
 754
 755 ;;;###autoload
 756 (defun epa-import-keys (file)
 757   "Import keys from FILE."
 758   (interactive "fFile: ")
 759   (let ((context (epg-make-context)))
 760     (message "Importing %s..." (file-name-nondirectory file))
 761     (epg-import-keys-from-file context (expand-file-name file))
 762     (message "Importing %s...done" (file-name-nondirectory file))
 763     (apply #'epa-list-keys epa-list-keys-arguments)))
 764
 765 ;;;###autoload
 766 (defun epa-export-keys (keys file)
 767   "Export selected KEYS to FILE."
 768   (interactive
 769    (let ((keys (epa-marked-keys))
 770          default-name)
 771      (unless keys
 772        (error "No keys selected"))
 773      (setq default-name
 774            (expand-file-name
 775             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
 776                     (if epa-armor ".asc" ".gpg"))
 777             default-directory))
 778      (list keys
 779            (expand-file-name
 780             (read-file-name
 781              (concat "To file (default "
 782                      (file-name-nondirectory default-name)
 783                      ") ")
 784              (file-name-directory default-name)
 785              default-name)))))
 786   (let ((context (epg-make-context)))
 787     (epg-context-set-armor context epa-armor)
 788     (message "Exporting to %s..." (file-name-nondirectory file))
 789     (epg-export-keys-to-file context keys file)
 790     (message "Exporting to %s...done" (file-name-nondirectory file))))
 791
 792 ;;;###autoload
 793 (defun epa-sign-keys (keys &optional local)
 794   "Sign selected KEYS.
 795 If LOCAL is non-nil, the signature is marked as non exportable."
 796   (interactive
 797    (let ((keys (epa-marked-keys)))
 798      (unless keys
 799        (error "No keys selected"))
 800      (list keys current-prefix-arg)))
 801   (let ((context (epg-make-context)))
 802     (message "Signing keys...")
 803     (epg-sign-keys context keys local)
 804     (message "Signing keys...done")))
 805
 806 (provide 'epa)
 807
 808 ;;; epa.el ends here