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)
 333   "List all keys matched with NAME from the keyring.
 334 If MODE is non-nil, it reads the private keyring.  Otherwise, it
 335 reads the public keyring."
 336   (interactive
 337    (if current-prefix-arg
 338        (let ((name (read-string "Pattern: "
 339                                 (if epa-list-keys-arguments
 340                                     (car epa-list-keys-arguments)))))
 341          (list (if (equal name "") nil name)
 342                (y-or-n-p "Secret keys? ")))
 343      (or epa-list-keys-arguments (list nil nil))))
 344   (unless (and epa-keys-buffer
 345                (buffer-live-p epa-keys-buffer))
 346     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 347   (set-buffer epa-keys-buffer)
 348   (let ((inhibit-read-only t)
 349         buffer-read-only
 350         (point (point-min))
 351         (context (epg-make-context epa-protocol)))
 352     (unless (get-text-property point 'epa-list-keys)
 353       (setq point (next-single-property-change point 'epa-list-keys)))
 354     (when point
 355       (delete-region point
 356                      (or (next-single-property-change point 'epa-list-keys)
 357                          (point-max)))
 358       (goto-char point))
 359     (epa--insert-keys context name mode)
 360     (epa-keys-mode)
 361     (widget-setup)
 362     (set-keymap-parent (current-local-map) widget-keymap))
 363   (make-local-variable 'epa-list-keys-arguments)
 364   (setq epa-list-keys-arguments (list name mode))
 365   (goto-char (point-min))
 366   (pop-to-buffer (current-buffer)))
 367
 368 (defun epa--insert-keys (context name mode)
 369   (save-excursion
 370     (save-restriction
 371       (narrow-to-region (point) (point))
 372       (let ((keys (epg-list-keys context name mode))
 373             point)
 374         (while keys
 375           (setq point (point))
 376           (insert "  ")
 377           (add-text-properties point (point)
 378                                (list 'epa-key (car keys)
 379                                      'front-sticky nil
 380                                      'rear-nonsticky t
 381                                      'start-open t
 382                                      'end-open t))
 383           (widget-create 'epa-key :value (car keys))
 384           (insert "\n")
 385           (setq keys (cdr keys))))
 386       (add-text-properties (point-min) (point-max)
 387                            (list 'epa-list-keys t
 388                                  'front-sticky nil
 389                                  'rear-nonsticky t
 390                                  'start-open t
 391                                  'end-open t)))))
 392
 393 (defun epa--marked-keys ()
 394   (or (save-excursion
 395         (set-buffer epa-keys-buffer)
 396         (goto-char (point-min))
 397         (let (keys key)
 398           (while (re-search-forward "^\\*" nil t)
 399             (if (setq key (get-text-property (match-beginning 0)
 400                                              'epa-key))
 401                 (setq keys (cons key keys))))
 402           (nreverse keys)))
 403       (save-excursion
 404         (beginning-of-line)
 405         (let ((key (get-text-property (point) 'epa-key)))
 406           (if key
 407               (list key))))))
 408
 409 ;;;###autoload
 410 (defun epa-select-keys (context prompt &optional names secret)
 411   "Display a user's keyring and ask him to select keys.
 412 CONTEXT is an epg-context.
 413 PROMPT is a string to prompt with.
 414 NAMES is a list of strings to be matched with keys.  If it is nil, all
 415 the keys are listed.
 416 If SECRET is non-nil, list secret keys instead of public keys."
 417   (save-excursion
 418     (unless (and epa-keys-buffer
 419                  (buffer-live-p epa-keys-buffer))
 420       (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 421     (let ((inhibit-read-only t)
 422           buffer-read-only)
 423       (set-buffer epa-keys-buffer)
 424       (erase-buffer)
 425       (insert prompt "\n")
 426       (widget-create 'link
 427                      :notify (lambda (&rest ignore) (abort-recursive-edit))
 428                      :help-echo
 429                      (substitute-command-keys
 430                       "Click here or \\[abort-recursive-edit] to cancel")
 431                      "Cancel")
 432       (widget-create 'link
 433                      :notify (lambda (&rest ignore) (exit-recursive-edit))
 434                      :help-echo
 435                      (substitute-command-keys
 436                       "Click here or \\[exit-recursive-edit] to finish")
 437                      "OK")
 438       (insert "\n\n")
 439       (if names
 440           (while names
 441             (epa--insert-keys context (car names) secret)
 442             (if (get-text-property (point) 'epa-list-keys)
 443                 (epa-mark))
 444             (goto-char (point-max))
 445             (setq names (cdr names)))
 446         (if secret
 447             (progn
 448               (epa--insert-keys context nil secret)
 449               (if (get-text-property (point) 'epa-list-keys)
 450                   (epa-mark)))
 451           (epa--insert-keys context nil nil)))
 452       (epa-keys-mode)
 453       (widget-setup)
 454       (set-keymap-parent (current-local-map) widget-keymap)
 455       (setq epa-exit-buffer-function #'abort-recursive-edit)
 456       (goto-char (point-min))
 457       (pop-to-buffer (current-buffer)))
 458     (unwind-protect
 459         (progn
 460           (recursive-edit)
 461           (epa--marked-keys))
 462       (if (get-buffer-window epa-keys-buffer)
 463           (delete-window (get-buffer-window epa-keys-buffer)))
 464       (kill-buffer epa-keys-buffer))))
 465
 466 (defun epa--show-key (key)
 467   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 468          (entry (assoc (epg-sub-key-id primary-sub-key)
 469                        epa-key-buffer-alist))
 470          (inhibit-read-only t)
 471          buffer-read-only
 472          pointer)
 473     (unless entry
 474       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 475             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 476     (unless (and (cdr entry)
 477                  (buffer-live-p (cdr entry)))
 478       (setcdr entry (generate-new-buffer
 479                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 480     (set-buffer (cdr entry))
 481     (make-local-variable 'epa-key)
 482     (setq epa-key key)
 483     (erase-buffer)
 484     (setq pointer (epg-key-user-id-list key))
 485     (while pointer
 486       (if (car pointer)
 487           (insert " "
 488                   (if (epg-user-id-validity (car pointer))
 489                       (char-to-string
 490                        (car (rassq (epg-user-id-validity (car pointer))
 491                                    epg-key-validity-alist)))
 492                     " ")
 493                   " "
 494                   (if (stringp (epg-user-id-string (car pointer)))
 495                       (epg-user-id-string (car pointer))
 496                     (epg-decode-dn (epg-user-id-string (car pointer))))
 497                   "\n"))
 498       (setq pointer (cdr pointer)))
 499     (setq pointer (epg-key-sub-key-list key))
 500     (while pointer
 501       (insert " "
 502               (if (epg-sub-key-validity (car pointer))
 503                   (char-to-string
 504                    (car (rassq (epg-sub-key-validity (car pointer))
 505                                epg-key-validity-alist)))
 506                 " ")
 507               " "
 508               (epg-sub-key-id (car pointer))
 509               " "
 510               (format "%dbits"
 511                       (epg-sub-key-length (car pointer)))
 512               " "
 513               (cdr (assq (epg-sub-key-algorithm (car pointer))
 514                          epg-pubkey-algorithm-alist))
 515               "\n\tCreated: "
 516               (format-time-string "%Y-%m-%d"
 517                                   (epg-sub-key-creation-time (car pointer)))
 518               (if (epg-sub-key-expiration-time (car pointer))
 519                   (format "\n\tExpires: %s"
 520                           (format-time-string "%Y-%m-%d"
 521                                               (epg-sub-key-expiration-time
 522                                                (car pointer))))
 523                 "")
 524               "\n\tCapabilities: "
 525               (mapconcat #'symbol-name
 526                          (epg-sub-key-capability (car pointer))
 527                          " ")
 528               "\n\tFingerprint: "
 529               (epg-sub-key-fingerprint (car pointer))
 530               "\n")
 531       (setq pointer (cdr pointer)))
 532     (goto-char (point-min))
 533     (pop-to-buffer (current-buffer))
 534     (epa-key-mode)))
 535
 536 (defun epa-display-info (info)
 537   (if epa-popup-info-window
 538       (save-selected-window
 539         (unless epa-info-buffer
 540           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 541         (save-excursion
 542           (set-buffer epa-info-buffer)
 543           (let ((inhibit-read-only t)
 544                 buffer-read-only)
 545             (erase-buffer)
 546             (insert info))
 547           (epa-info-mode)
 548           (goto-char (point-min)))
 549         (if (> (window-height)
 550                epa-info-window-height)
 551             (set-window-buffer (split-window nil (- (window-height)
 552                                                     epa-info-window-height))
 553                                epa-info-buffer)
 554           (pop-to-buffer epa-info-buffer)
 555           (if (> (window-height) epa-info-window-height)
 556               (shrink-window (- (window-height) epa-info-window-height)))))
 557     (message "%s" info)))
 558
 559 (defun epa-display-verify-result (verify-result)
 560   (epa-display-info (epg-verify-result-to-string verify-result)))
 561 (make-obsolete 'epa-display-verify-result 'epa-display-info)
 562
 563 (defun epa-passphrase-callback-function (context key-id handback)
 564   (if (eq key-id 'SYM)
 565       (read-passwd "Passphrase for symmetric encryption: "
 566                    (eq (epg-context-operation context) 'encrypt))
 567     (read-passwd
 568      (if (eq key-id 'PIN)
 569         "Passphrase for PIN: "
 570        (let ((entry (assoc key-id epg-user-id-alist)))
 571          (if entry
 572              (format "Passphrase for %s %s: " key-id (cdr entry))
 573            (format "Passphrase for %s: " key-id)))))))
 574
 575 (defun epa-progress-callback-function (context what char current total
 576                                                handback)
 577   (message "%s: %d%% (%d/%d)" what
 578            (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
 579            current total))
 580
 581 ;;;###autoload
 582 (defun epa-decrypt-file (file)
 583   "Decrypt FILE."
 584   (interactive "fFile: ")
 585   (setq file (expand-file-name file))
 586   (let* ((default-name (file-name-sans-extension file))
 587          (plain (expand-file-name
 588                  (read-file-name
 589                   (concat "To file (default "
 590                           (file-name-nondirectory default-name)
 591                           ") ")
 592                   (file-name-directory default-name)
 593                   default-name)))
 594          (context (epg-make-context epa-protocol)))
 595     (epg-context-set-passphrase-callback context
 596                                          #'epa-passphrase-callback-function)
 597     (epg-context-set-progress-callback context
 598                                        #'epa-progress-callback-function)
 599     (message "Decrypting %s..." (file-name-nondirectory file))
 600     (epg-decrypt-file context file plain)
 601     (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
 602              (file-name-nondirectory plain))
 603     (if (epg-context-result-for context 'verify)
 604         (epa-display-info (epg-verify-result-to-string
 605                            (epg-context-result-for context 'verify))))))
 606
 607 ;;;###autoload
 608 (defun epa-verify-file (file)
 609   "Verify FILE."
 610   (interactive "fFile: ")
 611   (setq file (expand-file-name file))
 612   (let* ((context (epg-make-context epa-protocol))
 613          (plain (if (equal (file-name-extension file) "sig")
 614                     (file-name-sans-extension file))))
 615     (epg-context-set-progress-callback context
 616                                        #'epa-progress-callback-function)
 617     (message "Verifying %s..." (file-name-nondirectory file))
 618     (epg-verify-file context file plain)
 619     (message "Verifying %s...done" (file-name-nondirectory file))
 620     (if (epg-context-result-for context 'verify)
 621         (epa-display-info (epg-verify-result-to-string
 622                            (epg-context-result-for context 'verify))))))
 623
 624 ;;;###autoload
 625 (defun epa-sign-file (file signers mode)
 626   "Sign FILE by SIGNERS keys selected."
 627   (interactive
 628    (list (expand-file-name (read-file-name "File: "))
 629          (epa-select-keys (epg-make-context epa-protocol)
 630                           "Select keys for signing.
 631 If no one is selected, default secret key is used.  "
 632                           nil t)
 633          (catch 'done
 634            (while t
 635              (message "Signature type (n,c,d,?) ")
 636              (let ((c (read-char)))
 637                (cond ((eq c ?c)
 638                       (throw 'done 'clear))
 639                      ((eq c ?d)
 640                       (throw 'done 'detached))
 641                      ((eq c ??)
 642                       (with-output-to-temp-buffer "*Help*"
 643                         (save-excursion
 644                           (set-buffer standard-output)
 645                           (insert "\
 646 n - Create a normal signature
 647 c - Create a cleartext signature
 648 d - Create a detached signature
 649 ? - Show this help
 650 "))))
 651                      (t
 652                       (throw 'done nil))))))))
 653   (let ((signature (concat file
 654                            (if (eq epa-protocol 'OpenPGP)
 655                                (if (or epa-armor
 656                                        (not (memq mode
 657                                                   '(nil t normal detached))))
 658                                    ".asc"
 659                                  (if (memq mode '(t detached))
 660                                      ".sig"
 661                                    ".gpg"))
 662                              (if (memq mode '(t detached))
 663                                  ".p7s"
 664                                ".p7m"))))
 665         (context (epg-make-context epa-protocol)))
 666     (epg-context-set-armor context epa-armor)
 667     (epg-context-set-textmode context epa-textmode)
 668     (epg-context-set-signers context signers)
 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 "Signing %s..." (file-name-nondirectory file))
 674     (epg-sign-file context file signature mode)
 675     (message "Signing %s...wrote %s" (file-name-nondirectory file)
 676              (file-name-nondirectory signature))))
 677
 678 ;;;###autoload
 679 (defun epa-encrypt-file (file recipients)
 680   "Encrypt FILE for RECIPIENTS."
 681   (interactive
 682    (list (expand-file-name (read-file-name "File: "))
 683          (epa-select-keys (epg-make-context epa-protocol)
 684                           "Select recipients for encryption.
 685 If no one is selected, symmetric encryption will be performed.  ")))
 686   (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
 687                                  (if epa-armor ".asc" ".gpg")
 688                                ".p7m")))
 689         (context (epg-make-context epa-protocol)))
 690     (epg-context-set-armor context epa-armor)
 691     (epg-context-set-textmode context epa-textmode)
 692     (epg-context-set-passphrase-callback context
 693                                          #'epa-passphrase-callback-function)
 694     (epg-context-set-progress-callback context
 695                                        #'epa-progress-callback-function)
 696     (message "Encrypting %s..." (file-name-nondirectory file))
 697     (epg-encrypt-file context file recipients cipher)
 698     (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
 699              (file-name-nondirectory cipher))))
 700
 701 ;;;###autoload
 702 (defun epa-decrypt-region (start end)
 703   "Decrypt the current region between START and END.
 704
 705 Don't use this command in Lisp programs!"
 706   (interactive "r")
 707   (save-excursion
 708     (let ((context (epg-make-context epa-protocol))
 709           plain)
 710       (epg-context-set-passphrase-callback context
 711                                            #'epa-passphrase-callback-function)
 712       (epg-context-set-progress-callback context
 713                                          #'epa-progress-callback-function)
 714       (message "Decrypting...")
 715       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 716       (message "Decrypting...done")
 717       (delete-region start end)
 718       (goto-char start)
 719       (insert (epa--decode-coding-string plain coding-system-for-read))
 720       (if (epg-context-result-for context 'verify)
 721           (epa-display-info (epg-verify-result-to-string
 722                              (epg-context-result-for context 'verify)))))))
 723
 724 ;;;###autoload
 725 (defun epa-decrypt-armor-in-region (start end)
 726   "Decrypt OpenPGP armors in the current region between START and END.
 727
 728 Don't use this command in Lisp programs!"
 729   (interactive "r")
 730   (save-excursion
 731     (save-restriction
 732       (narrow-to-region start end)
 733       (goto-char start)
 734       (let (armor-start armor-end charset coding-system)
 735         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 736           (setq armor-start (match-beginning 0)
 737                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 738                                              nil t))
 739           (unless armor-end
 740             (error "No armor tail"))
 741           (goto-char armor-start)
 742           (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 743               (setq charset (match-string 1)))
 744           (if coding-system-for-read
 745               (setq coding-system coding-system-for-read)
 746             (if charset
 747                 (setq coding-system (intern (downcase charset)))
 748               (setq coding-system 'utf-8)))
 749           (let ((coding-system-for-read coding-system))
 750             (epa-decrypt-region start end)))))))
 751
 752 ;;;###autoload
 753 (defun epa-verify-region (start end)
 754   "Verify the current region between START and END.
 755
 756 Don't use this command in Lisp programs!"
 757   (interactive "r")
 758   (let ((context (epg-make-context epa-protocol)))
 759     (epg-context-set-progress-callback context
 760                                        #'epa-progress-callback-function)
 761     (epg-verify-string context
 762                        (epa--encode-coding-string
 763                         (buffer-substring start end)
 764                         coding-system-for-write))
 765     (if (epg-context-result-for context 'verify)
 766         (epa-display-info (epg-verify-result-to-string
 767                            (epg-context-result-for context 'verify))))))
 768
 769 ;;;###autoload
 770 (defun epa-verify-cleartext-in-region (start end)
 771   "Verify OpenPGP cleartext signed messages in the current region
 772 between START and END.
 773
 774 Don't use this command in Lisp programs!"
 775   (interactive "r")
 776   (save-excursion
 777     (save-restriction
 778       (narrow-to-region start end)
 779       (goto-char start)
 780       (let (armor-start armor-end)
 781         (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
 782                                   nil t)
 783           (setq armor-start (match-beginning 0))
 784           (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 785                                            nil t)
 786             (error "Invalid cleartext signed message"))
 787           (setq armor-end (re-search-forward
 788                            "^-----END PGP SIGNATURE-----$"
 789                            nil t))
 790           (unless armor-end
 791             (error "No armor tail"))
 792           (epa-verify-region armor-start armor-end))))))
 793
 794 ;;;###autoload
 795 (defun epa-sign-region (start end signers mode)
 796   "Sign the current region between START and END by SIGNERS keys selected.
 797
 798 Don't use this command in Lisp programs!"
 799   (interactive
 800    (list (region-beginning) (region-end)
 801          (epa-select-keys (epg-make-context epa-protocol)
 802                           "Select keys for signing.
 803 If no one is selected, default secret key is used.  "
 804                           nil t)
 805          (catch 'done
 806            (while t
 807              (message "Signature type (n,c,d,?) ")
 808              (let ((c (read-char)))
 809                (cond ((eq c ?c)
 810                       (throw 'done 'clear))
 811                      ((eq c ?d)
 812                       (throw 'done 'detached))
 813                      ((eq c ??)
 814                       (with-output-to-temp-buffer "*Help*"
 815                         (save-excursion
 816                           (set-buffer standard-output)
 817                           (insert "\
 818 n - Create a normal signature
 819 c - Create a cleartext signature
 820 d - Create a detached signature
 821 ? - Show this help
 822 "))))
 823                      (t
 824                       (throw 'done nil))))))))
 825   (save-excursion
 826     (let ((context (epg-make-context epa-protocol))
 827           signature)
 828       ;;(epg-context-set-armor context epa-armor)
 829       (epg-context-set-armor context t)
 830       ;;(epg-context-set-textmode context epa-textmode)
 831       (epg-context-set-textmode context t)
 832       (epg-context-set-signers context signers)
 833       (epg-context-set-passphrase-callback context
 834                                            #'epa-passphrase-callback-function)
 835       (epg-context-set-progress-callback context
 836                                          #'epa-progress-callback-function)
 837       (message "Signing...")
 838       (setq signature (epg-sign-string context
 839                                        (epa--encode-coding-string
 840                                         (buffer-substring start end)
 841                                         coding-system-for-write)
 842                                        mode))
 843       (message "Signing...done")
 844       (delete-region start end)
 845       (insert (epa--decode-coding-string signature coding-system-for-read)))))
 846
 847 ;;;###autoload
 848 (defun epa-encrypt-region (start end recipients)
 849   "Encrypt the current region between START and END for RECIPIENTS.
 850
 851 Don't use this command in Lisp programs!"
 852   (interactive
 853    (list (region-beginning) (region-end)
 854          (epa-select-keys (epg-make-context epa-protocol)
 855                           "Select recipients for encryption.
 856 If no one is selected, symmetric encryption will be performed.  ")))
 857   (save-excursion
 858     (let ((context (epg-make-context epa-protocol))
 859           cipher)
 860       ;;(epg-context-set-armor context epa-armor)
 861       (epg-context-set-armor context t)
 862       ;;(epg-context-set-textmode context epa-textmode)
 863       (epg-context-set-textmode context t)
 864       (epg-context-set-passphrase-callback context
 865                                            #'epa-passphrase-callback-function)
 866       (epg-context-set-progress-callback context
 867                                          #'epa-progress-callback-function)
 868       (message "Encrypting...")
 869       (setq cipher (epg-encrypt-string context
 870                                        (epa--encode-coding-string
 871                                         (buffer-substring start end)
 872                                         coding-system-for-write)
 873                                        recipients))
 874       (message "Encrypting...done")
 875       (delete-region start end)
 876       (insert cipher))))
 877
 878 ;;;###autoload
 879 (defun epa-delete-keys (keys &optional allow-secret)
 880   "Delete selected KEYS.
 881
 882 Don't use this command in Lisp programs!"
 883   (interactive
 884    (let ((keys (epa--marked-keys)))
 885      (unless keys
 886        (error "No keys selected"))
 887      (list keys
 888            (eq (nth 1 epa-list-keys-arguments) t))))
 889   (let ((context (epg-make-context epa-protocol)))
 890     (message "Deleting...")
 891     (epg-delete-keys context keys allow-secret)
 892     (message "Deleting...done")
 893     (apply #'epa-list-keys epa-list-keys-arguments)))
 894
 895 ;;;###autoload
 896 (defun epa-import-keys (file)
 897   "Import keys from FILE.
 898
 899 Don't use this command in Lisp programs!"
 900   (interactive "fFile: ")
 901   (setq file (expand-file-name file))
 902   (let ((context (epg-make-context epa-protocol)))
 903     (message "Importing %s..." (file-name-nondirectory file))
 904     (condition-case nil
 905         (progn
 906           (epg-import-keys-from-file context file)
 907           (message "Importing %s...done" (file-name-nondirectory file)))
 908       (error
 909        (message "Importing %s...failed" (file-name-nondirectory file))))
 910     (if (epg-context-result-for context 'import)
 911         (epa-display-info (epg-import-result-to-string
 912                            (epg-context-result-for context 'import))))
 913     (if (eq major-mode 'epa-keys-mode)
 914         (apply #'epa-list-keys epa-list-keys-arguments))))
 915
 916 ;;;###autoload
 917 (defun epa-import-keys-region (start end)
 918   "Import keys from the region.
 919
 920 Don't use this command in Lisp programs!"
 921   (interactive "r")
 922   (let ((context (epg-make-context epa-protocol)))
 923     (message "Importing...")
 924     (condition-case nil
 925         (progn
 926           (epg-import-keys-from-string context (buffer-substring start end))
 927           (message "Importing...done"))
 928       (error
 929        (message "Importing...failed")))
 930     (if (epg-context-result-for context 'import)
 931         (epa-display-info (epg-import-result-to-string
 932                            (epg-context-result-for context 'import))))))
 933
 934 ;;;###autoload
 935 (defun epa-export-keys (keys file)
 936   "Export selected KEYS to FILE.
 937
 938 Don't use this command in Lisp programs!"
 939   (interactive
 940    (let ((keys (epa--marked-keys))
 941          default-name)
 942      (unless keys
 943        (error "No keys selected"))
 944      (setq default-name
 945            (expand-file-name
 946             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
 947                     (if epa-armor ".asc" ".gpg"))
 948             default-directory))
 949      (list keys
 950            (expand-file-name
 951             (read-file-name
 952              (concat "To file (default "
 953                      (file-name-nondirectory default-name)
 954                      ") ")
 955              (file-name-directory default-name)
 956              default-name)))))
 957   (let ((context (epg-make-context epa-protocol)))
 958     (epg-context-set-armor context epa-armor)
 959     (message "Exporting to %s..." (file-name-nondirectory file))
 960     (epg-export-keys-to-file context keys file)
 961     (message "Exporting to %s...done" (file-name-nondirectory file))))
 962
 963 ;;;###autoload
 964 (defun epa-insert-keys (keys)
 965   "Insert selected KEYS after the point.
 966
 967 Don't use this command in Lisp programs!"
 968   (interactive
 969    (list (epa-select-keys (epg-make-context epa-protocol)
 970                           "Select keys to export.  ")))
 971   (let ((context (epg-make-context epa-protocol)))
 972     ;;(epg-context-set-armor context epa-armor)
 973     (epg-context-set-armor context t)
 974     (insert (epg-export-keys-to-string context keys))))
 975
 976 ;;;###autoload
 977 (defun epa-sign-keys (keys &optional local)
 978   "Sign selected KEYS.
 979 If a prefix-arg is specified, the signature is marked as non exportable.
 980
 981 Don't use this command in Lisp programs!"
 982   (interactive
 983    (let ((keys (epa--marked-keys)))
 984      (unless keys
 985        (error "No keys selected"))
 986      (list keys current-prefix-arg)))
 987   (let ((context (epg-make-context epa-protocol)))
 988     (epg-context-set-passphrase-callback context
 989                                          #'epa-passphrase-callback-function)
 990     (epg-context-set-progress-callback context
 991                                        #'epa-progress-callback-function)
 992     (message "Signing keys...")
 993     (epg-sign-keys context keys local)
 994     (message "Signing keys...done")))
 995 (make-obsolete 'epa-sign-keys "Do not use.")
 996
 997 (provide 'epa)
 998
 999 ;;; epa.el ends here