1 ;;; uce.el --- facilitate reply to unsolicited commercial email
3 ;; Copyright (C) 1996, 1998, 2000, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: stanislav shalunov <shalunov@mccme.ru>
7 ;; Created: 10 Dec 1996
8 ;; Keywords: uce, unsolicited commercial email
10 ;; This file is part of GNU Emacs.
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
14 ;; the Free Software Foundation; either version 2, or (at your option)
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.
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., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
29 ;; Code in this file provides semi-automatic means of replying to
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.
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.
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
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.
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.
67 ;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
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.
73 ;; Dec 17, 1996 -- made scanning for host names little bit more clever
74 ;; (obviously bogus stuff like localhost is now ignored).
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.
80 ;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk>
81 ;; handling Received headers following some line like `From:'.
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.
90 ;; Add the following line to your ~/.emacs:
92 ;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
94 ;; If you want to use it with Gnus also use
96 ;; (setq uce-mail-reader 'gnus)
98 ;; store this file (uce.el) somewhere in load-path and byte-compile it.
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.
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.
110 ;; uce-uce-separator is line that separates your message from the UCE
113 ;; uce-subject-line will be used as subject of outgoing message. If
119 ;; Those sections of code which are dependent upon
120 ;; RMAIL are only evaluated if we have received a message with RMAIL...
124 "Facilitate reply to unsolicited commercial email."
128 (defcustom uce-mail-reader 'rmail
129 "A symbol indicating which mail reader you are using.
130 Choose from: `gnus', `rmail'."
131 :type '(choice (const gnus) (const rmail))
135 (defcustom uce-setup-hook nil
136 "Hook to run after UCE rant message is composed.
137 This hook is run after `mail-setup-hook', which is run as well."
141 (defcustom uce-message-text
142 "Recently, I have received an Unsolicited Commercial E-mail from you.
143 I do not like UCE's and I would like to inform you that sending
144 unsolicited messages to someone while he or she may have to pay for
145 reading your message may be illegal. Anyway, it is highly annoying
146 and not welcome by anyone. It is rude, after all.
148 If you think that this is a good way to advertise your products or
149 services you are mistaken. Spamming will only make people hate you, not
152 If you have any list of people you send unsolicited commercial emails to,
153 REMOVE me from such list immediately. I suggest that you make this list
156 ----------------------------------------------------
158 If you are not an administrator of any site and still have received
159 this message then your email address is being abused by some spammer.
160 They fake your address in From: or Reply-To: header. In this case,
161 you might want to show this message to your system administrator, and
162 ask him/her to investigate this matter.
164 Note to the postmaster(s): I append the text of UCE in question to
165 this message; I would like to hear from you about action(s) taken.
166 This message has been sent to postmasters at the host that is
167 mentioned as original sender's host (I do realize that it may be
168 faked, but I think that if your domain name is being abused this way
169 you might want to learn about it, and take actions) and to the
170 postmaster whose host was used as mail relay for this message. If
171 message was sent not by your user, could you please compare time when
172 this message was sent (use time in Received: field of the envelope
173 rather than Date: field) with your sendmail logs and see what host was
174 using your sendmail at this moment of time.
178 "This is the text that `uce-reply-to-uce' command will put in reply buffer.
179 Some of spamming programs in use will be set up to read all incoming
180 to spam address email, and will remove people who put the word `remove'
181 on beginning of some line from the spamming list. So, when you set it
182 up, it might be a good idea to actually use this feature.
184 Value nil means insert no text by default, lets you type it in."
188 (defcustom uce-uce-separator
189 "----- original unsolicited commercial email follows -----"
190 "Line that will begin quoting of the UCE.
191 Value nil means use no separator."
192 :type '(choice (const nil) string)
195 (defcustom uce-signature mail-signature
196 "Text to put as your signature after the note to UCE sender.
197 Value nil means none, t means insert `~/.signature' file (if it happens
198 to exist), if this variable is a string this string will be inserted
200 :type '(choice (const nil) (const t) string)
203 (defcustom uce-default-headers
204 "Errors-To: nobody@localhost\nPrecedence: bulk\n"
205 "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
206 These are mostly meant for headers that prevent delivery errors reporting."
210 (defcustom uce-subject-line
211 "Spam alert: unsolicited commercial e-mail"
212 "Subject of the message that will be sent in response to a UCE."
216 (defun uce-reply-to-uce (&optional ignored)
217 "Send reply to UCE in Rmail.
218 UCE stands for unsolicited commercial email. Function will set up reply
219 buffer with default To: to the sender, his postmaster, his abuse@
220 address, and postmaster of the mail relay used."
222 (let ((message-buffer
223 (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
224 ((eq uce-mail-reader 'rmail) "RMAIL")
226 "Variable uce-mail-reader set to unrecognized value"))))
227 (full-header-p (and (eq uce-mail-reader 'rmail)
228 (not (rmail-msg-is-pruned)))))
229 (or (get-buffer message-buffer)
230 (error (concat "No buffer " message-buffer ", cannot find UCE")))
231 (switch-to-buffer message-buffer)
232 ;; We need the message with headers pruned.
234 (rmail-toggle-header 1))
235 (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
236 (reply-to (mail-fetch-field "reply-to"))
238 ;; Initial setting of the list of recipients of our message; that's
239 ;; what they are pretending to be.
241 (setq to (format "%s" (mail-strip-quoted-names to)))
244 (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
245 (let (first-at-sign end-of-hostname sender-host)
246 (setq first-at-sign (string-match "@" to)
247 end-of-hostname (string-match "[ ,>]" to first-at-sign)
248 sender-host (substring to first-at-sign end-of-hostname))
249 (if (string-match "\\." sender-host)
250 (setq to (format "%s, postmaster%s, abuse%s"
251 to sender-host sender-host))))
252 (setq mail-send-actions nil)
253 (setq mail-reply-buffer nil)
254 (cond ((eq uce-mail-reader 'gnus)
255 (copy-region-as-kill (point-min) (point-max)))
256 ((eq uce-mail-reader 'rmail)
259 (rmail-toggle-header 1)
261 (rmail-maybe-set-message-counters)
262 (copy-region-as-kill (rmail-msgbeg rmail-current-message)
263 (rmail-msgend rmail-current-message))))))
264 ;; Restore the pruned header state we found.
266 (rmail-toggle-header 0))
267 (switch-to-buffer "*mail*")
272 (if (eq uce-mail-reader 'rmail)
275 (let ((case-fold-search t))
276 (while (looking-at "Summary-Line:\\|Mail-From:")
278 (delete-region temp (point))))
279 ;; Now find the mail hub that first accepted this message.
280 ;; This should try to find the last Received: header.
281 ;; Sometimes there may be other headers inbetween Received: headers.
282 (cond ((eq uce-mail-reader 'gnus)
283 ;; Does Gnus always have Lines: in the end?
284 (re-search-forward "^Lines:")
286 ((eq uce-mail-reader 'rmail)
287 (goto-char (point-min))
288 (search-forward "*** EOOH ***\n")
291 (re-search-backward "^Received:")
293 ;; Is this always good? It's the only thing I saw when I checked
295 (let ((eol (save-excursion (end-of-line) (point))))
296 ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
297 (if (not (re-search-forward "\\(from\\|by\\) " eol t))
300 (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
301 (goto-char (match-end 0))
302 (error "Failed to extract hub address")))))
306 ;; And add its postmaster to the list of addresses.
307 (if (string-match "\\." (buffer-substring temp (point)))
308 (setq to (format "%s, postmaster@%s"
309 to (buffer-substring temp (point)))))
310 ;; Also look at the message-id, it helps *very* often.
311 (if (and (search-forward "\nMessage-Id: " nil t)
312 ;; Not all Message-Id:'s have an `@' sign.
318 (search-forward "@" eol t)))
323 (if (string-match "\\." (buffer-substring temp (point)))
324 (setq to (format "%s, postmaster@%s"
325 to (buffer-substring temp (point)))))))
326 (cond ((eq uce-mail-reader 'gnus)
327 ;; Does Gnus always have Lines: in the end?
328 (re-search-forward "^Lines:")
330 ((eq uce-mail-reader 'rmail)
331 (search-forward "\n*** EOOH ***\n")
334 (search-forward "\n\n" nil t)
335 (if (eq uce-mail-reader 'gnus)
337 (delete-region temp (point))
338 ;; End of Rmail dependent section.
339 (auto-save-mode auto-save-default)
341 (goto-char (point-min))
345 (let ((fill-prefix "\t")
346 (address-start (point)))
348 (fill-region-as-paragraph address-start (point)))
350 (insert "Subject: " uce-subject-line "\n")
351 (if uce-default-headers
352 (insert uce-default-headers))
353 (if mail-default-headers
354 (insert mail-default-headers))
355 (if mail-default-reply-to
356 (insert "Reply-to: " mail-default-reply-to "\n"))
357 (insert mail-header-separator "\n")
358 ;; Insert all our text. Then go back to the place where we started.
359 (if to (setq to (point)))
362 (insert uce-message-text))
364 (cond ((eq uce-signature t)
365 (if (file-exists-p "~/.signature")
368 (forward-char (cadr (insert-file-contents "~/.signature"))))))
370 (insert "\n\n-- \n" uce-signature)))
371 ;; And text of the original message.
372 (if uce-uce-separator
373 (insert "\n\n" uce-uce-separator "\n"))
374 ;; If message doesn't end with a newline, insert it.
375 (goto-char (point-max))
376 (or (bolp) (newline)))
377 ;; And go back to the beginning of text.
378 (if to (goto-char to))
379 (or to (set-buffer-modified-p nil))
380 ;; Run hooks before we leave buffer for editing. Reasonable usage
381 ;; might be to set up special key bindings, replace standart
382 ;; functions in mail-mode, etc.
383 (run-hooks 'mail-setup-hook 'uce-setup-hook))))
385 (defun uce-insert-ranting (&optional ignored)
386 "Insert text of the usual reply to UCE into current buffer."
388 (insert uce-message-text))
392 ;;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221