| 1 | ;;; mml-sec.el --- A package with security functions for MML documents |
| 2 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; Author: Simon Josefsson <simon@josefsson.org> |
| 5 | |
| 6 | ;; This file is part of GNU Emacs. |
| 7 | |
| 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 9 | ;; it under the terms of the GNU General Public License as published by |
| 10 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 11 | ;; any later version. |
| 12 | |
| 13 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 16 | ;; GNU General Public License for more details. |
| 17 | |
| 18 | ;; You should have received a copy of the GNU General Public License |
| 19 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 20 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 21 | ;; Boston, MA 02111-1307, USA. |
| 22 | |
| 23 | ;;; Commentary: |
| 24 | |
| 25 | ;;; Code: |
| 26 | |
| 27 | (require 'mml-smime) |
| 28 | (eval-when-compile (require 'cl)) |
| 29 | (autoload 'mml2015-sign "mml2015") |
| 30 | (autoload 'mml2015-encrypt "mml2015") |
| 31 | (autoload 'mml1991-sign "mml1991") |
| 32 | (autoload 'mml1991-encrypt "mml1991") |
| 33 | (autoload 'message-goto-body "message") |
| 34 | (autoload 'mml-insert-tag "mml") |
| 35 | |
| 36 | (defvar mml-sign-alist |
| 37 | '(("smime" mml-smime-sign-buffer mml-smime-sign-query) |
| 38 | ("pgp" mml-pgp-sign-buffer list) |
| 39 | ("pgpauto" mml-pgpauto-sign-buffer list) |
| 40 | ("pgpmime" mml-pgpmime-sign-buffer list)) |
| 41 | "Alist of MIME signer functions.") |
| 42 | |
| 43 | (defcustom mml-default-sign-method "pgpmime" |
| 44 | "Default sign method. |
| 45 | The string must have an entry in `mml-sign-alist'." |
| 46 | :version "22.1" |
| 47 | :type '(choice (const "smime") |
| 48 | (const "pgp") |
| 49 | (const "pgpauto") |
| 50 | (const "pgpmime") |
| 51 | string) |
| 52 | :group 'message) |
| 53 | |
| 54 | (defvar mml-encrypt-alist |
| 55 | '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query) |
| 56 | ("pgp" mml-pgp-encrypt-buffer list) |
| 57 | ("pgpauto" mml-pgpauto-sign-buffer list) |
| 58 | ("pgpmime" mml-pgpmime-encrypt-buffer list)) |
| 59 | "Alist of MIME encryption functions.") |
| 60 | |
| 61 | (defcustom mml-default-encrypt-method "pgpmime" |
| 62 | "Default encryption method. |
| 63 | The string must have an entry in `mml-encrypt-alist'." |
| 64 | :version "22.1" |
| 65 | :type '(choice (const "smime") |
| 66 | (const "pgp") |
| 67 | (const "pgpauto") |
| 68 | (const "pgpmime") |
| 69 | string) |
| 70 | :group 'message) |
| 71 | |
| 72 | (defcustom mml-signencrypt-style-alist |
| 73 | '(("smime" separate) |
| 74 | ("pgp" combined) |
| 75 | ("pgpauto" combined) |
| 76 | ("pgpmime" combined)) |
| 77 | "Alist specifying if `signencrypt' results in two separate operations or not. |
| 78 | The first entry indicates the MML security type, valid entries include |
| 79 | the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is |
| 80 | a symbol `separate' or `combined' where `separate' means that MML signs |
| 81 | and encrypt messages in a two step process, and `combined' means that MML |
| 82 | signs and encrypt the message in one step. |
| 83 | |
| 84 | Note that the output generated by using a `combined' mode is NOT |
| 85 | understood by all PGP implementations, in particular PGP version |
| 86 | 2 does not support it! See Info node `(message)Security' for |
| 87 | details." |
| 88 | :version "22.1" |
| 89 | :group 'message |
| 90 | :type '(repeat (list (choice (const :tag "S/MIME" "smime") |
| 91 | (const :tag "PGP" "pgp") |
| 92 | (const :tag "PGP/MIME" "pgpmime") |
| 93 | (string :tag "User defined")) |
| 94 | (choice (const :tag "Separate" separate) |
| 95 | (const :tag "Combined" combined))))) |
| 96 | |
| 97 | ;;; Configuration/helper functions |
| 98 | |
| 99 | (defun mml-signencrypt-style (method &optional style) |
| 100 | "Function for setting/getting the signencrypt-style used. Takes two |
| 101 | arguments, the method (e.g. \"pgp\") and optionally the mode |
| 102 | \(e.g. combined). If the mode is omitted, the current value is returned. |
| 103 | |
| 104 | For example, if you prefer to use combined sign & encrypt with |
| 105 | smime, putting the following in your Gnus startup file will |
| 106 | enable that behavior: |
| 107 | |
| 108 | \(mml-set-signencrypt-style \"smime\" combined) |
| 109 | |
| 110 | You can also customize or set `mml-signencrypt-style-alist' instead." |
| 111 | (let ((style-item (assoc method mml-signencrypt-style-alist))) |
| 112 | (if style-item |
| 113 | (if (or (eq style 'separate) |
| 114 | (eq style 'combined)) |
| 115 | ;; valid style setting? |
| 116 | (setf (second style-item) style) |
| 117 | ;; otherwise, just return the current value |
| 118 | (second style-item)) |
| 119 | (message "Warning, attempt to set invalid signencrypt style")))) |
| 120 | |
| 121 | ;;; Security functions |
| 122 | |
| 123 | (defun mml-smime-sign-buffer (cont) |
| 124 | (or (mml-smime-sign cont) |
| 125 | (error "Signing failed... inspect message logs for errors"))) |
| 126 | |
| 127 | (defun mml-smime-encrypt-buffer (cont &optional sign) |
| 128 | (when sign |
| 129 | (message "Combined sign and encrypt S/MIME not support yet") |
| 130 | (sit-for 1)) |
| 131 | (or (mml-smime-encrypt cont) |
| 132 | (error "Encryption failed... inspect message logs for errors"))) |
| 133 | |
| 134 | (defun mml-pgp-sign-buffer (cont) |
| 135 | (or (mml1991-sign cont) |
| 136 | (error "Signing failed... inspect message logs for errors"))) |
| 137 | |
| 138 | (defun mml-pgp-encrypt-buffer (cont &optional sign) |
| 139 | (or (mml1991-encrypt cont sign) |
| 140 | (error "Encryption failed... inspect message logs for errors"))) |
| 141 | |
| 142 | (defun mml-pgpmime-sign-buffer (cont) |
| 143 | (or (mml2015-sign cont) |
| 144 | (error "Signing failed... inspect message logs for errors"))) |
| 145 | |
| 146 | (defun mml-pgpmime-encrypt-buffer (cont &optional sign) |
| 147 | (or (mml2015-encrypt cont sign) |
| 148 | (error "Encryption failed... inspect message logs for errors"))) |
| 149 | |
| 150 | (defun mml-pgpauto-sign-buffer (cont) |
| 151 | (message-goto-body) |
| 152 | (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way... |
| 153 | (mml2015-sign cont) |
| 154 | (mml1991-sign cont)) |
| 155 | (error "Encryption failed... inspect message logs for errors"))) |
| 156 | |
| 157 | (defun mml-pgpauto-encrypt-buffer (cont &optional sign) |
| 158 | (message-goto-body) |
| 159 | (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way... |
| 160 | (mml2015-encrypt cont sign) |
| 161 | (mml1991-encrypt cont sign)) |
| 162 | (error "Encryption failed... inspect message logs for errors"))) |
| 163 | |
| 164 | (defun mml-secure-part (method &optional sign) |
| 165 | (save-excursion |
| 166 | (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist |
| 167 | mml-encrypt-alist)))))) |
| 168 | (cond ((re-search-backward |
| 169 | "<#\\(multipart\\|part\\|external\\|mml\\)" nil t) |
| 170 | (goto-char (match-end 0)) |
| 171 | (insert (if sign " sign=" " encrypt=") method) |
| 172 | (while tags |
| 173 | (let ((key (pop tags)) |
| 174 | (value (pop tags))) |
| 175 | (when value |
| 176 | ;; Quote VALUE if it contains suspicious characters. |
| 177 | (when (string-match "[\"'\\~/*;() \t\n]" value) |
| 178 | (setq value (prin1-to-string value))) |
| 179 | (insert (format " %s=%s" key value)))))) |
| 180 | ((or (re-search-backward |
| 181 | (concat "^" (regexp-quote mail-header-separator) "\n") nil t) |
| 182 | (re-search-forward |
| 183 | (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) |
| 184 | (goto-char (match-end 0)) |
| 185 | (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) |
| 186 | (cons method tags)))) |
| 187 | (t (error "The message is corrupted. No mail header separator")))))) |
| 188 | |
| 189 | (defun mml-secure-sign-pgp () |
| 190 | "Add MML tags to PGP sign this MML part." |
| 191 | (interactive) |
| 192 | (mml-secure-part "pgp" 'sign)) |
| 193 | |
| 194 | (defun mml-secure-sign-pgpauto () |
| 195 | "Add MML tags to PGP-auto sign this MML part." |
| 196 | (interactive) |
| 197 | (mml-secure-part "pgpauto" 'sign)) |
| 198 | |
| 199 | (defun mml-secure-sign-pgpmime () |
| 200 | "Add MML tags to PGP/MIME sign this MML part." |
| 201 | (interactive) |
| 202 | (mml-secure-part "pgpmime" 'sign)) |
| 203 | |
| 204 | (defun mml-secure-sign-smime () |
| 205 | "Add MML tags to S/MIME sign this MML part." |
| 206 | (interactive) |
| 207 | (mml-secure-part "smime" 'sign)) |
| 208 | |
| 209 | (defun mml-secure-encrypt-pgp () |
| 210 | "Add MML tags to PGP encrypt this MML part." |
| 211 | (interactive) |
| 212 | (mml-secure-part "pgp")) |
| 213 | |
| 214 | (defun mml-secure-encrypt-pgpmime () |
| 215 | "Add MML tags to PGP/MIME encrypt this MML part." |
| 216 | (interactive) |
| 217 | (mml-secure-part "pgpmime")) |
| 218 | |
| 219 | (defun mml-secure-encrypt-smime () |
| 220 | "Add MML tags to S/MIME encrypt this MML part." |
| 221 | (interactive) |
| 222 | (mml-secure-part "smime")) |
| 223 | |
| 224 | ;; defuns that add the proper <#secure ...> tag to the top of the message body |
| 225 | (defun mml-secure-message (method &optional modesym) |
| 226 | (let ((mode (prin1-to-string modesym)) |
| 227 | insert-loc) |
| 228 | (mml-unsecure-message) |
| 229 | (save-excursion |
| 230 | (goto-char (point-min)) |
| 231 | (cond ((re-search-forward |
| 232 | (concat "^" (regexp-quote mail-header-separator) "\n") nil t) |
| 233 | (goto-char (setq insert-loc (match-end 0))) |
| 234 | (unless (looking-at "<#secure") |
| 235 | (mml-insert-tag |
| 236 | 'secure 'method method 'mode mode))) |
| 237 | (t (error |
| 238 | "The message is corrupted. No mail header separator")))) |
| 239 | (when (eql insert-loc (point)) |
| 240 | (forward-line 1)))) |
| 241 | |
| 242 | (defun mml-unsecure-message () |
| 243 | "Remove security related MML tags from message." |
| 244 | (interactive) |
| 245 | (save-excursion |
| 246 | (goto-char (point-max)) |
| 247 | (when (re-search-backward "^<#secure.*>\n" nil t) |
| 248 | (delete-region (match-beginning 0) (match-end 0))))) |
| 249 | |
| 250 | (defun mml-secure-message-sign-smime () |
| 251 | "Add MML tag to encrypt/sign the entire message." |
| 252 | (interactive) |
| 253 | (mml-secure-message "smime" 'sign)) |
| 254 | |
| 255 | (defun mml-secure-message-sign-pgp () |
| 256 | "Add MML tag to encrypt/sign the entire message." |
| 257 | (interactive) |
| 258 | (mml-secure-message "pgp" 'sign)) |
| 259 | |
| 260 | (defun mml-secure-message-sign-pgpmime () |
| 261 | "Add MML tag to encrypt/sign the entire message." |
| 262 | (interactive) |
| 263 | (mml-secure-message "pgpmime" 'sign)) |
| 264 | |
| 265 | (defun mml-secure-message-sign-pgpauto () |
| 266 | "Add MML tag to encrypt/sign the entire message." |
| 267 | (interactive) |
| 268 | (mml-secure-message "pgpauto" 'sign)) |
| 269 | |
| 270 | (defun mml-secure-message-encrypt-smime (&optional dontsign) |
| 271 | "Add MML tag to encrypt and sign the entire message. |
| 272 | If called with a prefix argument, only encrypt (do NOT sign)." |
| 273 | (interactive "P") |
| 274 | (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt))) |
| 275 | |
| 276 | (defun mml-secure-message-encrypt-pgp (&optional dontsign) |
| 277 | "Add MML tag to encrypt and sign the entire message. |
| 278 | If called with a prefix argument, only encrypt (do NOT sign)." |
| 279 | (interactive "P") |
| 280 | (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt))) |
| 281 | |
| 282 | (defun mml-secure-message-encrypt-pgpmime (&optional dontsign) |
| 283 | "Add MML tag to encrypt and sign the entire message. |
| 284 | If called with a prefix argument, only encrypt (do NOT sign)." |
| 285 | (interactive "P") |
| 286 | (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt))) |
| 287 | |
| 288 | (defun mml-secure-message-encrypt-pgpauto (&optional dontsign) |
| 289 | "Add MML tag to encrypt and sign the entire message. |
| 290 | If called with a prefix argument, only encrypt (do NOT sign)." |
| 291 | (interactive "P") |
| 292 | (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) |
| 293 | |
| 294 | (provide 'mml-sec) |
| 295 | |
| 296 | ;;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c |
| 297 | ;;; mml-sec.el ends here |