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