lisp/epa-mail.el

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