lisp/epa-mail.el

   1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2006-2014 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   (let ((inhibit-read-only t))
 113     (epa-sign-region start end signers mode)))
 114
 115 (defun epa-mail-default-recipients ()
 116   "Return the default list of encryption recipients for a mail buffer."
 117   (let ((config (epg-configuration))
 118         recipients-string real-recipients)
 119     (save-excursion
 120       (goto-char (point-min))
 121       (save-restriction
 122         (narrow-to-region (point)
 123                           (if (search-forward mail-header-separator nil 0)
 124                               (match-beginning 0)
 125                             (point)))
 126         (setq recipients-string
 127               (mapconcat #'identity
 128                          (nconc (mail-fetch-field "to" nil nil t)
 129                                 (mail-fetch-field "cc" nil nil t)
 130                                 (mail-fetch-field "bcc" nil nil t))
 131                          ","))
 132         (setq recipients-string
 133               (mail-strip-quoted-names
 134                (with-temp-buffer
 135                  (insert "to: " recipients-string "\n")
 136                  (expand-mail-aliases (point-min) (point-max))
 137                  (car (mail-fetch-field "to" nil nil t))))))
 138
 139       (setq real-recipients
 140             (split-string recipients-string "," t "[ \t\n]*"))
 141
 142       ;; Process all the recipients thru the list of GnuPG groups.
 143       ;; Expand GnuPG group names to what they stand for.
 144       (setq real-recipients
 145             (apply #'nconc
 146                    (mapcar
 147                     (lambda (recipient)
 148                       (or (epg-expand-group config recipient)
 149                           (list recipient)))
 150                     real-recipients)))
 151
 152       ;; Process all the recipients thru the user's list
 153       ;; of encryption aliases.
 154       (setq real-recipients
 155             (apply #'nconc
 156                    (mapcar
 157                     (lambda (recipient)
 158                       (let ((tem (assoc recipient epa-mail-aliases)))
 159                         (if tem (cdr tem)
 160                           (list recipient))))
 161                     real-recipients)))
 162       )))
 163
 164 ;;;###autoload
 165 (defun epa-mail-encrypt (&optional recipients signers)
 166   "Encrypt the outgoing mail message in the current buffer.
 167 Takes the recipients from the text in the header in the buffer
 168 and translates them through `epa-mail-aliases'.
 169 With prefix argument, asks you to select among them interactively
 170 and also whether and how to sign.
 171
 172 Called from Lisp, the optional argument RECIPIENTS is a list
 173 of recipient addresses, t to perform symmetric encryption,
 174 or nil meaning use the defaults.
 175
 176 SIGNERS is a list of keys to sign the message with."
 177   (interactive
 178    (let ((verbose current-prefix-arg)
 179          (context (epg-make-context epa-protocol)))
 180      (list (if verbose
 181                (or (epa-select-keys
 182                     context
 183                     "Select recipients for encryption.
 184 If no one is selected, symmetric encryption will be performed.  "
 185                     (epa-mail-default-recipients))
 186                    t))
 187            (and verbose (y-or-n-p "Sign? ")
 188                 (epa-select-keys context
 189                                  "Select keys for signing.  ")))))
 190   (let (start recipient-keys default-recipients)
 191     (save-excursion
 192       (setq recipient-keys
 193             (cond ((eq recipients t)
 194                    nil)
 195                   (recipients recipients)
 196                   (t
 197                    (setq default-recipients
 198                          (epa-mail-default-recipients))
 199                    ;; Convert recipients to keys.
 200                    (apply
 201                     'nconc
 202                     (mapcar
 203                      (lambda (recipient)
 204                        (let ((recipient-key
 205                               (epa-mail--find-usable-key
 206                                (epg-list-keys
 207                                 (epg-make-context epa-protocol)
 208                                 (if (string-match "@" recipient)
 209                                     (concat "<" recipient ">")
 210                                   recipient))
 211                                'encrypt)))
 212                          (unless (or recipient-key
 213                                      (y-or-n-p
 214                                       (format
 215                                        "No public key for %s; skip it? "
 216                                        recipient)))
 217                            (error "No public key for %s" recipient))
 218                          (if recipient-key (list recipient-key))))
 219                        default-recipients)))))
 220
 221       (goto-char (point-min))
 222       (if (search-forward mail-header-separator nil t)
 223           (forward-line))
 224       (setq start (point))
 225
 226       (setq epa-last-coding-system-specified
 227             (or coding-system-for-write
 228                 (epa--select-safe-coding-system (point) (point-max)))))
 229
 230     ;; Don't let some read-only text stop us from encrypting.
 231     (let ((inhibit-read-only t))
 232       (epa-encrypt-region start (point-max) recipient-keys signers signers))))
 233
 234 ;;;###autoload
 235 (defun epa-mail-import-keys ()
 236   "Import keys in the OpenPGP armor format in the current buffer.
 237 The buffer is expected to contain a mail message.
 238
 239 Don't use this command in Lisp programs!"
 240   (interactive)
 241   (epa-import-armor-in-region (point-min) (point-max)))
 242
 243 ;;;###autoload
 244 (define-minor-mode epa-global-mail-mode
 245   "Minor mode to hook EasyPG into Mail mode.
 246 With a prefix argument ARG, enable the mode if ARG is positive,
 247 and disable it otherwise.  If called from Lisp, enable the mode
 248 if ARG is omitted or nil."
 249   :global t :init-value nil :group 'epa-mail :version "23.1"
 250   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 251   (if epa-global-mail-mode
 252       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 253
 254 (provide 'epa-mail)
 255
 256 ;;; epa-mail.el ends here