git.shemshak.org - ~bandali/configs/blob - lisp/bbdb/bbdb-pgp.el

   1 ;;; bbdb-pgp.el --- use BBDB to handle PGP preferences -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2013-2017  Free Software Foundation, Inc.
   4
   5 ;; This file is part of the Insidious Big Brother Database (aka BBDB),
   6
   7 ;; BBDB is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; BBDB is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with BBDB.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21 ;; It is believed that encrypted mail works best if all mail between
  22 ;; individuals is encrypted - even concerning matters that are not
  23 ;; confidential.  The reasoning is that confidential messages cannot
  24 ;; then be easily spotted and decryption efforts concentrated on them.
  25 ;; Some people therefore prefer to have all their email encrypted.
  26 ;; This package allows you to mark the BBDB entries for those
  27 ;; individuals so that messages will be (signed or) encrypted
  28 ;; when they are sent.
  29
  30 ;;; Usage:
  31 ;; Add the xfield pgp-mail (see `bbdb-pgp-field') with the value
  32 ;; `sign' or `encrypt' to the BBDB records of the message recipients.
  33 ;; If the value is `sign-query' or `encrypt-query', this will query
  34 ;; whether to send signed or encrypted messages.
  35 ;;
  36 ;; Then call `bbdb-pgp' on outgoing message to add MML tags,
  37 ;; see info node `(message)security'.  For all message recipients
  38 ;; in `bbdb-pgp-headers', this command grabs the action in `bbdb-pgp-field'
  39 ;; of their BBDB records.  If this proposes multiple actions,
  40 ;; perform the action which appears first in `bbdb-pgp-ranked-actions'.
  41 ;; If this proposes no action at all, use `bbdb-pgp-default'.
  42 ;; The variable `bbdb-pgp-method' defines the method which is actually used
  43 ;; for signing and encrypting, see also `bbdb-pgp-method-alist'.
  44 ;;
  45 ;; `bbdb-pgp' works with both `mail-mode' and `message-mode' to send
  46 ;; signed or encrypted mail.
  47 ;;
  48 ;; To run `bbdb-pgp' automatically when sending a message,
  49 ;; use `bbdb-initialize' with arg `pgp' to add this function
  50 ;; to `message-send-hook' and `mail-send-hook'.
  51 ;; Yet see info node `(message)Signing and encryption' why you
  52 ;; might not want to rely for encryption on a hook function
  53 ;; which runs just before the message is sent, that is, you might want
  54 ;; to call the command `bbdb-pgp' manually, then call `mml-preview'.
  55 ;;
  56 ;; A thought: For these hooks we could define a wrapper that calls
  57 ;; first `bbdb-pgp', then `mml-preview' for preview.  The wrapper should
  58 ;; abort the sending of the message if the preview is not getting
  59 ;; the user's approval.  Yet this might require some recursive editing mode
  60 ;; so that the user can browse the preview before approving it.
  61 ;;
  62 ;;; Todo:
  63 ;; Spot incoming PGP-signed or encrypted messages and prompt for adding
  64 ;; `bbdb-pgp-field' to the senders' BBDB records; similar to how
  65 ;; bbdb-sc.el maintains attribution preferences.
  66
  67 ;;; Code:
  68
  69 (require 'message)
  70 (require 'bbdb-com)
  71
  72 (defcustom bbdb-pgp-field 'pgp-mail
  73   "BBDB xfield holding the PGP action.
  74 If the recipient of a message has this xfield in his/her BBDB record,
  75 its value determines whether `bbdb-pgp' signs or encrypts the message.
  76 The value of this xfield should be one of the following symbols:
  77   sign            Sign the message
  78   sign-query      Query whether to sign the message
  79   encrypt         Encrypt the message
  80   encrypt-query   Query whether to encrypt the message
  81 If the xfield is absent use `bbdb-pgp-default'.
  82 See also info node `(message)security'."
  83   :type '(symbol :tag "BBDB xfield")
  84   :group 'bbdb-utilities-pgp)
  85
  86 (defcustom bbdb-pgp-default nil
  87   "Default action when sending a message and the recipients are not in BBDB.
  88 This should be one of the following symbols:
  89   nil             Do nothing
  90   sign            Sign the message
  91   sign-query      Query whether to sign the message
  92   encrypt         Encrypt the message
  93   encrypt-query   Query whether to encrypt the message
  94 See info node `(message)security'."
  95   :type '(choice
  96           (const :tag "Do Nothing" nil)
  97           (const :tag "Encrypt" encrypt)
  98           (const :tag "Query encryption" encrypt-query)
  99           (const :tag "Sign" sign)
 100           (const :tag "Query signing" sign-query))
 101   :group 'bbdb-utilities-pgp)
 102
 103 (defcustom bbdb-pgp-ranked-actions
 104   '(encrypt-query sign-query encrypt sign)
 105   "Ranked list of actions when sending a message.
 106 If a message has multiple recipients such that their BBDB records specify
 107 different actions for this message, `bbdb-pgp' will perform the action
 108 which appears first in `bbdb-pgp-ranked-actions'.
 109 This list should include the following four symbols:
 110   sign            Sign the message
 111   sign-query      Query whether to sign the message
 112   encrypt         Encrypt the message
 113   encrypt-query   Query whether to encrypt the message."
 114   :type '(repeat (symbol :tag "Action"))
 115   :group 'bbdb-utilities-pgp)
 116
 117 (defcustom bbdb-pgp-headers '("To" "Cc")
 118   "Message headers to look at."
 119   :type '(repeat (string :tag "Message header"))
 120   :group 'bbdb-utilities-pgp)
 121
 122 (defcustom bbdb-pgp-method 'pgpmime
 123   "Method for signing and encrypting messages.
 124 It should be one of the keys of `bbdb-pgp-method-alist'.
 125 The default methods include
 126   pgp       Add MML tags for PGP format
 127   pgpauto   Add MML tags for PGP-auto format
 128   pgpmime   Add MML tags for PGP/MIME
 129   smime     Add MML tags for S/MIME
 130 See info node `(message)security'."
 131   :type '(choice
 132           (const :tag "MML PGP" pgp)
 133           (const :tag "MML PGP-auto" pgpauto)
 134           (const :tag "MML PGP/MIME" pgpmime)
 135           (const :tag "MML S/MIME" smime)
 136           (symbol :tag "Custom"))
 137   :group 'bbdb-utilities-pgp)
 138
 139 (defcustom bbdb-pgp-method-alist
 140   '((pgp mml-secure-message-sign-pgp
 141          mml-secure-message-encrypt-pgp)
 142     (pgpmime mml-secure-message-sign-pgpmime
 143              mml-secure-message-encrypt-pgpmime)
 144     (smime mml-secure-message-sign-smime
 145            mml-secure-message-encrypt-smime)
 146     (pgpauto mml-secure-message-sign-pgpauto
 147              mml-secure-message-encrypt-pgpauto))
 148   "Alist of methods for signing and encrypting a message with `bbdb-pgp'.
 149 Each method is a list (KEY SIGN ENCRYPT).
 150 The symbol KEY identifies the method.  The function SIGN signs the message;
 151 the function ENCRYPT encrypts it.  These functions take no arguments.
 152 The default methods include
 153   pgp       Add MML tags for PGP format
 154   pgpauto   Add MML tags for PGP-auto format
 155   pgpmime   Add MML tags for PGP/MIME
 156   smime     Add MML tags for S/MIME
 157 See info node `(message)security'."
 158   :type '(repeat (list (symbol :tag "Key")
 159                        (symbol :tag "Sign method")
 160                        (symbol :tag "Encrypt method")))
 161   :group 'bbdb-utilities-pgp)
 162
 163 ;;;###autoload
 164 (defun bbdb-read-xfield-pgp-mail (&optional init)
 165   "Set `bbdb-pgp-field', requiring match with `bbdb-pgp-ranked-actions'."
 166   (bbdb-read-string "PGP action: " init
 167                     (mapcar 'list bbdb-pgp-ranked-actions) t))
 168
 169 ;;;###autoload
 170 (defun bbdb-pgp ()
 171   "Add PGP MML tags to a message according to the recipients' BBDB records.
 172 For all message recipients in `bbdb-pgp-headers', this grabs the action
 173 in `bbdb-pgp-field' of their BBDB records.  If this proposes multiple actions,
 174 perform the action which appears first in `bbdb-pgp-ranked-actions'.
 175 If this proposes no action at all, use `bbdb-pgp-default'.
 176 The variable `bbdb-pgp-method' defines the method which is actually used
 177 for signing and encrypting.
 178
 179 This command works with both `mail-mode' and `message-mode' to send
 180 signed or encrypted mail.
 181
 182 To run this command automatically when sending a message,
 183 use `bbdb-initialize' with arg `pgp' to add this function
 184 to `message-send-hook' and `mail-send-hook'.
 185 Yet see info node `(message)Signing and encryption' why you
 186 might not want to rely for encryption on a hook function
 187 which runs just before the message is sent, that is, you might want
 188 to call the command `bbdb-pgp' manually, then call `mml-preview'."
 189   (interactive)
 190   (save-excursion
 191     (save-restriction
 192       (widen)
 193       (message-narrow-to-headers)
 194       (when mail-aliases
 195         ;; (sendmail-sync-aliases) ; needed?
 196         (expand-mail-aliases (point-min) (point-max)))
 197       (let ((actions
 198              (or (delq nil
 199                        (delete-dups
 200                         (mapcar
 201                          (lambda (record)
 202                            (bbdb-record-xfield-intern record bbdb-pgp-field))
 203                          (delete-dups
 204                           (apply 'nconc
 205                                  (mapcar
 206                                   (lambda (address)
 207                                     (bbdb-message-search (car address)
 208                                                          (cadr address)))
 209                                   (bbdb-extract-address-components
 210                                    (mapconcat
 211                                     (lambda (header)
 212                                       (mail-fetch-field header nil t))
 213                                     bbdb-pgp-headers ", ")
 214                                    t)))))))
 215                  (and bbdb-pgp-default
 216                       (list bbdb-pgp-default)))))
 217         (when actions
 218           (widen) ; after analyzing the headers
 219           (let ((ranked-actions bbdb-pgp-ranked-actions)
 220                 action)
 221             (while ranked-actions
 222               (if (memq (setq action (pop ranked-actions)) actions)
 223                   (cond ((or (eq action 'sign)
 224                              (and (eq action 'sign-query)
 225                                   (y-or-n-p "Sign message? ")))
 226                          (funcall (nth 1 (assq bbdb-pgp-method
 227                                                bbdb-pgp-method-alist)))
 228                          (setq ranked-actions nil))
 229                         ((or (eq action 'encrypt)
 230                              (and (eq action 'encrypt-query)
 231                                   (y-or-n-p "Encrypt message? ")))
 232                          (funcall (nth 2 (assq bbdb-pgp-method
 233                                                bbdb-pgp-method-alist)))
 234                          (setq ranked-actions nil)))))))))))
 235
 236 (provide 'bbdb-pgp)
 237
 238 ;;; bbdb-pgp.el ends here