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       (set-buffer epa-keys-buffer)
 368       (erase-buffer)
 369       (insert prompt "\n")
 370       (widget-create 'link
 371                      :notify (lambda (&rest ignore) (abort-recursive-edit))
 372                      :help-echo
 373                      (substitute-command-keys
 374                       "Click here or \\[abort-recursive-edit] to cancel")
 375                      "Cancel")
 376       (widget-create 'link
 377                      :notify (lambda (&rest ignore) (exit-recursive-edit))
 378                      :help-echo
 379                      (substitute-command-keys
 380                       "Click here or \\[exit-recursive-edit] to finish")
 381                      "OK")
 382       (insert "\n\n")
 383       (if names
 384           (while names
 385             (epa-insert-keys context (car names) secret)
 386             (if (get-text-property (point) 'epa-list-keys)
 387                 (epa-mark))
 388             (goto-char (point-max))
 389             (setq names (cdr names)))
 390         (if secret
 391             (progn
 392               (epa-insert-keys context nil secret)
 393               (if (get-text-property (point) 'epa-list-keys)
 394                   (epa-mark)))
 395           (epa-insert-keys context nil nil)))
 396       (epa-keys-mode)
 397       (setq epa-exit-buffer-function #'abort-recursive-edit)
 398       (goto-char (point-min))
 399       (pop-to-buffer (current-buffer)))
 400     (unwind-protect
 401         (progn
 402           (recursive-edit)
 403           (epa-marked-keys))
 404       (if (get-buffer-window epa-keys-buffer)
 405           (delete-window (get-buffer-window epa-keys-buffer)))
 406       (kill-buffer epa-keys-buffer))))
 407
 408 (defun epa-show-key (key)
 409   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 410          (entry (assoc (epg-sub-key-id primary-sub-key)
 411                        epa-key-buffer-alist))
 412          (inhibit-read-only t)
 413          buffer-read-only
 414          pointer)
 415     (unless entry
 416       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 417             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 418     (unless (and (cdr entry)
 419                  (buffer-live-p (cdr entry)))
 420       (setcdr entry (generate-new-buffer
 421                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 422     (set-buffer (cdr entry))
 423     (make-local-variable 'epa-key)
 424     (setq epa-key key)
 425     (erase-buffer)
 426     (setq pointer (epg-key-user-id-list key))
 427     (while pointer
 428       (insert " "
 429               (if (epg-user-id-validity (car pointer))
 430                   (char-to-string
 431                    (car (rassq (epg-user-id-validity (car pointer))
 432                                epg-key-validity-alist)))
 433                 " ")
 434               " "
 435               (if (stringp (epg-user-id-string (car pointer)))
 436                   (epg-user-id-string (car pointer))
 437                 (epg-decode-dn (epg-user-id-string (car pointer))))
 438               "\n")
 439       (setq pointer (cdr pointer)))
 440     (setq pointer (epg-key-sub-key-list key))
 441     (while pointer
 442       (insert " "
 443               (if (epg-sub-key-validity (car pointer))
 444                   (char-to-string
 445                    (car (rassq (epg-sub-key-validity (car pointer))
 446                                epg-key-validity-alist)))
 447                 " ")
 448               " "
 449               (epg-sub-key-id (car pointer))
 450               " "
 451               (format "%dbits"
 452                       (epg-sub-key-length (car pointer)))
 453               " "
 454               (cdr (assq (epg-sub-key-algorithm (car pointer))
 455                          epg-pubkey-algorithm-alist))
 456               "\n\tCreated: "
 457               (format-time-string "%Y-%m-%d"
 458                                   (epg-sub-key-creation-time (car pointer)))
 459               (if (epg-sub-key-expiration-time (car pointer))
 460                   (format "\n\tExpires: %s"
 461                           (format-time-string "%Y-%m-%d"
 462                                               (epg-sub-key-expiration-time
 463                                                (car pointer))))
 464                 "")
 465               "\n\tCapabilities: "
 466               (mapconcat #'symbol-name
 467                          (epg-sub-key-capability (car pointer))
 468                          " ")
 469               "\n\tFingerprint: "
 470               (epg-sub-key-fingerprint (car pointer))
 471               "\n")
 472       (setq pointer (cdr pointer)))
 473     (goto-char (point-min))
 474     (pop-to-buffer (current-buffer))
 475     (epa-key-mode)))
 476
 477 (defun epa-show-key-notify (widget &rest ignore)
 478   (epa-show-key (widget-get widget :value)))
 479
 480 (defun epa-mark (&optional arg)
 481   "Mark the current line.
 482 If ARG is non-nil, unmark the current line."
 483   (interactive "P")
 484   (let ((inhibit-read-only t)
 485         buffer-read-only
 486         properties)
 487     (beginning-of-line)
 488     (setq properties (text-properties-at (point)))
 489     (delete-char 1)
 490     (insert (if arg " " "*"))
 491     (set-text-properties (1- (point)) (point) properties)
 492     (forward-line)))
 493
 494 (defun epa-unmark (&optional arg)
 495   "Unmark the current line.
 496 If ARG is non-nil, mark the current line."
 497   (interactive "P")
 498   (epa-mark (not arg)))
 499
 500 (defun epa-toggle-mark ()
 501   "Toggle the mark the current line."
 502   (interactive)
 503   (epa-mark (eq (char-after (save-excursion (beginning-of-line) (point))) ?*)))
 504
 505 (defun epa-exit-buffer ()
 506   "Exit the current buffer.
 507 `epa-exit-buffer-function' is called if it is set."
 508   (interactive)
 509   (funcall epa-exit-buffer-function))
 510
 511 (defun epa-display-verify-result (verify-result)
 512   (if epa-popup-info-window
 513       (progn
 514         (unless epa-info-buffer
 515           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 516         (save-excursion
 517           (set-buffer epa-info-buffer)
 518           (let ((inhibit-read-only t)
 519                 buffer-read-only)
 520             (erase-buffer)
 521             (insert (epg-verify-result-to-string verify-result)))
 522           (epa-info-mode))
 523         (pop-to-buffer epa-info-buffer)
 524         (if (> (window-height) epa-info-window-height)
 525             (shrink-window (- (window-height) epa-info-window-height)))
 526         (goto-char (point-min)))
 527     (message "%s" (epg-verify-result-to-string verify-result))))
 528
 529 (defun epa-info-mode ()
 530   "Major mode for `epa-info-buffer'."
 531   (kill-all-local-variables)
 532   (buffer-disable-undo)
 533   (setq major-mode 'epa-info-mode
 534         mode-name "Info"
 535         truncate-lines t
 536         buffer-read-only t)
 537   (use-local-map epa-info-mode-map)
 538   (run-hooks 'epa-info-mode-hook))
 539
 540 ;;;###autoload
 541 (defun epa-decrypt-file (file)
 542   "Decrypt FILE."
 543   (interactive "fFile: ")
 544   (let* ((default-name (file-name-sans-extension file))
 545          (plain (expand-file-name
 546                  (read-file-name
 547                   (concat "To file (default "
 548                           (file-name-nondirectory default-name)
 549                           ") ")
 550                   (file-name-directory default-name)
 551                   default-name)))
 552          (context (epg-make-context)))
 553     (message "Decrypting %s..." (file-name-nondirectory file))
 554     (epg-decrypt-file context file plain)
 555     (message "Decrypting %s...done" (file-name-nondirectory file))
 556     (if (epg-context-result-for context 'verify)
 557         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 558
 559 ;;;###autoload
 560 (defun epa-verify-file (file)
 561   "Verify FILE."
 562   (interactive "fFile: ")
 563   (let* ((context (epg-make-context))
 564          (plain (if (equal (file-name-extension file) "sig")
 565                     (file-name-sans-extension file))))
 566     (message "Verifying %s..." (file-name-nondirectory file))
 567     (epg-verify-file context file plain)
 568     (message "Verifying %s...done" (file-name-nondirectory file))
 569     (if (epg-context-result-for context 'verify)
 570         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 571
 572 ;;;###autoload
 573 (defun epa-sign-file (file signers mode)
 574   "Sign FILE by SIGNERS keys selected."
 575   (interactive
 576    (list (expand-file-name (read-file-name "File: "))
 577          (epa-select-keys (epg-make-context) "Select keys for signing.
 578 If no one is selected, default secret key is used.  "
 579                           nil t)
 580          (if (y-or-n-p "Make a detached signature? ")
 581              'detached
 582            (if (y-or-n-p "Make a cleartext signature? ")
 583                'clear))))
 584   (let ((signature (concat file
 585                            (if (or epa-armor
 586                                    (not (memq mode '(nil t normal detached))))
 587                                ".asc"
 588                              (if (memq mode '(t detached))
 589                                  ".sig"
 590                                ".gpg"))))
 591         (context (epg-make-context)))
 592     (epg-context-set-armor context epa-armor)
 593     (epg-context-set-textmode context epa-textmode)
 594     (epg-context-set-signers context signers)
 595     (message "Signing %s..." (file-name-nondirectory file))
 596     (epg-sign-file context file signature mode)
 597     (message "Signing %s...done" (file-name-nondirectory file))))
 598
 599 ;;;###autoload
 600 (defun epa-encrypt-file (file recipients)
 601   "Encrypt FILE for RECIPIENTS."
 602   (interactive
 603    (list (expand-file-name (read-file-name "File: "))
 604          (epa-select-keys (epg-make-context) "Select recipients for encryption.
 605 If no one is selected, symmetric encryption will be performed.  ")))
 606   (let ((cipher (concat file (if epa-armor ".asc" ".gpg")))
 607         (context (epg-make-context)))
 608     (epg-context-set-armor context epa-armor)
 609     (epg-context-set-textmode context epa-textmode)
 610     (message "Encrypting %s..." (file-name-nondirectory file))
 611     (epg-encrypt-file context file recipients cipher)
 612     (message "Encrypting %s...done" (file-name-nondirectory file))))
 613
 614 ;;;###autoload
 615 (defun epa-decrypt-region (start end)
 616   "Decrypt the current region between START and END.
 617
 618 Don't use this command in Lisp programs!"
 619   (interactive "r")
 620   (save-excursion
 621     (let ((context (epg-make-context))
 622           plain)
 623       (message "Decrypting...")
 624       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 625       (message "Decrypting...done")
 626       (delete-region start end)
 627       (goto-char start)
 628       (insert (decode-coding-string plain coding-system-for-read))
 629       (if (epg-context-result-for context 'verify)
 630           (epa-display-verify-result (epg-context-result-for context 'verify))))))
 631
 632 ;;;###autoload
 633 (defun epa-decrypt-armor-in-region (start end)
 634   "Decrypt OpenPGP armors in the current region between START and END.
 635
 636 Don't use this command in Lisp programs!"
 637   (interactive "r")
 638   (save-excursion
 639     (save-restriction
 640       (narrow-to-region start end)
 641       (goto-char start)
 642       (let (armor-start armor-end charset coding-system)
 643         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 644           (setq armor-start (match-beginning 0)
 645                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 646                                              nil t))
 647           (unless armor-end
 648             (error "No armor tail"))
 649           (goto-char armor-start)
 650           (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 651               (setq charset (match-string 1)))
 652           (if coding-system-for-read
 653               (setq coding-system coding-system-for-read)
 654             (if charset
 655                 (setq coding-system (intern (downcase charset)))
 656               (setq coding-system 'utf-8)))
 657           (let ((coding-system-for-read coding-system))
 658             (epa-decrypt-region start end)))))))
 659
 660 ;;;###autoload
 661 (defun epa-verify-region (start end)
 662   "Verify the current region between START and END.
 663
 664 Don't use this command in Lisp programs!"
 665   (interactive "r")
 666   (let ((context (epg-make-context)))
 667     (epg-verify-string context
 668                        (encode-coding-string
 669                         (buffer-substring start end)
 670                         coding-system-for-write))
 671     (if (epg-context-result-for context 'verify)
 672         (epa-display-verify-result (epg-context-result-for context 'verify)))))
 673
 674 ;;;###autoload
 675 (defun epa-verify-armor-in-region (start end)
 676   "Verify OpenPGP armors in the current region between START and END.
 677
 678 Don't use this command in Lisp programs!"
 679   (interactive "r")
 680   (save-excursion
 681     (save-restriction
 682       (narrow-to-region start end)
 683       (goto-char start)
 684       (let (armor-start armor-end)
 685         (while (re-search-forward "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----$"
 686                                   nil t)
 687           (setq armor-start (match-beginning 0))
 688           (if (match-beginning 1)       ;cleartext signed message
 689               (progn
 690                 (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 691                                            nil t)
 692                   (error "Invalid cleartext signed message"))
 693                 (setq armor-end (re-search-forward
 694                                  "^-----END PGP SIGNATURE-----$"
 695                                  nil t)))
 696             (setq armor-end (re-search-forward
 697                              "^-----END PGP MESSAGE-----$"
 698                              nil t)))
 699           (unless armor-end
 700             (error "No armor tail"))
 701           (epa-verify-region armor-start armor-end))))))
 702
 703 ;;;###autoload
 704 (defun epa-sign-region (start end signers mode)
 705   "Sign the current region between START and END by SIGNERS keys selected.
 706
 707 Don't use this command in Lisp programs!"
 708   (interactive
 709    (list (region-beginning) (region-end)
 710          (epa-select-keys (epg-make-context) "Select keys for signing.
 711 If no one is selected, default secret key is used.  "
 712                           nil t)
 713          (if (y-or-n-p "Make a detached signature? ")
 714              'detached
 715            (if (y-or-n-p "Make a cleartext signature? ")
 716                'clear))))
 717   (save-excursion
 718     (let ((context (epg-make-context))
 719           signature)
 720       (epg-context-set-armor context epa-armor)
 721       (epg-context-set-textmode context epa-textmode)
 722       (epg-context-set-signers context signers)
 723       (message "Signing...")
 724       (setq signature (epg-sign-string context
 725                                        (encode-coding-string
 726                                         (buffer-substring start end)
 727                                         coding-system-for-write)
 728                                        mode))
 729       (message "Signing...done")
 730       (delete-region start end)
 731       (insert (decode-coding-string signature coding-system-for-read)))))
 732
 733 ;;;###autoload
 734 (defun epa-encrypt-region (start end recipients)
 735   "Encrypt the current region between START and END for RECIPIENTS.
 736
 737 Don't use this command in Lisp programs!"
 738   (interactive
 739    (list (region-beginning) (region-end)
 740          (epa-select-keys (epg-make-context) "Select recipients for encryption.
 741 If no one is selected, symmetric encryption will be performed.  ")))
 742   (save-excursion
 743     (let ((context (epg-make-context))
 744           cipher)
 745       (epg-context-set-armor context epa-armor)
 746       (epg-context-set-textmode context epa-textmode)
 747       (message "Encrypting...")
 748       (setq cipher (epg-encrypt-string context
 749                                        (encode-coding-string
 750                                         (buffer-substring start end)
 751                                         coding-system-for-write)
 752                                        recipients))
 753       (message "Encrypting...done")
 754       (delete-region start end)
 755       (insert cipher))))
 756
 757 ;;;###autoload
 758 (defun epa-delete-keys (keys &optional allow-secret)
 759   "Delete selected KEYS."
 760   (interactive
 761    (let ((keys (epa-marked-keys)))
 762      (unless keys
 763        (error "No keys selected"))
 764      (list keys
 765            (eq (nth 1 epa-list-keys-arguments) t))))
 766   (let ((context (epg-make-context)))
 767     (message "Deleting...")
 768     (epg-delete-keys context keys allow-secret)
 769     (message "Deleting...done")
 770     (apply #'epa-list-keys epa-list-keys-arguments)))
 771
 772 ;;;###autoload
 773 (defun epa-import-keys (file)
 774   "Import keys from FILE."
 775   (interactive "fFile: ")
 776   (let ((context (epg-make-context)))
 777     (message "Importing %s..." (file-name-nondirectory file))
 778     (epg-import-keys-from-file context (expand-file-name file))
 779     (message "Importing %s...done" (file-name-nondirectory file))
 780     (apply #'epa-list-keys epa-list-keys-arguments)))
 781
 782 ;;;###autoload
 783 (defun epa-export-keys (keys file)
 784   "Export selected KEYS to FILE."
 785   (interactive
 786    (let ((keys (epa-marked-keys))
 787          default-name)
 788      (unless keys
 789        (error "No keys selected"))
 790      (setq default-name
 791            (expand-file-name
 792             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
 793                     (if epa-armor ".asc" ".gpg"))
 794             default-directory))
 795      (list keys
 796            (expand-file-name
 797             (read-file-name
 798              (concat "To file (default "
 799                      (file-name-nondirectory default-name)
 800                      ") ")
 801              (file-name-directory default-name)
 802              default-name)))))
 803   (let ((context (epg-make-context)))
 804     (epg-context-set-armor context epa-armor)
 805     (message "Exporting to %s..." (file-name-nondirectory file))
 806     (epg-export-keys-to-file context keys file)
 807     (message "Exporting to %s...done" (file-name-nondirectory file))))
 808
 809 ;;;###autoload
 810 (defun epa-sign-keys (keys &optional local)
 811   "Sign selected KEYS.
 812 If LOCAL is non-nil, the signature is marked as non exportable."
 813   (interactive
 814    (let ((keys (epa-marked-keys)))
 815      (unless keys
 816        (error "No keys selected"))
 817      (list keys current-prefix-arg)))
 818   (let ((context (epg-make-context)))
 819     (message "Signing keys...")
 820     (epg-sign-keys context keys local)
 821     (message "Signing keys...done")))
 822
 823 (provide 'epa)
 824
 825 ;;; epa.el ends here