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