lisp/epa-mail.el

   1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer
   2 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG, mail, message
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs 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 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'epa)
  25 (require 'mail-utils)
  26
  27 (defvar epa-mail-mode-map
  28   (let ((keymap (make-sparse-keymap)))
  29     (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
  30     (define-key keymap "\C-c\C-ev" 'epa-mail-verify)
  31     (define-key keymap "\C-c\C-es" 'epa-mail-sign)
  32     (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt)
  33     (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys)
  34     (define-key keymap "\C-c\C-eo" 'epa-insert-keys)
  35     keymap))
  36
  37 (defvar epa-mail-mode-hook nil)
  38 (defvar epa-mail-mode-on-hook nil)
  39 (defvar epa-mail-mode-off-hook nil)
  40
  41 ;;;###autoload
  42 (define-minor-mode epa-mail-mode
  43   "A minor-mode for composing encrypted/clearsigned mails."
  44   nil " epa-mail" epa-mail-mode-map)
  45
  46 (defun epa-mail--find-usable-key (keys usage)
  47   "Find a usable key from KEYS for USAGE."
  48   (catch 'found
  49     (while keys
  50       (let ((pointer (epg-key-sub-key-list (car keys))))
  51         (while pointer
  52           (if (and (memq usage (epg-sub-key-capability (car pointer)))
  53                    (not (memq (epg-sub-key-validity (car pointer))
  54                               '(revoked expired))))
  55               (throw 'found (car keys)))
  56           (setq pointer (cdr pointer))))
  57       (setq keys (cdr keys)))))
  58
  59 ;;;###autoload
  60 (defun epa-mail-decrypt ()
  61   "Decrypt OpenPGP armors in the current buffer.
  62 The buffer is expected to contain a mail message.
  63
  64 Don't use this command in Lisp programs!"
  65   (interactive)
  66   (epa-decrypt-armor-in-region (point-min) (point-max)))
  67
  68 ;;;###autoload
  69 (defun epa-mail-verify ()
  70   "Verify OpenPGP cleartext signed messages in the current buffer.
  71 The buffer is expected to contain a mail message.
  72
  73 Don't use this command in Lisp programs!"
  74   (interactive)
  75   (epa-verify-cleartext-in-region (point-min) (point-max)))
  76
  77 ;;;###autoload
  78 (defun epa-mail-sign (start end signers mode)
  79   "Sign the current buffer.
  80 The buffer is expected to contain a mail message.
  81
  82 Don't use this command in Lisp programs!"
  83   (interactive
  84    (save-excursion
  85      (goto-char (point-min))
  86      (if (search-forward mail-header-separator nil t)
  87          (forward-line))
  88      (setq epa-last-coding-system-specified
  89            (or coding-system-for-write
  90                (epa--select-safe-coding-system (point) (point-max))))
  91      (let ((verbose current-prefix-arg))
  92        (list (point) (point-max)
  93              (if verbose
  94                  (epa-select-keys (epg-make-context epa-protocol)
  95                                   "Select keys for signing.
  96 If no one is selected, default secret key is used.  "
  97                                   nil t))
  98              (if verbose
  99                  (epa--read-signature-type)
 100                'clear)))))
 101   (epa-sign-region start end signers mode))
 102
 103 ;;;###autoload
 104 (defun epa-mail-encrypt (start end recipients sign signers)
 105   "Encrypt the current buffer.
 106 The buffer is expected to contain a mail message.
 107
 108 Don't use this command in Lisp programs!"
 109   (interactive
 110    (save-excursion
 111      (let ((verbose current-prefix-arg)
 112            (context (epg-make-context epa-protocol))
 113            recipients recipient-key)
 114        (goto-char (point-min))
 115        (save-restriction
 116          (narrow-to-region (point)
 117                            (if (search-forward mail-header-separator nil 0)
 118                                (match-beginning 0)
 119                              (point)))
 120          (setq recipients
 121                (mail-strip-quoted-names
 122                 (mapconcat #'identity
 123                            (nconc (mail-fetch-field "to" nil nil t)
 124                                   (mail-fetch-field "cc" nil nil t)
 125                                   (mail-fetch-field "bcc" nil nil t))
 126                            ","))))
 127        (if recipients
 128            (setq recipients (delete ""
 129                                     (split-string recipients "[ \t\n]+"))))
 130        (goto-char (point-min))
 131        (if (search-forward mail-header-separator nil t)
 132            (forward-line))
 133        (setq epa-last-coding-system-specified
 134              (or coding-system-for-write
 135                  (epa--select-safe-coding-system (point) (point-max))))
 136        (list (point) (point-max)
 137              (if verbose
 138                  (epa-select-keys
 139                   context
 140                   "Select recipients for encryption.
 141 If no one is selected, symmetric encryption will be performed.  "
 142                   recipients)
 143                (if recipients
 144                    (mapcar
 145                     (lambda (recipient)
 146                       (setq recipient-key
 147                             (epa-mail--find-usable-key
 148                              (epg-list-keys
 149                               (epg-make-context epa-protocol)
 150                               (concat "<" recipient ">"))
 151                              'encrypt))
 152                       (unless (or recipient-key
 153                                   (y-or-n-p
 154                                    (format
 155                                     "No public key for %s; skip it? "
 156                                     recipient)))
 157                         (error "No public key for %s" recipient))
 158                       recipient-key)
 159                     recipients)))
 160              (setq sign (if verbose (y-or-n-p "Sign? ")))
 161              (if sign
 162                  (epa-select-keys context
 163                                   "Select keys for signing.  "))))))
 164   (epa-encrypt-region start end recipients sign signers))
 165
 166 ;;;###autoload
 167 (defun epa-mail-import-keys ()
 168   "Import keys in the OpenPGP armor format in the current buffer.
 169 The buffer is expected to contain a mail message.
 170
 171 Don't use this command in Lisp programs!"
 172   (interactive)
 173   (epa-import-armor-in-region (point-min) (point-max)))
 174
 175 ;;;###autoload
 176 (define-minor-mode epa-global-mail-mode
 177   "Minor mode to hook EasyPG into Mail mode."
 178   :global t :init-value nil :group 'epa-mail :version "23.1"
 179   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 180   (if epa-global-mail-mode
 181       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 182
 183 (provide 'epa-mail)
 184
 185 ;; arch-tag: a6f82b3f-d177-4a11-af95-040da55927d2
 186 ;;; epa-mail.el ends here