Commit | Line | Data |
---|---|---|
bf078b46 RS |
1 | ;;; uce.el --- facilitate reply to unsolicited commercial email |
2 | ||
3 | ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: stanislav shalunov <shalunov@math.wisc.edu> | |
6 | ;; Created: 10 Dec 1996 | |
7 | ;; Version: 1.0 | |
8 | ;; Keywords: uce, unsolicited commercial email | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; This program is free software; you can redistribute it and/or | |
13 | ;; modify it under the terms of the GNU General Public License as | |
14 | ;; published by the Free Software Foundation; either version 2, or (at | |
15 | ;; your option) any later version. | |
16 | ||
17 | ;; This program is distributed in the hope that it will be useful, but | |
18 | ;; without any warranty; without even the implied warranty of | |
19 | ;; merchantability or fitness for a particular purpose. See the GNU | |
20 | ;; General Public License for more details. | |
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 | |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
26 | ||
27 | ;;; Commentary: | |
28 | ||
29 | ;; Code in this file provides semi-automatic means of replying to | |
30 | ;; UCE's you might get. It works currently only with Rmail. If you | |
31 | ;; would like to make it work with other mail readers, Rmail-specific | |
32 | ;; section is marked below. If you want to play with code, would you | |
33 | ;; please grab the newest version from | |
34 | ;; http://math.wisc.edu/~shalunov/uce.el and let me know, if you would | |
35 | ;; like, about your changes so I can incorporate them. I'd appreciate | |
36 | ;; it. | |
37 | ||
38 | ;; Function uce-reply-to-uce, if called when current message in RMAIL | |
39 | ;; buffer is a UCE, will setup *mail* buffer in the following way: it | |
40 | ;; scans full headers of message for 1) normal return address of | |
41 | ;; sender (From, Reply-To lines); and puts these addresses into To: | |
42 | ;; header, it also puts abuse@offenders.host address there 2) mailhub | |
43 | ;; that first saw this message; and puts address of its postmaster | |
44 | ;; into To: header 3) finally, it looks at Message-Id and adds | |
45 | ;; posmaster of that host to the list of addresses. | |
46 | ||
47 | ;; Then, we add "Errors-To: nobody@localhost" header, so that if some | |
48 | ;; of these addresses are not actually correct, we will never see | |
49 | ;; bounced mail. Also, mail-self-blind and mail-archive-file-name | |
50 | ;; take no effect: the ideology is that we don't want to save junk or | |
51 | ;; replies to junk. | |
52 | ||
53 | ;; Then we put template into buffer (customizable message that | |
54 | ;; explains what has happened), customizable signature, and the | |
55 | ;; original message with full headers and envelope for postmasters. | |
56 | ;; Then buffer is left for editing. | |
57 | ||
58 | ;; The reason that function uce-reply-to-uce is Rmail dependant is | |
59 | ;; that we want full headers of the original message, nothing | |
60 | ;; stripped. If we use normal means of inserting of the original | |
61 | ;; message into *mail* buffer headers like Received: (not really | |
62 | ;; headers, but envelope lines) will be stripped while they bear | |
63 | ;; valuable for us and postmasters information. I do wish that there | |
64 | ;; would be some way to write this function in some portable way, but | |
65 | ;; I am not aware of any. | |
66 | ||
67 | ;;; Change log: | |
68 | ||
69 | ;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs | |
70 | ||
71 | ;; Dec 11, 1996 -- fixed some typos, and Francesco Potorti` | |
72 | ;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was | |
73 | ;; weird, suggested fix, and added let form. | |
74 | ||
75 | ;; Dec 17, 1996 -- made scanning for host names little bit more clever | |
76 | ;; (obviously bogus stuff like localhost is now ignored). | |
77 | ||
78 | ;;; Setup: | |
79 | ||
80 | ;; put in your ~./emacs the following line: | |
81 | ||
82 | ;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil) | |
83 | ||
84 | ;; store this file (uce.el) somewhere in load-path and byte-compile it. | |
85 | ||
86 | ;;; Variables: | |
87 | ||
88 | ;; uce-message-text is template that will be inserted into buffer. It | |
89 | ;; has reasonable default. If you want to write some scarier one, | |
90 | ;; please do so and send it to me. Please keep it polite. | |
91 | ||
92 | ;; uce-signature behaves just like mail-signature. If nil, nothing is | |
93 | ;; inserted, if t, file ~/.signature is used, if a string, its | |
94 | ;; contents are inserted into buffer. | |
95 | ||
96 | ;; uce-uce-separator is line that separates your message from the UCE | |
97 | ;; that you enclose. | |
98 | ||
99 | ;; uce-subject-line will be used as subject of outgoing message. If | |
100 | ;; nil, left blank. | |
101 | ||
102 | ;;; Code: | |
103 | ||
104 | (require 'sendmail) | |
105 | (require 'rmail) | |
106 | ||
107 | (defvar uce-setup-hook nil | |
108 | "Hook to run after UCE rant message is composed. | |
109 | This hook is run after mail-setup-hook, which is run as well.") | |
110 | ||
111 | (defvar uce-message-text | |
112 | "Recently, I have received an Unsolicited Commercial E-mail from you. | |
113 | I do not like UCE's and I would like to inform you that sending | |
114 | unsolicited messages to someone while he or she may have to pay for | |
115 | reading your message may be illegal. Anyway, it is highly annoying | |
116 | and not welcome by anyone. It is rude, after all. | |
117 | ||
118 | If you think that this is a good way to advertise your products or | |
119 | services you are mistaken. Spamming will only make people hate you, not | |
120 | buy from you. | |
121 | ||
122 | If you have any list of people you send unsolicited commercial emails to, | |
123 | REMOVE me from such list immediately. I suggest that you make this list | |
124 | just empty. | |
125 | ||
126 | Note to the postmaster(s): I append the text of UCE in question to | |
127 | this message, I would like to hear from you about action(s) taken. | |
128 | This message has been sent to postmasters at the host that is | |
129 | mentioned as original sender's host and to the postmaster whose host | |
130 | was used as mail relay for this message. If message was sent not by | |
131 | your user, could you please compare time when this message was sent | |
132 | (use time in Received: field of the envelope rather than Date: field) | |
133 | with your sendmail logs and see what host was using your sendmail at | |
134 | this moment of time. | |
135 | ||
136 | Thank you." | |
137 | ||
138 | "This is the text that uce-reply-to-uce command will put in reply buffer. | |
139 | Some of spamming programs in use will be set up to read all incoming | |
140 | to spam address email, and will remove people who put the word `remove' | |
141 | on beginning of some line from the spamming list. So, when you set it | |
142 | up, it might be a good idea to actually use this feature. | |
143 | ||
144 | Value nil means insert no text by default, lets you type it in.") | |
145 | ||
146 | (defvar uce-uce-separator | |
147 | "----- original unsolicited commercial email follows -----" | |
148 | "Line that will begin quoting of the UCE. | |
149 | Value nil means use no separator.") | |
150 | ||
151 | (defvar uce-signature mail-signature | |
152 | "Text to put as your signature after the note to UCE sender. | |
153 | Value nil means none, t means insert ~/.signature file (if it happens | |
154 | to exist), if this variable is a string this string will be inserted | |
155 | as your signature.") | |
156 | ||
157 | (defvar uce-default-headers | |
158 | "Errors-To: nobody@localhost\nPrecedence: bulk\n" | |
159 | "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce]. | |
160 | These are mostly meant for headers that prevent delivery errors reporting.") | |
161 | ||
162 | (defvar uce-subject-line | |
163 | "Spam alert: unsolicited commercial e-mail" | |
164 | "Subject of the message that will be sent in response to a UCE.") | |
165 | ||
166 | (defun uce-reply-to-uce (&optional ignored) | |
167 | "Send reply to UCE in Rmail. | |
168 | UCE stands for unsolicited commercial email. Function will set up reply | |
169 | buffer with default To: to the sender, his postmaster, his abuse@ | |
170 | address, and postmaster of the mail relay used." | |
171 | (interactive "P") | |
172 | (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t))) | |
173 | (reply-to (mail-fetch-field "reply-to")) | |
174 | temp) | |
175 | ;; Initial setting of the list of recipients of our message; that's | |
176 | ;; what they are pretending to be (and in many cases, really are). | |
177 | (if to | |
178 | (setq to (format "%s" (mail-strip-quoted-names to))) | |
179 | (setq to "")) | |
180 | (if reply-to | |
181 | (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to)))) | |
182 | (let (first-at-sign end-of-hostname sender-host) | |
183 | (setq first-at-sign (string-match "@" to) | |
184 | end-of-hostname (string-match "[ ,>]" to first-at-sign) | |
185 | sender-host (substring to first-at-sign end-of-hostname)) | |
186 | (if (string-match "\\." sender-host) | |
187 | (setq to (format "%s, postmaster%s, abuse%s" | |
188 | to sender-host sender-host)))) | |
189 | (setq mail-send-actions nil) | |
190 | (setq mail-reply-buffer nil) | |
191 | ;; Begin of Rmail dependant section. | |
192 | (or (get-buffer "RMAIL") | |
193 | (error "No buffer RMAIL, cannot find UCE")) | |
194 | (switch-to-buffer "RMAIL") | |
195 | (save-excursion | |
196 | (save-restriction | |
197 | (widen) | |
198 | (rmail-maybe-set-message-counters) | |
199 | (copy-region-as-kill (rmail-msgbeg rmail-current-message) | |
200 | (rmail-msgend rmail-current-message)))) | |
201 | (switch-to-buffer "*mail*") | |
202 | (erase-buffer) | |
203 | (setq temp (point)) | |
204 | (yank) | |
205 | (goto-char temp) | |
206 | (forward-line 2) | |
207 | (while (looking-at "Summary-Line:\\|Mail-From:") | |
208 | (forward-line 1)) | |
209 | (delete-region temp (point)) | |
210 | ;; Now find the mail hub that first accepted this message. | |
211 | (while (or (looking-at "Received:") | |
212 | (looking-at " ") | |
213 | (looking-at "\t")) | |
214 | (forward-line 1)) | |
215 | (while (or (looking-at " ") | |
216 | (looking-at "\t")) | |
217 | (forward-line -1)) | |
218 | ;; Is this always good? It's the only thing I saw when I checked | |
219 | ;; a few messages. | |
220 | (search-forward ": from ") | |
221 | (setq temp (point)) | |
222 | (search-forward " ") | |
223 | (forward-char -1) | |
224 | ;; And add its postmaster to the list of addresses. | |
225 | (if (string-match "\\." (buffer-substring temp (point))) | |
226 | (setq to (format "%s, postmaster@%s" | |
227 | to (buffer-substring temp (point))))) | |
228 | ;; Also look at the message-id, it helps *very* often. | |
229 | (search-forward "\nMessage-Id: ") | |
230 | (search-forward "@") | |
231 | (setq temp (point)) | |
232 | (search-forward ">") | |
233 | (forward-char -1) | |
234 | (if (string-match "\\." (buffer-substring temp (point))) | |
235 | (setq to (format "%s, postmaster@%s" | |
236 | to (buffer-substring temp (point))))) | |
237 | (search-forward "\n*** EOOH ***\n") | |
238 | (forward-line -1) | |
239 | (setq temp (point)) | |
240 | (search-forward "\n\n" nil t) | |
241 | (delete-region temp (point)) | |
242 | ;; End of Rmail dependent section. | |
243 | (auto-save-mode auto-save-default) | |
244 | (mail-mode) | |
245 | (goto-char (point-min)) | |
246 | (insert "To: ") | |
247 | (save-excursion | |
248 | (if to | |
249 | (let ((fill-prefix "\t") | |
250 | (address-start (point))) | |
251 | (insert to "\n") | |
252 | (fill-region-as-paragraph address-start (point))) | |
253 | (newline)) | |
254 | (insert "Subject: " uce-subject-line "\n") | |
255 | (if uce-default-headers | |
256 | (insert uce-default-headers)) | |
257 | (if mail-default-headers | |
258 | (insert mail-default-headers)) | |
259 | (if mail-default-reply-to | |
260 | (insert "Reply-to: " mail-default-reply-to "\n")) | |
261 | (insert mail-header-separator "\n") | |
262 | ;; Insert all our text. Then go back to the place where we started. | |
263 | (if to (setq to (point))) | |
264 | ;; Text of ranting. | |
265 | (if uce-message-text | |
266 | (insert uce-message-text)) | |
267 | ;; Signature. | |
268 | (cond ((eq uce-signature t) | |
269 | (if (file-exists-p "~/.signature") | |
270 | (progn | |
271 | (insert "\n\n-- \n") | |
272 | (insert-file "~/.signature") | |
273 | ;; Function insert-file leaves point where it was, | |
274 | ;; while we want to place signature in the ``middle'' | |
275 | ;; of the message. | |
276 | (exchange-point-and-mark)))) | |
277 | (uce-signature | |
278 | (insert "\n\n-- \n" uce-signature))) | |
279 | ;; And text of the original message. | |
280 | (if uce-uce-separator | |
281 | (insert "\n\n" uce-uce-separator "\n")) | |
282 | ;; If message doesn't end with a newline, insert it. | |
283 | (goto-char (point-max)) | |
284 | (or (bolp) (newline))) | |
285 | ;; And go back to the beginning of text. | |
286 | (if to (goto-char to)) | |
287 | (or to (set-buffer-modified-p nil)) | |
288 | ;; Run hooks before we leave buffer for editing. Reasonable usage | |
289 | ;; might be to set up special key bindings, replace standart | |
290 | ;; functions in mail-mode, etc. | |
291 | (run-hooks 'mail-setup-hook 'uce-setup-hook))) | |
292 | ||
293 | (defun uce-insert-ranting (&optional ignored) | |
294 | "Insert text of the usual reply to UCE into current buffer." | |
295 | (interactive "P") | |
296 | (insert uce-message-text)) | |
297 | ||
298 | (provide 'uce) | |
299 | ||
300 | ;;; uce.el ends here |