epa-mail.el

   1 ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer
   2 ;; Copyright (C) 2006,2007 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG, mail, message
   6
   7 ;; This file is part of EasyPG.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Code:
  25
  26 (require 'epa)
  27 (require 'mail-utils)
  28
  29 (defvar epa-key-list-mode-map
  30   (let ((keymap (make-sparse-keymap)))
  31     (define-key keymap "C-cC-ed" 'epa-mail-decrypt)
  32     (define-key keymap "C-cC-ev" 'epa-mail-verify)
  33     (define-key keymap "C-cC-es" 'epa-mail-sign)
  34     (define-key keymap "C-cC-ee" 'epa-mail-encrypt)
  35     (define-key keymap "C-cC-ei" 'epa-mail-import-keys)
  36     (define-key keymap "C-cC-eo" 'epa-insert-keys)
  37     keymap))
  38
  39 ;;;###autoload
  40 (define-minor-mode epa-mail-mode
  41   "A minor-mode for composing encrypted/clearsigned mails."
  42   nil nil epa-mail-mode-map)
  43
  44 ;;;###autoload
  45 (defun epa-mail-decrypt ()
  46   "Decrypt OpenPGP armors in the current buffer.
  47 The buffer is expected to contain a mail message.
  48
  49 Don't use this command in Lisp programs!"
  50   (interactive)
  51   (epa-decrypt-armor-in-region (point-min) (point-max)))
  52
  53 ;;;###autoload
  54 (defun epa-mail-verify ()
  55   "Verify OpenPGP cleartext signed messages in the current buffer.
  56 The buffer is expected to contain a mail message.
  57
  58 Don't use this command in Lisp programs!"
  59   (interactive)
  60   (epa-verify-cleartext-in-region (point-min) (point-max)))
  61
  62 ;;;###autoload
  63 (defun epa-mail-sign (start end signers mode)
  64   "Sign the current buffer.
  65 The buffer is expected to contain a mail message.
  66
  67 Don't use this command in Lisp programs!"
  68   (interactive
  69    (save-excursion
  70      (goto-char (point-min))
  71      (if (search-forward mail-header-separator nil t)
  72          (forward-line))
  73      (setq epa-last-coding-system-specified
  74            (or coding-system-for-write
  75                (epa--select-safe-coding-system (point) (point-max))))
  76      (let ((verbose current-prefix-arg))
  77        (list (point) (point-max)
  78              (if verbose
  79                  (epa-select-keys (epg-make-context epa-protocol)
  80                                   "Select keys for signing.
  81 If no one is selected, default secret key is used.  "
  82                                   nil t))
  83              (if verbose
  84                  (epa--read-signature-type)
  85                'clear)))))
  86   (epa-sign-region start end signers mode))
  87
  88 ;;;###autoload
  89 (defun epa-mail-encrypt (start end recipients sign signers)
  90   "Encrypt 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      (let ((verbose current-prefix-arg)
  97            (context (epg-make-context epa-protocol))
  98            recipients recipient-keys)
  99        (goto-char (point-min))
 100        (save-restriction
 101          (narrow-to-region (point)
 102                            (if (search-forward mail-header-separator nil 0)
 103                                (match-beginning 0)
 104                              (point)))
 105          (setq recipients
 106                (mail-strip-quoted-names
 107                 (mapconcat #'identity
 108                            (nconc (mail-fetch-field "to" nil nil t)
 109                                   (mail-fetch-field "cc" nil nil t)
 110                                   (mail-fetch-field "bcc" nil nil t))
 111                            ","))))
 112        (if recipients
 113            (setq recipients (delete ""
 114                                     (split-string recipients "[ \t\n]+"))))
 115        (goto-char (point-min))
 116        (if (search-forward mail-header-separator nil t)
 117            (forward-line))
 118        (setq epa-last-coding-system-specified
 119              (or coding-system-for-write
 120                  (epa--select-safe-coding-system (point) (point-max))))
 121        (list (point) (point-max)
 122              (if verbose
 123                  (epa-select-keys
 124                   context
 125                   "Select recipients for encryption.
 126 If no one is selected, symmetric encryption will be performed.  "
 127                   recipients)
 128                (if recipients
 129                    (apply #'nconc
 130                           (mapcar
 131                            (lambda (recipient)
 132                              (setq recipient-keys
 133                                    (epg-list-keys
 134                                     (epg-make-context epa-protocol)
 135                                     (concat "<" recipient ">")))
 136                              (unless (or recipient-keys
 137                                          (y-or-n-p
 138                                           (format
 139                                            "No public key for %s; skip it? "
 140                                            recipient)))
 141                                (error "No public key for %s" recipient))
 142                              recipient-keys)
 143                            recipients))))
 144              (setq sign (if verbose (y-or-n-p "Sign? ")))
 145              (if sign
 146                  (epa-select-keys context
 147                                   "Select keys for signing.  "))))))
 148   (epa-encrypt-region start end recipients sign signers))
 149
 150 ;;;###autoload
 151 (defun epa-mail-import-keys ()
 152   "Import keys in the OpenPGP armor format in the current buffer.
 153 The buffer is expected to contain a mail message.
 154
 155 Don't use this command in Lisp programs!"
 156   (interactive)
 157   (epa-import-armor-in-region (point-min) (point-max)))
 158
 159 (provide 'epa-mail)
 160
 161 ;;; epa-mail.el ends here