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 ;;; ??? Could someone please clarify this doc string?
  54 ;;; In particular, what does USAGE look like
  55 ;;; and what does it mean?  -- rms
  56 (defun epa-mail--find-usable-key (keys usage)
  57   "Find a usable key from KEYS for USAGE."
  58   (catch 'found
  59     (while keys
  60       (let ((pointer (epg-key-sub-key-list (car keys))))
  61         (while pointer
  62           (if (and (memq usage (epg-sub-key-capability (car pointer)))
  63                    (not (memq (epg-sub-key-validity (car pointer))
  64                               '(revoked expired))))
  65               (throw 'found (car keys)))
  66           (setq pointer (cdr pointer))))
  67       (setq keys (cdr keys)))))
  68
  69 (defvar epa-mail-group-alist nil
  70   "Alist of GnuPG mail groups (`group' commands in `.gnupg/gpg.conf').
  71 Each element has the form (GROUPNAME ADDRESSES...).
  72 t means the list is not yet read in.")
  73
  74 (defvar epa-mail-group-modtime nil
  75   "The modification time of `~/.gnupg/gpg.conf' file when last examined.")
  76
  77 (defvar epa-mail-gnupg-conf-file "~/.gnupg/gpg.conf"
  78   "File name of GnuPG configuration file that specifies recipient groups.")
  79
  80 (defun epa-mail-parse-groups ()
  81   "Parse `~/.gnupg/gpg.conf' and set `epa-mail-group-alist' from it."
  82   (let (aliases)
  83     (with-temp-buffer
  84       (insert-file-contents-literally epa-mail-gnupg-conf-file)
  85
  86       (while (re-search-forward "^[ \t]*group[ \t]*" nil t)
  87         (if (looking-at "\\([^= \t]+\\)[ \t]*=[ \t]*\\([^ \t\n]+\\)")
  88             (push (cons (match-string-no-properties 1)
  89                         (split-string (match-string-no-properties 2)))
  90                   aliases))))
  91     (setq epa-mail-group-alist aliases)))
  92
  93 (defun epa-mail-sync-groups ()
  94   "Update GnuPG groups from file if necessary."
  95   (if (file-exists-p epa-mail-gnupg-conf-file)
  96       (let ((modtime (nth 5 (file-attributes epa-mail-gnupg-conf-file))))
  97         (if (not (equal epa-mail-group-modtime modtime))
  98             (progn
  99               (setq epa-mail-group-modtime modtime)
 100               (epa-mail-parse-groups))))
 101     (setq epa-mail-group-alist nil)))
 102
 103 (defun epa-mail-expand-recipient-1 (recipient)
 104   "Expand RECIPIENT once thru `epa-mail-group-alist'.
 105 Returns the list of names it stands for, or nil if it isn't a group."
 106   ;; Load the alias list if not loaded before.
 107   (let (alist-elt)
 108     (setq alist-elt (assoc recipient epa-mail-group-alist))
 109     (cdr alist-elt)))
 110
 111 (defun epa-mail-expand-recipients-2 (recipients)
 112   "Expand list RECIPIENTS once thru `epa-mail-group-alist'.
 113 Returns the list of names they stand for."
 114   ;; Load the alias list if not loaded before.
 115   (let (output)
 116     (dolist (r recipients)
 117       (let ((expanded (epa-mail-expand-recipient-1 r)))
 118         (if expanded
 119             (dolist (xr expanded)
 120               (unless (member xr output)
 121                 (push xr output)))
 122           (unless (member r output)
 123             (push r output)))))
 124     (nreverse output)))
 125
 126 (defun epa-mail-expand-recipients (recipients)
 127   "Expand RECIPIENTS thru `epa-mail-group-alist' until it stops changing."
 128   (epa-mail-sync-groups)
 129   (while (not (equal recipients
 130                      (setq recipients
 131                            (epa-mail-expand-recipients-2 recipients)))))
 132   recipients)
 133
 134 ;;;###autoload
 135 (defun epa-mail-decrypt ()
 136   "Decrypt OpenPGP armors in the current buffer.
 137 The buffer is expected to contain a mail message.
 138
 139 Don't use this command in Lisp programs!"
 140   (interactive)
 141   (epa-decrypt-armor-in-region (point-min) (point-max)))
 142
 143 ;;;###autoload
 144 (defun epa-mail-verify ()
 145   "Verify OpenPGP cleartext signed messages in the current buffer.
 146 The buffer is expected to contain a mail message.
 147
 148 Don't use this command in Lisp programs!"
 149   (interactive)
 150   (epa-verify-cleartext-in-region (point-min) (point-max)))
 151
 152 ;;;###autoload
 153 (defun epa-mail-sign (start end signers mode)
 154   "Sign the current buffer.
 155 The buffer is expected to contain a mail message.
 156
 157 Don't use this command in Lisp programs!"
 158   (interactive
 159    (save-excursion
 160      (goto-char (point-min))
 161      (if (search-forward mail-header-separator nil t)
 162          (forward-line))
 163      (setq epa-last-coding-system-specified
 164            (or coding-system-for-write
 165                (epa--select-safe-coding-system (point) (point-max))))
 166      (let ((verbose current-prefix-arg))
 167        (list (point) (point-max)
 168              (if verbose
 169                  (epa-select-keys (epg-make-context epa-protocol)
 170                                   "Select keys for signing.
 171 If no one is selected, default secret key is used.  "
 172                                   nil t))
 173              (if verbose
 174                  (epa--read-signature-type)
 175                'clear)))))
 176   (epa-sign-region start end signers mode))
 177
 178 ;;;###autoload
 179 (defun epa-mail-encrypt (start end recipients sign signers)
 180   "Encrypt the current buffer.
 181 The buffer is expected to contain a mail message.
 182
 183 Don't use this command in Lisp programs!"
 184   (interactive
 185    (save-excursion
 186      (let ((verbose current-prefix-arg)
 187            (context (epg-make-context epa-protocol))
 188            recipients-string recipients recipient-key sign)
 189        (goto-char (point-min))
 190        (save-restriction
 191          (narrow-to-region (point)
 192                            (if (search-forward mail-header-separator nil 0)
 193                                (match-beginning 0)
 194                              (point)))
 195          (setq recipients-string
 196                (mapconcat #'identity
 197                           (nconc (mail-fetch-field "to" nil nil t)
 198                                  (mail-fetch-field "cc" nil nil t)
 199                                  (mail-fetch-field "bcc" nil nil t))
 200                           ","))
 201          (setq recipients
 202                (mail-strip-quoted-names
 203                 (with-temp-buffer
 204                   (insert "to: " recipients-string "\n")
 205                   (expand-mail-aliases (point-min) (point-max))
 206                   (car (mail-fetch-field "to" nil nil t))))))
 207        (if recipients
 208            (setq recipients (delete ""
 209                                     (split-string recipients
 210                                                   "[ \t\n]*,[ \t\n]*"))))
 211
 212        ;; Process all the recipients thru the list of GnuPG groups.
 213        ;; Expand GnuPG group names to what they stand for.
 214        ;; The code below, and elsewhere, that checks that names have keys
 215        ;; does not know about these group names.
 216        (setq recipients (epa-mail-expand-recipients recipients))
 217
 218        (goto-char (point-min))
 219        (if (search-forward mail-header-separator nil t)
 220            (forward-line))
 221        (setq epa-last-coding-system-specified
 222              (or coding-system-for-write
 223                  (epa--select-safe-coding-system (point) (point-max))))
 224        (list (point) (point-max)
 225              (if verbose
 226                  (epa-select-keys
 227                   context
 228                   "Select recipients for encryption.
 229 If no one is selected, symmetric encryption will be performed.  "
 230                   recipients)
 231                (if recipients
 232                    (mapcar
 233                     (lambda (recipient)
 234                       (setq recipient-key
 235                             (epa-mail--find-usable-key
 236                              (epg-list-keys
 237                               (epg-make-context epa-protocol)
 238                               (if (string-match "@" recipient)
 239                                   (concat "<" recipient ">")
 240                                 recipient))
 241                              'encrypt))
 242                       (unless (or recipient-key
 243                                   (y-or-n-p
 244                                    (format
 245                                     "No public key for %s; skip it? "
 246                                     recipient)))
 247                         (error "No public key for %s" recipient))
 248                       recipient-key)
 249                     recipients)))
 250              (setq sign (if verbose (y-or-n-p "Sign? ")))
 251              (if sign
 252                  (epa-select-keys context
 253                                   "Select keys for signing.  "))))))
 254   (epa-encrypt-region start end recipients sign signers))
 255
 256 ;;;###autoload
 257 (defun epa-mail-import-keys ()
 258   "Import keys in the OpenPGP armor format in the current buffer.
 259 The buffer is expected to contain a mail message.
 260
 261 Don't use this command in Lisp programs!"
 262   (interactive)
 263   (epa-import-armor-in-region (point-min) (point-max)))
 264
 265 ;;;###autoload
 266 (define-minor-mode epa-global-mail-mode
 267   "Minor mode to hook EasyPG into Mail mode."
 268   :global t :init-value nil :group 'epa-mail :version "23.1"
 269   (remove-hook 'mail-mode-hook 'epa-mail-mode)
 270   (if epa-global-mail-mode
 271       (add-hook 'mail-mode-hook 'epa-mail-mode)))
 272
 273 (provide 'epa-mail)
 274
 275 ;;; epa-mail.el ends here