| 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 |