lisp/epa-mail.el

   1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG, mail, message
   6 ;; Package: epa
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'epa)
  26 (require 'mail-utils)
  27
  28 (defvar epa-mail-mode-map
  29   (let ((keymap (make-sparse-keymap)))
  30     (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
  31     (define-key keymap "\C-c\C-ev" 'epa-mail-verify)
  32     (define-key keymap "\C-c\C-es" 'epa-mail-sign)
  33     (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt)
  34     (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys)
  35     (define-key keymap "\C-c\C-eo" 'epa-insert-keys)
  36     (define-key keymap "\C-c\C-e\C-d" 'epa-mail-decrypt)
  37     (define-key keymap "\C-c\C-e\C-v" 'epa-mail-verify)
  38     (define-key keymap "\C-c\C-e\C-s" 'epa-mail-sign)
  39     (define-key keymap "\C-c\C-e\C-e" 'epa-mail-encrypt)
  40     (define-key keymap "\C-c\C-e\C-i" 'epa-mail-import-keys)
  41     (define-key keymap "\C-c\C-e\C-o" 'epa-insert-keys)
  42     keymap))
  43
  44 (defvar epa-mail-mode-hook nil)
  45 (defvar epa-mail-mode-on-hook nil)
  46 (defvar epa-mail-mode-off-hook nil)
  47
  48 ;;;###autoload
  49 (define-minor-mode epa-mail-mode
  50   "A minor-mode for composing encrypted/clearsigned mails.
  51 With a prefix argument ARG, enable the mode if ARG is positive,
  52 and disable it otherwise.  If called from Lisp, enable the mode
  53 if ARG is omitted or nil."
  54   nil " epa-mail" epa-mail-mode-map)
  55
  56 (defun epa-mail--find-usable-key (keys usage)
  57   "Find a usable key from KEYS for USAGE.
  58 USAGE would be `sign' or `encrypt'."
  59   (catch 'found
  60     (while keys
  61       (let ((pointer (epg-key-sub-key-list (car keys))))
  62         (while pointer
  63           (if (and (memq usage (epg-sub-key-capability (car pointer)))
  64                    (not (memq (epg-sub-key-validity (car pointer))
  65                               '(revoked expired))))
  66               (throw 'found (car keys)))
  67           (setq pointer (cdr pointer))))
  68       (setq keys (cdr keys)))))
  69
  70 ;;;###autoload
  71 (defun epa-mail-decrypt ()
  72   "Decrypt OpenPGP armors 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-decrypt-armor-in-region (point-min) (point-max)))
  78
  79 ;;;###autoload
  80 (defun epa-mail-verify ()
  81   "Verify OpenPGP cleartext signed messages in 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   (epa-verify-cleartext-in-region (point-min) (point-max)))
  87
  88 ;;;###autoload
  89 (defun epa-mail-sign (start end signers mode)
  90   "Sign the current buffer.
  91 The buffer is expected to contain a mail message.
  92
  93 Don't use this command in Lisp programs!"
  94   (interactive
  95    (save-excursion
  96      (goto-char (point-min))
  97      (if (search-forward mail-header-separator nil t)
  98          (forward-line))
  99      (setq epa-last-coding-system-specified
 100            (or coding-system-for-write
 101                (epa--select-safe-coding-system (point) (point-max))))
 102      (let ((verbose current-prefix-arg))
 103        (list (point) (point-max)
 104              (if verbose
 105                  (epa-select-keys (epg-make-context epa-protocol)
 106                                   "Select keys for signing.
 107 If no one is selected, default secret key is used.  "
 108                                   nil t))
 109              (if verbose
 110                  (epa--read-signature-type)
 111                'clear)))))
 112   (epa-sign-region start end signers mode))
 113
 114 ;;;###autoload
 115 (defun epa-mail-encrypt (start end recipients sign signers)
 116   "Encrypt the current buffer.
 117 The buffer is expected to contain a mail message.
 118
 119 Don't use this command in Lisp programs!"
 120   (interactive
 121    (save-excursion
 122      (let ((verbose current-prefix-arg)
 123            (config (epg-configuration))
 124            (context (epg-make-context epa-protocol))
 125            recipients-string recipients recipient-key sign)
 126        (goto-char (point-min))
 127        (save-restriction
 128          (narrow-to-region (point)
 129                            (if (search-forward mail-header-separator nil 0)
 130                                (match-beginning 0)
 131                              (point)))
 132          (setq recipients-string
 133                (mapconcat #'identity
 134                           (nconc (mail-fetch-field "to" nil nil t)
 135                                  (mail-fetch-field "cc" nil nil t)
 136                                  (mail-fetch-field "bcc" nil nil t))
 137                           ","))
 138          (setq recipients
 139                (mail-strip-quoted-names
 140                 (with-temp-buffer
 141                   (insert "to: " recipients-string "\n")
 142                   (expand-mail-aliases (point-min) (point-max))
 143                   (car (mail-fetch-field "to" nil nil t))))))
 144        (if recipients
 145            (setq recipients (delete ""
 146                                     (split-string recipients
 147                                                   "[ \t\n]*,[ \t\n]*"))))
 148
 149        ;; Process all the recipients thru the list of GnuPG groups.
 150        ;; Expand GnuPG group names to what they stand for.
 151        (setq recipients
 152              (apply #'nconc
 153                     (mapcar
 154                      (lambda (recipient)
 155                        (or (epg-expand-group config recipient)
 156                            (list recipient)))
 157                      recipients)))
 158
 159        (goto-char (point-min))
 160        (if (search-forward mail-header-separator nil t)
 161            (forward-line))
 162        (setq epa-last-coding-system-specified
 163              (or coding-system-for-write
 164                  (epa--select-safe-coding-system (point) (point-max))))
 165        (list (point) (point-max)
 166              (if verbose
 167                  (epa-select-keys
 168                   context
 169                   "Select recipients for encryption.
 170 If no one is selected, symmetric encryption will be performed.  "
 171                   recipients)
 172                (if recipients
 173                    (mapcar
 174                     (lambda (recipient)
 175                       (setq recipient-key
 176                             (epa-mail--find-usable-key
 177                              (epg-list-keys
 178                               (epg-make-context epa-protocol)
 179                               (if (string-match "@" recipient)
 180                                   (concat "<" recipient ">")
 181                                 recipient))
 182                              'encrypt))
 183                       (unless (or recipient-key
 184                                   (y-or-n-p
 185                                    (format
 186                                     "No public key for %s; skip it? "
 187                                     recipient)))
 188                         (error "No public key for %s" recipient))
 189                       recipient-key)
 190                     recipients)))
 191              (setq sign (if verbose (y-or-n-p "Sign? ")))
 192              (if sign
 193                  (epa-select-keys context
 194                                   "Select keys for signing.  "))))))
 195   ;; Don't let some read-only text stop us from encrypting.
 196   (let ((inhibit-read-only t))
 197     (epa-encrypt-region start end recipients sign signers)))
 198
 199 ;;;###autoload
 200 (defun epa-mail-import-keys ()
 201   "Import keys in the OpenPGP armor format in the current buffer.
 202 The buffer is expected to contain a mail message.
 203
 204 Don't use this command in Lisp programs!"
 205   (interactive)
 206   (epa-import-armor-in-region (point-min) (point-max)))
 207
 208 ;;;###autoload
 209 (define-minor-mode epa-global-mail-mode
 210   "Minor mode to hook EasyPG into Mail mode.
 211 With a prefix argument ARG, enable the mode if ARG is positive,
 212 and disable it otherwise.  If called from Lisp, enable the mode
 213 if ARG is omitted or nil."
 214   :global t :init-value nil :group 'epa-mail :version "23.1"
 215   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 216   (if epa-global-mail-mode
 217       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 218
 219 (provide 'epa-mail)
 220
 221 ;;; epa-mail.el ends here