lisp/epa-mail.el

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