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