lisp/epa-mail.el

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