Commit | Line | Data |
---|---|---|
bf078b46 RS |
1 | ;;; uce.el --- facilitate reply to unsolicited commercial email |
2 | ||
f2e3589a | 3 | ;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, |
2f043267 | 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
bf078b46 | 5 | |
dc99d85e | 6 | ;; Author: stanislav shalunov <shalunov@mccme.ru> |
bf078b46 | 7 | ;; Created: 10 Dec 1996 |
bf078b46 RS |
8 | ;; Keywords: uce, unsolicited commercial email |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
2be7dabc GM |
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 | |
ceaeecb0 | 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
2be7dabc GM |
15 | ;; any later version. |
16 | ||
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. | |
bf078b46 RS |
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 | |
3a35cf56 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
bf078b46 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
29 | ;; Code in this file provides semi-automatic means of replying to | |
dc99d85e RS |
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. | |
bf078b46 RS |
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 | ||
dc99d85e RS |
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 | ||
db214408 GM |
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. | |
bf078b46 | 87 | |
db214408 GM |
88 | ;; Setup: |
89 | ||
90 | ;; Add the following line to your ~/.emacs: | |
bf078b46 RS |
91 | |
92 | ;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil) | |
93 | ||
dc99d85e RS |
94 | ;; If you want to use it with Gnus also use |
95 | ||
96 | ;; (setq uce-mail-reader 'gnus) | |
97 | ||
bf078b46 RS |
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 | ||
ea9a034c JB |
118 | (defvar gnus-original-article-buffer) |
119 | (defvar mail-reply-buffer) | |
120 | (defvar rmail-current-message) | |
121 | ||
bf078b46 | 122 | (require 'sendmail) |
dc99d85e RS |
123 | ;; Those sections of code which are dependent upon |
124 | ;; RMAIL are only evaluated if we have received a message with RMAIL... | |
a1506d29 | 125 | ;;(require 'rmail) |
dc99d85e | 126 | |
0b5bb3ec SE |
127 | (defgroup uce nil |
128 | "Facilitate reply to unsolicited commercial email." | |
129 | :prefix "uce-" | |
130 | :group 'mail) | |
131 | ||
e13d531d RS |
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 | ||
0b5bb3ec | 139 | (defcustom uce-setup-hook nil |
bf078b46 | 140 | "Hook to run after UCE rant message is composed. |
e13d531d | 141 | This hook is run after `mail-setup-hook', which is run as well." |
0b5bb3ec SE |
142 | :type 'hook |
143 | :group 'uce) | |
bf078b46 | 144 | |
a1506d29 | 145 | (defcustom uce-message-text |
bf078b46 RS |
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 | ||
a1506d29 JB |
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 | |
bf078b46 RS |
158 | just empty. |
159 | ||
dc99d85e RS |
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 | ||
bf078b46 | 168 | Note to the postmaster(s): I append the text of UCE in question to |
dc99d85e | 169 | this message; I would like to hear from you about action(s) taken. |
bf078b46 | 170 | This message has been sent to postmasters at the host that is |
dc99d85e RS |
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. | |
bf078b46 RS |
179 | |
180 | Thank you." | |
181 | ||
e13d531d | 182 | "This is the text that `uce-reply-to-uce' command will put in reply buffer. |
bf078b46 RS |
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 | ||
0b5bb3ec SE |
188 | Value nil means insert no text by default, lets you type it in." |
189 | :type 'string | |
190 | :group 'uce) | |
bf078b46 | 191 | |
0b5bb3ec | 192 | (defcustom uce-uce-separator |
bf078b46 RS |
193 | "----- original unsolicited commercial email follows -----" |
194 | "Line that will begin quoting of the UCE. | |
0b5bb3ec SE |
195 | Value nil means use no separator." |
196 | :type '(choice (const nil) string) | |
197 | :group 'uce) | |
bf078b46 | 198 | |
0b5bb3ec | 199 | (defcustom uce-signature mail-signature |
a1506d29 | 200 | "Text to put as your signature after the note to UCE sender. |
e13d531d | 201 | Value nil means none, t means insert `~/.signature' file (if it happens |
bf078b46 | 202 | to exist), if this variable is a string this string will be inserted |
0b5bb3ec SE |
203 | as your signature." |
204 | :type '(choice (const nil) (const t) string) | |
205 | :group 'uce) | |
bf078b46 | 206 | |
0b5bb3ec | 207 | (defcustom uce-default-headers |
bf078b46 RS |
208 | "Errors-To: nobody@localhost\nPrecedence: bulk\n" |
209 | "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce]. | |
0b5bb3ec SE |
210 | These are mostly meant for headers that prevent delivery errors reporting." |
211 | :type 'string | |
212 | :group 'uce) | |
bf078b46 | 213 | |
0b5bb3ec | 214 | (defcustom uce-subject-line |
bf078b46 | 215 | "Spam alert: unsolicited commercial e-mail" |
0b5bb3ec SE |
216 | "Subject of the message that will be sent in response to a UCE." |
217 | :type 'string | |
218 | :group 'uce) | |
bf078b46 | 219 | |
2b54af74 | 220 | (declare-function mail-strip-quoted-names "mail-utils" (address)) |
73e72da4 DN |
221 | (declare-function rmail-msg-is-pruned "rmail" ()) |
222 | (declare-function rmail-maybe-set-message-counters "rmail" ()) | |
223 | (declare-function rmail-msgbeg "rmail" (n)) | |
224 | (declare-function rmail-msgend "rmail" (n)) | |
225 | (declare-function rmail-toggle-header "rmail" (&optional arg)) | |
226 | ||
2b54af74 | 227 | |
bf078b46 RS |
228 | (defun uce-reply-to-uce (&optional ignored) |
229 | "Send reply to UCE in Rmail. | |
230 | UCE stands for unsolicited commercial email. Function will set up reply | |
231 | buffer with default To: to the sender, his postmaster, his abuse@ | |
232 | address, and postmaster of the mail relay used." | |
dc99d85e RS |
233 | (interactive) |
234 | (let ((message-buffer | |
db214408 | 235 | (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer) |
dc99d85e | 236 | ((eq uce-mail-reader 'rmail) "RMAIL") |
a1506d29 | 237 | (t (error |
f04f5c76 EZ |
238 | "Variable uce-mail-reader set to unrecognized value")))) |
239 | (full-header-p (and (eq uce-mail-reader 'rmail) | |
240 | (not (rmail-msg-is-pruned))))) | |
dc99d85e | 241 | (or (get-buffer message-buffer) |
a867ead0 | 242 | (error "No buffer %s, cannot find UCE" message-buffer)) |
dc99d85e | 243 | (switch-to-buffer message-buffer) |
f04f5c76 EZ |
244 | ;; We need the message with headers pruned. |
245 | (if full-header-p | |
246 | (rmail-toggle-header 1)) | |
dc99d85e RS |
247 | (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t))) |
248 | (reply-to (mail-fetch-field "reply-to")) | |
249 | temp) | |
250 | ;; Initial setting of the list of recipients of our message; that's | |
251 | ;; what they are pretending to be. | |
bf078b46 | 252 | (if to |
dc99d85e RS |
253 | (setq to (format "%s" (mail-strip-quoted-names to))) |
254 | (setq to "")) | |
255 | (if reply-to | |
256 | (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to)))) | |
257 | (let (first-at-sign end-of-hostname sender-host) | |
258 | (setq first-at-sign (string-match "@" to) | |
259 | end-of-hostname (string-match "[ ,>]" to first-at-sign) | |
260 | sender-host (substring to first-at-sign end-of-hostname)) | |
261 | (if (string-match "\\." sender-host) | |
a1506d29 | 262 | (setq to (format "%s, postmaster%s, abuse%s" |
dc99d85e RS |
263 | to sender-host sender-host)))) |
264 | (setq mail-send-actions nil) | |
265 | (setq mail-reply-buffer nil) | |
266 | (cond ((eq uce-mail-reader 'gnus) | |
db214408 | 267 | (copy-region-as-kill (point-min) (point-max))) |
dc99d85e RS |
268 | ((eq uce-mail-reader 'rmail) |
269 | (save-excursion | |
270 | (save-restriction | |
8a7377b5 | 271 | (rmail-toggle-header 1) |
dc99d85e RS |
272 | (widen) |
273 | (rmail-maybe-set-message-counters) | |
a1506d29 | 274 | (copy-region-as-kill (rmail-msgbeg rmail-current-message) |
dc99d85e | 275 | (rmail-msgend rmail-current-message)))))) |
f04f5c76 EZ |
276 | ;; Restore the pruned header state we found. |
277 | (if full-header-p | |
278 | (rmail-toggle-header 0)) | |
dc99d85e RS |
279 | (switch-to-buffer "*mail*") |
280 | (erase-buffer) | |
281 | (setq temp (point)) | |
282 | (yank) | |
283 | (goto-char temp) | |
284 | (if (eq uce-mail-reader 'rmail) | |
285 | (progn | |
286 | (forward-line 2) | |
0a6f5134 RS |
287 | (let ((case-fold-search t)) |
288 | (while (looking-at "Summary-Line:\\|Mail-From:") | |
289 | (forward-line 1))) | |
dc99d85e RS |
290 | (delete-region temp (point)))) |
291 | ;; Now find the mail hub that first accepted this message. | |
292 | ;; This should try to find the last Received: header. | |
293 | ;; Sometimes there may be other headers inbetween Received: headers. | |
294 | (cond ((eq uce-mail-reader 'gnus) | |
295 | ;; Does Gnus always have Lines: in the end? | |
296 | (re-search-forward "^Lines:") | |
297 | (beginning-of-line)) | |
298 | ((eq uce-mail-reader 'rmail) | |
38926103 | 299 | (goto-char (point-min)) |
dc99d85e RS |
300 | (search-forward "*** EOOH ***\n") |
301 | (beginning-of-line) | |
a1506d29 | 302 | (forward-line -1))) |
dc99d85e RS |
303 | (re-search-backward "^Received:") |
304 | (beginning-of-line) | |
305 | ;; Is this always good? It's the only thing I saw when I checked | |
306 | ;; a few messages. | |
307 | (let ((eol (save-excursion (end-of-line) (point)))) | |
308 | ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t)) | |
309 | (if (not (re-search-forward "\\(from\\|by\\) " eol t)) | |
310 | (progn | |
311 | (goto-char eol) | |
312 | (if (looking-at "[ \t\n]+\\(from\\|by\\) ") | |
313 | (goto-char (match-end 0)) | |
314 | (error "Failed to extract hub address"))))) | |
315 | (setq temp (point)) | |
316 | (search-forward " ") | |
317 | (forward-char -1) | |
318 | ;; And add its postmaster to the list of addresses. | |
319 | (if (string-match "\\." (buffer-substring temp (point))) | |
a1506d29 | 320 | (setq to (format "%s, postmaster@%s" |
dc99d85e RS |
321 | to (buffer-substring temp (point))))) |
322 | ;; Also look at the message-id, it helps *very* often. | |
323 | (if (and (search-forward "\nMessage-Id: " nil t) | |
324 | ;; Not all Message-Id:'s have an `@' sign. | |
325 | (let ((bol (point)) | |
326 | eol) | |
327 | (end-of-line) | |
328 | (setq eol (point)) | |
329 | (goto-char bol) | |
330 | (search-forward "@" eol t))) | |
331 | (progn | |
332 | (setq temp (point)) | |
333 | (search-forward ">") | |
334 | (forward-char -1) | |
335 | (if (string-match "\\." (buffer-substring temp (point))) | |
a1506d29 | 336 | (setq to (format "%s, postmaster@%s" |
dc99d85e RS |
337 | to (buffer-substring temp (point))))))) |
338 | (cond ((eq uce-mail-reader 'gnus) | |
339 | ;; Does Gnus always have Lines: in the end? | |
340 | (re-search-forward "^Lines:") | |
341 | (beginning-of-line)) | |
342 | ((eq uce-mail-reader 'rmail) | |
343 | (search-forward "\n*** EOOH ***\n") | |
344 | (forward-line -1))) | |
345 | (setq temp (point)) | |
346 | (search-forward "\n\n" nil t) | |
347 | (if (eq uce-mail-reader 'gnus) | |
348 | (forward-line -1)) | |
349 | (delete-region temp (point)) | |
350 | ;; End of Rmail dependent section. | |
351 | (auto-save-mode auto-save-default) | |
352 | (mail-mode) | |
353 | (goto-char (point-min)) | |
354 | (insert "To: ") | |
355 | (save-excursion | |
356 | (if to | |
357 | (let ((fill-prefix "\t") | |
358 | (address-start (point))) | |
359 | (insert to "\n") | |
360 | (fill-region-as-paragraph address-start (point))) | |
361 | (newline)) | |
362 | (insert "Subject: " uce-subject-line "\n") | |
363 | (if uce-default-headers | |
364 | (insert uce-default-headers)) | |
365 | (if mail-default-headers | |
366 | (insert mail-default-headers)) | |
367 | (if mail-default-reply-to | |
368 | (insert "Reply-to: " mail-default-reply-to "\n")) | |
369 | (insert mail-header-separator "\n") | |
370 | ;; Insert all our text. Then go back to the place where we started. | |
371 | (if to (setq to (point))) | |
372 | ;; Text of ranting. | |
373 | (if uce-message-text | |
374 | (insert uce-message-text)) | |
375 | ;; Signature. | |
376 | (cond ((eq uce-signature t) | |
377 | (if (file-exists-p "~/.signature") | |
378 | (progn | |
379 | (insert "\n\n-- \n") | |
38926103 | 380 | (forward-char (cadr (insert-file-contents "~/.signature")))))) |
dc99d85e RS |
381 | (uce-signature |
382 | (insert "\n\n-- \n" uce-signature))) | |
383 | ;; And text of the original message. | |
384 | (if uce-uce-separator | |
385 | (insert "\n\n" uce-uce-separator "\n")) | |
386 | ;; If message doesn't end with a newline, insert it. | |
387 | (goto-char (point-max)) | |
388 | (or (bolp) (newline))) | |
389 | ;; And go back to the beginning of text. | |
390 | (if to (goto-char to)) | |
391 | (or to (set-buffer-modified-p nil)) | |
392 | ;; Run hooks before we leave buffer for editing. Reasonable usage | |
393 | ;; might be to set up special key bindings, replace standart | |
394 | ;; functions in mail-mode, etc. | |
395 | (run-hooks 'mail-setup-hook 'uce-setup-hook)))) | |
a1506d29 | 396 | |
bf078b46 RS |
397 | (defun uce-insert-ranting (&optional ignored) |
398 | "Insert text of the usual reply to UCE into current buffer." | |
399 | (interactive "P") | |
400 | (insert uce-message-text)) | |
401 | ||
402 | (provide 'uce) | |
403 | ||
cbee283d | 404 | ;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221 |
bf078b46 | 405 | ;;; uce.el ends here |