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