cgit.sxemacs.org Git - packages/blob - xemacs-packages/easypg/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-mail-mode-map
  30   (let ((keymap (make-sparse-keymap)))
  31     (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
  32     (define-key keymap "\C-c\C-ev" 'epa-mail-verify)
  33     (define-key keymap "\C-c\C-es" 'epa-mail-sign)
  34     (define-key keymap "\C-c\C-ee" 'epa-mail-encrypt)
  35     (define-key keymap "\C-c\C-ei" 'epa-mail-import-keys)
  36     (define-key keymap "\C-c\C-eo" 'epa-insert-keys)
  37     keymap))
  38
  39 (defvar epa-mail-mode-hook nil)
  40 (defvar epa-mail-mode-on-hook nil)
  41 (defvar epa-mail-mode-off-hook nil)
  42
  43 (define-minor-mode epa-mail-mode
  44   "A minor-mode for composing encrypted/clearsigned mails."
  45   nil " epa-mail" epa-mail-mode-map)
  46
  47 (defun epa-mail--find-usable-key (keys usage)
  48   "Find a usable key from KEYS for USAGE."
  49   (catch 'found
  50     (while keys
  51       (let ((pointer (epg-key-sub-key-list (car keys))))
  52         (while pointer
  53           (if (and (memq usage (epg-sub-key-capability (car pointer)))
  54                    (not (memq (epg-sub-key-validity (car pointer))
  55                               '(revoked expired))))
  56               (throw 'found (car keys)))
  57           (setq pointer (cdr pointer))))
  58       (setq keys (cdr keys)))))
  59
  60 ;;;###autoload
  61 (defun epa-mail-decrypt ()
  62   "Decrypt OpenPGP armors in the current buffer.
  63 The buffer is expected to contain a mail message.
  64
  65 Don't use this command in Lisp programs!"
  66   (interactive)
  67   (epa-decrypt-armor-in-region (point-min) (point-max)))
  68
  69 ;;;###autoload
  70 (defun epa-mail-verify ()
  71   "Verify OpenPGP cleartext signed messages in the current buffer.
  72 The buffer is expected to contain a mail message.
  73
  74 Don't use this command in Lisp programs!"
  75   (interactive)
  76   (epa-verify-cleartext-in-region (point-min) (point-max)))
  77
  78 ;;;###autoload
  79 (defun epa-mail-sign (start end signers mode)
  80   "Sign the current buffer.
  81 The buffer is expected to contain a mail message.
  82
  83 Don't use this command in Lisp programs!"
  84   (interactive
  85    (save-excursion
  86      (goto-char (point-min))
  87      (if (search-forward mail-header-separator nil t)
  88          (forward-line))
  89      (setq epa-last-coding-system-specified
  90            (or coding-system-for-write
  91                (epa--select-safe-coding-system (point) (point-max))))
  92      (let ((verbose current-prefix-arg))
  93        (list (point) (point-max)
  94              (if verbose
  95                  (epa-select-keys (epg-make-context epa-protocol)
  96                                   "Select keys for signing.
  97 If no one is selected, default secret key is used.  "
  98                                   nil t))
  99              (if verbose
 100                  (epa--read-signature-type)
 101                'clear)))))
 102   (epa-sign-region start end signers mode))
 103
 104 ;;;###autoload
 105 (defun epa-mail-encrypt (start end recipients sign signers)
 106   "Encrypt the current buffer.
 107 The buffer is expected to contain a mail message.
 108
 109 Don't use this command in Lisp programs!"
 110   (interactive
 111    (save-excursion
 112      (let ((verbose current-prefix-arg)
 113            (context (epg-make-context epa-protocol))
 114            recipients recipient-key)
 115        (goto-char (point-min))
 116        (save-restriction
 117          (narrow-to-region (point)
 118                            (if (search-forward mail-header-separator nil 0)
 119                                (match-beginning 0)
 120                              (point)))
 121          (setq recipients
 122                (mail-strip-quoted-names
 123                 (mapconcat #'identity
 124                            (nconc (mail-fetch-field "to" nil nil t)
 125                                   (mail-fetch-field "cc" nil nil t)
 126                                   (mail-fetch-field "bcc" nil nil t))
 127                            ","))))
 128        (if recipients
 129            (setq recipients (delete ""
 130                                     (split-string recipients "[ \t\n]+"))))
 131        (goto-char (point-min))
 132        (if (search-forward mail-header-separator nil t)
 133            (forward-line))
 134        (setq epa-last-coding-system-specified
 135              (or coding-system-for-write
 136                  (epa--select-safe-coding-system (point) (point-max))))
 137        (list (point) (point-max)
 138              (if verbose
 139                  (epa-select-keys
 140                   context
 141                   "Select recipients for encryption.
 142 If no one is selected, symmetric encryption will be performed.  "
 143                   recipients)
 144                (if recipients
 145                    (mapcar
 146                     (lambda (recipient)
 147                       (setq recipient-key
 148                             (epa-mail--find-usable-key
 149                              (epg-list-keys
 150                               (epg-make-context epa-protocol)
 151                               (concat "<" recipient ">"))
 152                              'encrypt))
 153                       (unless (or recipient-key
 154                                   (y-or-n-p
 155                                    (format
 156                                     "No public key for %s; skip it? "
 157                                     recipient)))
 158                         (error "No public key for %s" recipient))
 159                       recipient-key)
 160                     recipients)))
 161              (setq sign (if verbose (y-or-n-p "Sign? ")))
 162              (if sign
 163                  (epa-select-keys context
 164                                   "Select keys for signing.  "))))))
 165   (epa-encrypt-region start end recipients sign signers))
 166
 167 ;;;###autoload
 168 (defun epa-mail-import-keys ()
 169   "Import keys in the OpenPGP armor format in the current buffer.
 170 The buffer is expected to contain a mail message.
 171
 172 Don't use this command in Lisp programs!"
 173   (interactive)
 174   (epa-import-armor-in-region (point-min) (point-max)))
 175
 176 (provide 'epa-mail)
 177
 178 ;;; epa-mail.el ends here