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