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                    (apply
 174                     'nconc
 175                     (mapcar
 176                      (lambda (recipient)
 177                        (setq recipient-key
 178                              (epa-mail--find-usable-key
 179                               (epg-list-keys
 180                                (epg-make-context epa-protocol)
 181                                (if (string-match "@" recipient)
 182                                    (concat "<" recipient ">")
 183                                  recipient))
 184                               'encrypt))
 185                        (unless (or recipient-key
 186                                    (y-or-n-p
 187                                     (format
 188                                      "No public key for %s; skip it? "
 189                                      recipient)))
 190                          (error "No public key for %s" recipient))
 191                        (if recipient-key (list recipient-key)))
 192                      recipients))))
 193              (setq sign (if verbose (y-or-n-p "Sign? ")))
 194              (if sign
 195                  (epa-select-keys context
 196                                   "Select keys for signing.  "))))))
 197   ;; Don't let some read-only text stop us from encrypting.
 198   (let ((inhibit-read-only t))
 199     (epa-encrypt-region start end recipients sign signers)))
 200
 201 ;;;###autoload
 202 (defun epa-mail-import-keys ()
 203   "Import keys in the OpenPGP armor format in the current buffer.
 204 The buffer is expected to contain a mail message.
 205
 206 Don't use this command in Lisp programs!"
 207   (interactive)
 208   (epa-import-armor-in-region (point-min) (point-max)))
 209
 210 ;;;###autoload
 211 (define-minor-mode epa-global-mail-mode
 212   "Minor mode to hook EasyPG into Mail mode.
 213 With a prefix argument ARG, enable the mode if ARG is positive,
 214 and disable it otherwise.  If called from Lisp, enable the mode
 215 if ARG is omitted or nil."
 216   :global t :init-value nil :group 'epa-mail :version "23.1"
 217   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 218   (if epa-global-mail-mode
 219       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 220
 221 (provide 'epa-mail)
 222
 223 ;;; epa-mail.el ends here