lisp/epa-mail.el

   1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2006-2011 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   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
  72 Don't use this command in Lisp programs!"
  73   (interactive)
  74   (epa-decrypt-armor-in-region (point-min) (point-max)))
  75
  76 ;;;###autoload
  77 (defun epa-mail-verify ()
  78   "Verify OpenPGP cleartext signed messages in the current buffer.
  79 The buffer is expected to contain a mail message.
  80
  81 Don't use this command in Lisp programs!"
  82   (interactive)
  83   (epa-verify-cleartext-in-region (point-min) (point-max)))
  84
  85 ;;;###autoload
  86 (defun epa-mail-sign (start end signers mode)
  87   "Sign the current buffer.
  88 The buffer is expected to contain a mail message.
  89
  90 Don't use this command in Lisp programs!"
  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   (epa-sign-region start end signers mode))
 110
 111 ;;;###autoload
 112 (defun epa-mail-encrypt (start end recipients sign signers)
 113   "Encrypt the current buffer.
 114 The buffer is expected to contain a mail message.
 115
 116 Don't use this command in Lisp programs!"
 117   (interactive
 118    (save-excursion
 119      (let ((verbose current-prefix-arg)
 120            (config (epg-configuration))
 121            (context (epg-make-context epa-protocol))
 122            recipients-string recipients recipient-key sign)
 123        (goto-char (point-min))
 124        (save-restriction
 125          (narrow-to-region (point)
 126                            (if (search-forward mail-header-separator nil 0)
 127                                (match-beginning 0)
 128                              (point)))
 129          (setq recipients-string
 130                (mapconcat #'identity
 131                           (nconc (mail-fetch-field "to" nil nil t)
 132                                  (mail-fetch-field "cc" nil nil t)
 133                                  (mail-fetch-field "bcc" nil nil t))
 134                           ","))
 135          (setq recipients
 136                (mail-strip-quoted-names
 137                 (with-temp-buffer
 138                   (insert "to: " recipients-string "\n")
 139                   (expand-mail-aliases (point-min) (point-max))
 140                   (car (mail-fetch-field "to" nil nil t))))))
 141        (if recipients
 142            (setq recipients (delete ""
 143                                     (split-string recipients
 144                                                   "[ \t\n]*,[ \t\n]*"))))
 145
 146        ;; Process all the recipients thru the list of GnuPG groups.
 147        ;; Expand GnuPG group names to what they stand for.
 148        (setq recipients
 149              (apply #'nconc
 150                     (mapcar
 151                      (lambda (recipient)
 152                        (or (epg-expand-group config recipient)
 153                            (list recipient)))
 154                      recipients)))
 155
 156        (goto-char (point-min))
 157        (if (search-forward mail-header-separator nil t)
 158            (forward-line))
 159        (setq epa-last-coding-system-specified
 160              (or coding-system-for-write
 161                  (epa--select-safe-coding-system (point) (point-max))))
 162        (list (point) (point-max)
 163              (if verbose
 164                  (epa-select-keys
 165                   context
 166                   "Select recipients for encryption.
 167 If no one is selected, symmetric encryption will be performed.  "
 168                   recipients)
 169                (if recipients
 170                    (mapcar
 171                     (lambda (recipient)
 172                       (setq recipient-key
 173                             (epa-mail--find-usable-key
 174                              (epg-list-keys
 175                               (epg-make-context epa-protocol)
 176                               (if (string-match "@" recipient)
 177                                   (concat "<" recipient ">")
 178                                 recipient))
 179                              'encrypt))
 180                       (unless (or recipient-key
 181                                   (y-or-n-p
 182                                    (format
 183                                     "No public key for %s; skip it? "
 184                                     recipient)))
 185                         (error "No public key for %s" recipient))
 186                       recipient-key)
 187                     recipients)))
 188              (setq sign (if verbose (y-or-n-p "Sign? ")))
 189              (if sign
 190                  (epa-select-keys context
 191                                   "Select keys for signing.  "))))))
 192   (epa-encrypt-region start end recipients sign signers))
 193
 194 ;;;###autoload
 195 (defun epa-mail-import-keys ()
 196   "Import keys in the OpenPGP armor format in the current buffer.
 197 The buffer is expected to contain a mail message.
 198
 199 Don't use this command in Lisp programs!"
 200   (interactive)
 201   (epa-import-armor-in-region (point-min) (point-max)))
 202
 203 ;;;###autoload
 204 (define-minor-mode epa-global-mail-mode
 205   "Minor mode to hook EasyPG into Mail mode."
 206   :global t :init-value nil :group 'epa-mail :version "23.1"
 207   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 208   (if epa-global-mail-mode
 209       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 210
 211 (provide 'epa-mail)
 212
 213 ;;; epa-mail.el ends here