;;; bbdb-pgp.el --- use BBDB to store PGP preferences

;; Copyright (C) 1997,1999 Kevin Davidson

;; Author: Kevin Davidson tkld@quadstone.com
;; Maintainer: Kevin Davidson tkld@quadstone.com
;; Created: 10 Nov 1997
;; Version: $Revision: 1.6 $
;; Keywords: PGP BBDB message mailcrypt


;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to tkld@quadstone.com) or
;; from the Free Software Foundation, Inc.,59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; LCD Archive Entry:
;; bbdb-pgp|Kevin Davidson|tkld@quadstone.com
;; |Use BBDB to store PGP preferences
;; |$Date: 2003/08/11 08:54:35 $|$Revision: 1.6 $|~/packages/bbdb-pgp.el

;;; Commentary:
;;
;; It is believed that encrypted mail works best if all mail between
;; individuals is encrypted - even concerning matters that are not
;; confidential. The reasoning is that confidential messages cannot
;; then be easily spotted and decryption efforts concentrated on them.
;; Some people therefore prefer to have all their email encrypted.
;; This package allows you to mark the BBDB entries for those
;; individuals so that messages will be encrypted when they are sent.
;;
;; These packages are required: BBDB, mailcrypt, message
;;
;; message.el is included with recent versions of Emacs.
;; You can use mail-mode as well as message-mode to send mail.

;;; Usage:
;; (require 'bbdb-pgp)
;;
;; Then for all users who you want to send encrypted mail to, add the field
;; pgp-mail with the value `encrypt'. Alternatively you can add the value
;; `sign' if you just want to send signed messages.
;;
;; and possibly (if you do not want the PGP field printed out)
;; (add-hook 'bbdb-print-elide bbdb-pgp-field)
;;
;; The variable bbdb/pgp-default-action defines what to do if the recipient
;; is not in the BBDB.

;;; TODO
;; Spot incoming PGP mail by hooking into mc-verify/decrypt and adding pgp-mail
;; field to BBDB entry (creating one if necessary); like bbdb-sc.el maintains
;; attribution prefs.

;;; PGP Public Key
;; The author's public key is available from any public PGP keyserver
;; eg http://www.pgp.net/pgpnet/
;; Fingerprint: 1F A9 3F 3E 90 F7 85 64  55 35 32 C8 75 91 3A E3


;;; Code:

(require 'message)
(require 'bbdb)
(condition-case nil (require 'mailcrypt) (error nil))

(defconst bbdb/pgp-version (substring "$Revision: 1.6 $" 11 -2)
  "$Id: bbdb-pgp.el,v 1.6 2003/08/11 08:54:35 waider Exp $

Report bugs to: Kevin Davidson tkld@quadstone.com")

;;;###autoload
(defgroup bbdb-utilities-pgp nil
  "Automatically sign and/or encrypt outgoing messages."
  :link '(emacs-library-link :tag "Lisp Source File" "bbdb-pgp.el")
  :group 'bbdb-utilities)


(defcustom bbdb/pgp-field 'pgp-mail
  "*Field to use in BBDB to store PGP preferences.

If this field's value in a record is \"encrypt\" then messages are
encrypted. If it is \"sign\" then messages are signed."
  :type 'symbol
  :tag "BBDB Field"
  :require 'bbdb
  :group 'bbdb-utilities-pgp)

(defcustom bbdb/pgp-method 'mailcrypt
  "*How to sign or encrypt messages.

'mailcrypt     means use Mailcrypt.
'mml-pgp       means add MML tags for Message to use old PGP format
'mml-pgpmime   means add MML tags for Message to use PGP/MIME
'mml-smime     means add MML tags for Message to use S/MIME"
  :type '(choice
      (const :tag "Mailcrypt" mailcrypt :require 'mailcrypt)
      (const :tag "MML PGP" mml-pgp :require 'mml)
      (const :tag "MML PGP/MIME" mml-pgpmime :require 'mml)
      (const :tag "MML S/MIME" mml-smime :require 'mml))
  :tag "Signing/Encryption Method"
  :group 'bbdb-utilities-pgp)

(defcustom bbdb/pgp-default-action nil
  "*Default action when sending a message and the recipient is not in BBDB.

nil         means do nothing.
'encrypt    means encrypt message.
'sign       means sign message."
  :type '(choice
      (const :tag "Do Nothing")
      (const :tag "Encrypt" encrypt)
      (const :tag "Sign" sign))
  :tag "Default Action"
  :group 'bbdb-utilities-pgp)

(defcustom bbdb/pgp-quiet nil
  "*Do not ask for confirmation on pgp-action.

nil         means normal messages/questions.
't          means to be quiet."
  :type '(choice
      (const :tag "normal")
      (const :tag "quiet" t))
  :tag "Quietness"
  :group 'bbdb-utilities-pgp)

(defun bbdb/pgp-get-pgp (name address)
  "Look up user NAME and ADDRESS in BBDB and return the PGP preference."
  (let* ((record (bbdb-search-simple name address))
     (pgp (and record
           (bbdb-record-getprop record bbdb/pgp-field))))
    pgp))

(defun bbdb/pgp-sign ()
  "Sign a message.
bbdb/pgp-method controls the method used."
  (cond
   ((eq bbdb/pgp-method 'mailcrypt)
    (mc-sign 0))
   ((eq bbdb/pgp-method 'mml-pgp)
    (mml-secure-message-sign-pgp))
   ((eq bbdb/pgp-method 'mml-pgpmime)
    (mml-secure-message-sign-pgpmime))
   ((eq bbdb/pgp-method 'mml-smime)
    (mml-secure-message-sign-smime))
   (t
    (error 'invalid-state "bbdb/pgp-method"))))

(defun bbdb/pgp-encrypt ()
  "Encrypt and sign a message.
bbdb/pgp-method controls the method used."
  (cond
   ((eq bbdb/pgp-method 'mailcrypt)
    (mc-encrypt 0))
   ((eq bbdb/pgp-method 'mml-pgp)
    (mml-secure-message-encrypt-pgp))
   ((eq bbdb/pgp-method 'mml-pgpmime)
    (mml-secure-message-encrypt-pgpmime))
   ((eq bbdb/pgp-method 'mml-smime)
    (mml-secure-message-encrypt-smime))
   (t
    (error 'invalid-state "bbdb/pgp-method"))))

(defun bbdb/pgp-hook-fun ()
  "Function to be added to message-send-hook
Uses PGP to encrypt messages to users marked in the BBDB with the
field `bbdb/pgp-field'.
The user is prompted before encryption or signing."
  (save-restriction
    (save-excursion
      (message-narrow-to-headers)
      (and (featurep 'mailalias)
       (not (featurep 'mailabbrev))
       mail-aliases
       (expand-mail-aliases (point-min) (point-max)))
      (let* ((to-field (mail-fetch-field "To" nil t))
         (address (mail-extract-address-components (or to-field ""))))
    (widen)
    (if (not (equal address '(nil nil)))
        (let ((pgp-p (bbdb/pgp-get-pgp (car address) (car (cdr address)))))
          (cond
           ((string= "encrypt" pgp-p)
                (and (or bbdb/pgp-quiet
                         (y-or-n-p "Encrypt message? "))
                     (bbdb/pgp-encrypt)))
           ((string= "sign" pgp-p)
        (and (or bbdb/pgp-quiet
                         (y-or-n-p "Sign message? "))
                     (bbdb/pgp-sign)))
           (t
        (cond
         ((eq bbdb/pgp-default-action 'encrypt)
          (and (y-or-n-p "Encrypt message? ")
               (bbdb/pgp-encrypt)))
         ((eq bbdb/pgp-default-action 'sign)
          (and (y-or-n-p "Sign message? ")
               (bbdb/pgp-sign)))
         (t
          nil))))))))))

(add-hook 'message-send-hook 'bbdb/pgp-hook-fun)
(add-hook 'mail-send-hook 'bbdb/pgp-hook-fun)

(provide 'bbdb-pgp)

;;; bbdb-pgp.el ends here