17450
|
1 ;;; uce.el --- facilitate reply to unsolicited commercial email
|
|
2
|
74509
|
3 ;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004,
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
17450
|
5
|
22416
|
6 ;; Author: stanislav shalunov <shalunov@mccme.ru>
|
17450
|
7 ;; Created: 10 Dec 1996
|
|
8 ;; Keywords: uce, unsolicited commercial email
|
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
38401
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
78232
|
14 ;; the Free Software Foundation; either version 3, or (at your option)
|
38401
|
15 ;; any later version.
|
17450
|
16
|
38401
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
17450
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
25 ;; Boston, MA 02110-1301, USA.
|
17450
|
26
|
|
27 ;;; Commentary:
|
|
28
|
|
29 ;; Code in this file provides semi-automatic means of replying to
|
22416
|
30 ;; UCE's you might get. It works currently only with Rmail and Gnus.
|
|
31 ;; If you would like to make it work with other mail readers,
|
|
32 ;; Rmail-specific section is marked below. If you want to play with
|
|
33 ;; code, please let me know about your changes so I can incorporate
|
|
34 ;; them. I'd appreciate it.
|
17450
|
35
|
|
36 ;; Function uce-reply-to-uce, if called when current message in RMAIL
|
|
37 ;; buffer is a UCE, will setup *mail* buffer in the following way: it
|
|
38 ;; scans full headers of message for 1) normal return address of
|
|
39 ;; sender (From, Reply-To lines); and puts these addresses into To:
|
|
40 ;; header, it also puts abuse@offenders.host address there 2) mailhub
|
|
41 ;; that first saw this message; and puts address of its postmaster
|
|
42 ;; into To: header 3) finally, it looks at Message-Id and adds
|
|
43 ;; posmaster of that host to the list of addresses.
|
|
44
|
|
45 ;; Then, we add "Errors-To: nobody@localhost" header, so that if some
|
|
46 ;; of these addresses are not actually correct, we will never see
|
|
47 ;; bounced mail. Also, mail-self-blind and mail-archive-file-name
|
|
48 ;; take no effect: the ideology is that we don't want to save junk or
|
|
49 ;; replies to junk.
|
|
50
|
|
51 ;; Then we put template into buffer (customizable message that
|
|
52 ;; explains what has happened), customizable signature, and the
|
|
53 ;; original message with full headers and envelope for postmasters.
|
|
54 ;; Then buffer is left for editing.
|
|
55
|
|
56 ;; The reason that function uce-reply-to-uce is Rmail dependant is
|
|
57 ;; that we want full headers of the original message, nothing
|
|
58 ;; stripped. If we use normal means of inserting of the original
|
|
59 ;; message into *mail* buffer headers like Received: (not really
|
|
60 ;; headers, but envelope lines) will be stripped while they bear
|
|
61 ;; valuable for us and postmasters information. I do wish that there
|
|
62 ;; would be some way to write this function in some portable way, but
|
|
63 ;; I am not aware of any.
|
|
64
|
|
65 ;;; Change log:
|
|
66
|
|
67 ;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
|
|
68
|
|
69 ;; Dec 11, 1996 -- fixed some typos, and Francesco Potorti`
|
|
70 ;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was
|
|
71 ;; weird, suggested fix, and added let form.
|
|
72
|
|
73 ;; Dec 17, 1996 -- made scanning for host names little bit more clever
|
|
74 ;; (obviously bogus stuff like localhost is now ignored).
|
|
75
|
22416
|
76 ;; Nov 11, 1997 -- incorporated changes from Mikael Djurfeldt
|
|
77 ;; <mdj@nada.kth.se> to make uce.el work with Gnus. Changed the text
|
|
78 ;; of message that is sent.
|
|
79
|
|
80 ;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk>
|
|
81 ;; handling Received headers following some line like `From:'.
|
|
82
|
31224
|
83 ;; Aug 16, 2000 -- changes from Detlev Zundel
|
|
84 ;; <detlev.zundel@stud.uni-karlsruhe.de> to make uce.el work with the
|
|
85 ;; latest Gnus. Lars told him it should work for all versions of Gnus
|
|
86 ;; younger than three years.
|
17450
|
87
|
31224
|
88 ;; Setup:
|
|
89
|
|
90 ;; Add the following line to your ~/.emacs:
|
17450
|
91
|
|
92 ;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
|
|
93
|
22416
|
94 ;; If you want to use it with Gnus also use
|
|
95
|
|
96 ;; (setq uce-mail-reader 'gnus)
|
|
97
|
17450
|
98 ;; store this file (uce.el) somewhere in load-path and byte-compile it.
|
|
99
|
|
100 ;;; Variables:
|
|
101
|
|
102 ;; uce-message-text is template that will be inserted into buffer. It
|
|
103 ;; has reasonable default. If you want to write some scarier one,
|
|
104 ;; please do so and send it to me. Please keep it polite.
|
|
105
|
|
106 ;; uce-signature behaves just like mail-signature. If nil, nothing is
|
|
107 ;; inserted, if t, file ~/.signature is used, if a string, its
|
|
108 ;; contents are inserted into buffer.
|
|
109
|
|
110 ;; uce-uce-separator is line that separates your message from the UCE
|
|
111 ;; that you enclose.
|
|
112
|
|
113 ;; uce-subject-line will be used as subject of outgoing message. If
|
|
114 ;; nil, left blank.
|
|
115
|
|
116 ;;; Code:
|
|
117
|
65205
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
118 (defvar gnus-original-article-buffer)
|
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
119 (defvar mail-reply-buffer)
|
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
120 (defvar rmail-current-message)
|
98f74806263a
(gnus-original-article-buffer, mail-reply-buffer, rmail-current-message):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
121
|
17450
|
122 (require 'sendmail)
|
22416
|
123 ;; Those sections of code which are dependent upon
|
|
124 ;; RMAIL are only evaluated if we have received a message with RMAIL...
|
49598
|
125 ;;(require 'rmail)
|
22416
|
126
|
20962
|
127 (defgroup uce nil
|
|
128 "Facilitate reply to unsolicited commercial email."
|
|
129 :prefix "uce-"
|
|
130 :group 'mail)
|
|
131
|
22462
|
132 (defcustom uce-mail-reader 'rmail
|
|
133 "A symbol indicating which mail reader you are using.
|
|
134 Choose from: `gnus', `rmail'."
|
|
135 :type '(choice (const gnus) (const rmail))
|
|
136 :version "20.3"
|
|
137 :group 'uce)
|
|
138
|
20962
|
139 (defcustom uce-setup-hook nil
|
17450
|
140 "Hook to run after UCE rant message is composed.
|
22462
|
141 This hook is run after `mail-setup-hook', which is run as well."
|
20962
|
142 :type 'hook
|
|
143 :group 'uce)
|
17450
|
144
|
49598
|
145 (defcustom uce-message-text
|
17450
|
146 "Recently, I have received an Unsolicited Commercial E-mail from you.
|
|
147 I do not like UCE's and I would like to inform you that sending
|
|
148 unsolicited messages to someone while he or she may have to pay for
|
|
149 reading your message may be illegal. Anyway, it is highly annoying
|
|
150 and not welcome by anyone. It is rude, after all.
|
|
151
|
|
152 If you think that this is a good way to advertise your products or
|
|
153 services you are mistaken. Spamming will only make people hate you, not
|
|
154 buy from you.
|
|
155
|
49598
|
156 If you have any list of people you send unsolicited commercial emails to,
|
|
157 REMOVE me from such list immediately. I suggest that you make this list
|
17450
|
158 just empty.
|
|
159
|
22416
|
160 ----------------------------------------------------
|
|
161
|
|
162 If you are not an administrator of any site and still have received
|
|
163 this message then your email address is being abused by some spammer.
|
|
164 They fake your address in From: or Reply-To: header. In this case,
|
|
165 you might want to show this message to your system administrator, and
|
|
166 ask him/her to investigate this matter.
|
|
167
|
17450
|
168 Note to the postmaster(s): I append the text of UCE in question to
|
22416
|
169 this message; I would like to hear from you about action(s) taken.
|
17450
|
170 This message has been sent to postmasters at the host that is
|
22416
|
171 mentioned as original sender's host (I do realize that it may be
|
|
172 faked, but I think that if your domain name is being abused this way
|
|
173 you might want to learn about it, and take actions) and to the
|
|
174 postmaster whose host was used as mail relay for this message. If
|
|
175 message was sent not by your user, could you please compare time when
|
|
176 this message was sent (use time in Received: field of the envelope
|
|
177 rather than Date: field) with your sendmail logs and see what host was
|
|
178 using your sendmail at this moment of time.
|
17450
|
179
|
|
180 Thank you."
|
|
181
|
22462
|
182 "This is the text that `uce-reply-to-uce' command will put in reply buffer.
|
17450
|
183 Some of spamming programs in use will be set up to read all incoming
|
|
184 to spam address email, and will remove people who put the word `remove'
|
|
185 on beginning of some line from the spamming list. So, when you set it
|
|
186 up, it might be a good idea to actually use this feature.
|
|
187
|
20962
|
188 Value nil means insert no text by default, lets you type it in."
|
|
189 :type 'string
|
|
190 :group 'uce)
|
17450
|
191
|
20962
|
192 (defcustom uce-uce-separator
|
17450
|
193 "----- original unsolicited commercial email follows -----"
|
|
194 "Line that will begin quoting of the UCE.
|
20962
|
195 Value nil means use no separator."
|
|
196 :type '(choice (const nil) string)
|
|
197 :group 'uce)
|
17450
|
198
|
20962
|
199 (defcustom uce-signature mail-signature
|
49598
|
200 "Text to put as your signature after the note to UCE sender.
|
22462
|
201 Value nil means none, t means insert `~/.signature' file (if it happens
|
17450
|
202 to exist), if this variable is a string this string will be inserted
|
20962
|
203 as your signature."
|
|
204 :type '(choice (const nil) (const t) string)
|
|
205 :group 'uce)
|
17450
|
206
|
20962
|
207 (defcustom uce-default-headers
|
17450
|
208 "Errors-To: nobody@localhost\nPrecedence: bulk\n"
|
|
209 "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
|
20962
|
210 These are mostly meant for headers that prevent delivery errors reporting."
|
|
211 :type 'string
|
|
212 :group 'uce)
|
17450
|
213
|
20962
|
214 (defcustom uce-subject-line
|
17450
|
215 "Spam alert: unsolicited commercial e-mail"
|
20962
|
216 "Subject of the message that will be sent in response to a UCE."
|
|
217 :type 'string
|
|
218 :group 'uce)
|
17450
|
219
|
|
220 (defun uce-reply-to-uce (&optional ignored)
|
|
221 "Send reply to UCE in Rmail.
|
|
222 UCE stands for unsolicited commercial email. Function will set up reply
|
|
223 buffer with default To: to the sender, his postmaster, his abuse@
|
|
224 address, and postmaster of the mail relay used."
|
22416
|
225 (interactive)
|
|
226 (let ((message-buffer
|
31224
|
227 (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
|
22416
|
228 ((eq uce-mail-reader 'rmail) "RMAIL")
|
49598
|
229 (t (error
|
43067
|
230 "Variable uce-mail-reader set to unrecognized value"))))
|
|
231 (full-header-p (and (eq uce-mail-reader 'rmail)
|
|
232 (not (rmail-msg-is-pruned)))))
|
22416
|
233 (or (get-buffer message-buffer)
|
|
234 (error (concat "No buffer " message-buffer ", cannot find UCE")))
|
|
235 (switch-to-buffer message-buffer)
|
43067
|
236 ;; We need the message with headers pruned.
|
|
237 (if full-header-p
|
|
238 (rmail-toggle-header 1))
|
22416
|
239 (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
|
|
240 (reply-to (mail-fetch-field "reply-to"))
|
|
241 temp)
|
|
242 ;; Initial setting of the list of recipients of our message; that's
|
|
243 ;; what they are pretending to be.
|
17450
|
244 (if to
|
22416
|
245 (setq to (format "%s" (mail-strip-quoted-names to)))
|
|
246 (setq to ""))
|
|
247 (if reply-to
|
|
248 (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
|
|
249 (let (first-at-sign end-of-hostname sender-host)
|
|
250 (setq first-at-sign (string-match "@" to)
|
|
251 end-of-hostname (string-match "[ ,>]" to first-at-sign)
|
|
252 sender-host (substring to first-at-sign end-of-hostname))
|
|
253 (if (string-match "\\." sender-host)
|
49598
|
254 (setq to (format "%s, postmaster%s, abuse%s"
|
22416
|
255 to sender-host sender-host))))
|
|
256 (setq mail-send-actions nil)
|
|
257 (setq mail-reply-buffer nil)
|
|
258 (cond ((eq uce-mail-reader 'gnus)
|
31224
|
259 (copy-region-as-kill (point-min) (point-max)))
|
22416
|
260 ((eq uce-mail-reader 'rmail)
|
|
261 (save-excursion
|
|
262 (save-restriction
|
43387
|
263 (rmail-toggle-header 1)
|
22416
|
264 (widen)
|
|
265 (rmail-maybe-set-message-counters)
|
49598
|
266 (copy-region-as-kill (rmail-msgbeg rmail-current-message)
|
22416
|
267 (rmail-msgend rmail-current-message))))))
|
43067
|
268 ;; Restore the pruned header state we found.
|
|
269 (if full-header-p
|
|
270 (rmail-toggle-header 0))
|
22416
|
271 (switch-to-buffer "*mail*")
|
|
272 (erase-buffer)
|
|
273 (setq temp (point))
|
|
274 (yank)
|
|
275 (goto-char temp)
|
|
276 (if (eq uce-mail-reader 'rmail)
|
|
277 (progn
|
|
278 (forward-line 2)
|
23458
|
279 (let ((case-fold-search t))
|
|
280 (while (looking-at "Summary-Line:\\|Mail-From:")
|
|
281 (forward-line 1)))
|
22416
|
282 (delete-region temp (point))))
|
|
283 ;; Now find the mail hub that first accepted this message.
|
|
284 ;; This should try to find the last Received: header.
|
|
285 ;; Sometimes there may be other headers inbetween Received: headers.
|
|
286 (cond ((eq uce-mail-reader 'gnus)
|
|
287 ;; Does Gnus always have Lines: in the end?
|
|
288 (re-search-forward "^Lines:")
|
|
289 (beginning-of-line))
|
|
290 ((eq uce-mail-reader 'rmail)
|
64386
d24c0f192f20
(uce-reply-to-uce): Replace beginning-of-buffer and insert-file.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
291 (goto-char (point-min))
|
22416
|
292 (search-forward "*** EOOH ***\n")
|
|
293 (beginning-of-line)
|
49598
|
294 (forward-line -1)))
|
22416
|
295 (re-search-backward "^Received:")
|
|
296 (beginning-of-line)
|
|
297 ;; Is this always good? It's the only thing I saw when I checked
|
|
298 ;; a few messages.
|
|
299 (let ((eol (save-excursion (end-of-line) (point))))
|
|
300 ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
|
|
301 (if (not (re-search-forward "\\(from\\|by\\) " eol t))
|
|
302 (progn
|
|
303 (goto-char eol)
|
|
304 (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
|
|
305 (goto-char (match-end 0))
|
|
306 (error "Failed to extract hub address")))))
|
|
307 (setq temp (point))
|
|
308 (search-forward " ")
|
|
309 (forward-char -1)
|
|
310 ;; And add its postmaster to the list of addresses.
|
|
311 (if (string-match "\\." (buffer-substring temp (point)))
|
49598
|
312 (setq to (format "%s, postmaster@%s"
|
22416
|
313 to (buffer-substring temp (point)))))
|
|
314 ;; Also look at the message-id, it helps *very* often.
|
|
315 (if (and (search-forward "\nMessage-Id: " nil t)
|
|
316 ;; Not all Message-Id:'s have an `@' sign.
|
|
317 (let ((bol (point))
|
|
318 eol)
|
|
319 (end-of-line)
|
|
320 (setq eol (point))
|
|
321 (goto-char bol)
|
|
322 (search-forward "@" eol t)))
|
|
323 (progn
|
|
324 (setq temp (point))
|
|
325 (search-forward ">")
|
|
326 (forward-char -1)
|
|
327 (if (string-match "\\." (buffer-substring temp (point)))
|
49598
|
328 (setq to (format "%s, postmaster@%s"
|
22416
|
329 to (buffer-substring temp (point)))))))
|
|
330 (cond ((eq uce-mail-reader 'gnus)
|
|
331 ;; Does Gnus always have Lines: in the end?
|
|
332 (re-search-forward "^Lines:")
|
|
333 (beginning-of-line))
|
|
334 ((eq uce-mail-reader 'rmail)
|
|
335 (search-forward "\n*** EOOH ***\n")
|
|
336 (forward-line -1)))
|
|
337 (setq temp (point))
|
|
338 (search-forward "\n\n" nil t)
|
|
339 (if (eq uce-mail-reader 'gnus)
|
|
340 (forward-line -1))
|
|
341 (delete-region temp (point))
|
|
342 ;; End of Rmail dependent section.
|
|
343 (auto-save-mode auto-save-default)
|
|
344 (mail-mode)
|
|
345 (goto-char (point-min))
|
|
346 (insert "To: ")
|
|
347 (save-excursion
|
|
348 (if to
|
|
349 (let ((fill-prefix "\t")
|
|
350 (address-start (point)))
|
|
351 (insert to "\n")
|
|
352 (fill-region-as-paragraph address-start (point)))
|
|
353 (newline))
|
|
354 (insert "Subject: " uce-subject-line "\n")
|
|
355 (if uce-default-headers
|
|
356 (insert uce-default-headers))
|
|
357 (if mail-default-headers
|
|
358 (insert mail-default-headers))
|
|
359 (if mail-default-reply-to
|
|
360 (insert "Reply-to: " mail-default-reply-to "\n"))
|
|
361 (insert mail-header-separator "\n")
|
|
362 ;; Insert all our text. Then go back to the place where we started.
|
|
363 (if to (setq to (point)))
|
|
364 ;; Text of ranting.
|
|
365 (if uce-message-text
|
|
366 (insert uce-message-text))
|
|
367 ;; Signature.
|
|
368 (cond ((eq uce-signature t)
|
|
369 (if (file-exists-p "~/.signature")
|
|
370 (progn
|
|
371 (insert "\n\n-- \n")
|
64386
d24c0f192f20
(uce-reply-to-uce): Replace beginning-of-buffer and insert-file.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
372 (forward-char (cadr (insert-file-contents "~/.signature"))))))
|
22416
|
373 (uce-signature
|
|
374 (insert "\n\n-- \n" uce-signature)))
|
|
375 ;; And text of the original message.
|
|
376 (if uce-uce-separator
|
|
377 (insert "\n\n" uce-uce-separator "\n"))
|
|
378 ;; If message doesn't end with a newline, insert it.
|
|
379 (goto-char (point-max))
|
|
380 (or (bolp) (newline)))
|
|
381 ;; And go back to the beginning of text.
|
|
382 (if to (goto-char to))
|
|
383 (or to (set-buffer-modified-p nil))
|
|
384 ;; Run hooks before we leave buffer for editing. Reasonable usage
|
|
385 ;; might be to set up special key bindings, replace standart
|
|
386 ;; functions in mail-mode, etc.
|
|
387 (run-hooks 'mail-setup-hook 'uce-setup-hook))))
|
49598
|
388
|
17450
|
389 (defun uce-insert-ranting (&optional ignored)
|
|
390 "Insert text of the usual reply to UCE into current buffer."
|
|
391 (interactive "P")
|
|
392 (insert uce-message-text))
|
|
393
|
|
394 (provide 'uce)
|
|
395
|
52401
|
396 ;;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221
|
17450
|
397 ;;; uce.el ends here
|