1;;; uce.el --- facilitate reply to unsolicited commercial email 2 3;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: stanislav shalunov <shalunov@mccme.ru> 7;; Created: 10 Dec 1996 8;; Keywords: uce, unsolicited commercial email 9 10;; This file is part of GNU Emacs. 11 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) 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. 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., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, 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 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. 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 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 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. 87 88;; Setup: 89 90;; Add the following line to your ~/.emacs: 91 92;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil) 93 94;; If you want to use it with Gnus also use 95 96;; (setq uce-mail-reader 'gnus) 97 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 118(defvar gnus-original-article-buffer) 119(defvar mail-reply-buffer) 120(defvar rmail-current-message) 121 122(require 'sendmail) 123;; Those sections of code which are dependent upon 124;; RMAIL are only evaluated if we have received a message with RMAIL... 125;;(require 'rmail) 126 127(defgroup uce nil 128 "Facilitate reply to unsolicited commercial email." 129 :prefix "uce-" 130 :group 'mail) 131 132(defcustom uce-mail-reader 'rmail 133 "A symbol indicating which mail reader you are using. 134Choose from: `gnus', `rmail'." 135 :type '(choice (const gnus) (const rmail)) 136 :version "20.3" 137 :group 'uce) 138 139(defcustom uce-setup-hook nil 140 "Hook to run after UCE rant message is composed. 141This hook is run after `mail-setup-hook', which is run as well." 142 :type 'hook 143 :group 'uce) 144 145(defcustom uce-message-text 146 "Recently, I have received an Unsolicited Commercial E-mail from you. 147I do not like UCE's and I would like to inform you that sending 148unsolicited messages to someone while he or she may have to pay for 149reading your message may be illegal. Anyway, it is highly annoying 150and not welcome by anyone. It is rude, after all. 151 152If you think that this is a good way to advertise your products or 153services you are mistaken. Spamming will only make people hate you, not 154buy from you. 155 156If you have any list of people you send unsolicited commercial emails to, 157REMOVE me from such list immediately. I suggest that you make this list 158just empty. 159 160 ---------------------------------------------------- 161 162If you are not an administrator of any site and still have received 163this message then your email address is being abused by some spammer. 164They fake your address in From: or Reply-To: header. In this case, 165you might want to show this message to your system administrator, and 166ask him/her to investigate this matter. 167 168Note to the postmaster(s): I append the text of UCE in question to 169this message; I would like to hear from you about action(s) taken. 170This message has been sent to postmasters at the host that is 171mentioned as original sender's host (I do realize that it may be 172faked, but I think that if your domain name is being abused this way 173you might want to learn about it, and take actions) and to the 174postmaster whose host was used as mail relay for this message. If 175message was sent not by your user, could you please compare time when 176this message was sent (use time in Received: field of the envelope 177rather than Date: field) with your sendmail logs and see what host was 178using your sendmail at this moment of time. 179 180Thank you." 181 182 "This is the text that `uce-reply-to-uce' command will put in reply buffer. 183Some of spamming programs in use will be set up to read all incoming 184to spam address email, and will remove people who put the word `remove' 185on beginning of some line from the spamming list. So, when you set it 186up, it might be a good idea to actually use this feature. 187 188Value nil means insert no text by default, lets you type it in." 189 :type 'string 190 :group 'uce) 191 192(defcustom uce-uce-separator 193 "----- original unsolicited commercial email follows -----" 194 "Line that will begin quoting of the UCE. 195Value nil means use no separator." 196 :type '(choice (const nil) string) 197 :group 'uce) 198 199(defcustom uce-signature mail-signature 200"Text to put as your signature after the note to UCE sender. 201Value nil means none, t means insert `~/.signature' file (if it happens 202to exist), if this variable is a string this string will be inserted 203as your signature." 204 :type '(choice (const nil) (const t) string) 205 :group 'uce) 206 207(defcustom uce-default-headers 208 "Errors-To: nobody@localhost\nPrecedence: bulk\n" 209 "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce]. 210These are mostly meant for headers that prevent delivery errors reporting." 211 :type 'string 212 :group 'uce) 213 214(defcustom uce-subject-line 215 "Spam alert: unsolicited commercial e-mail" 216 "Subject of the message that will be sent in response to a UCE." 217 :type 'string 218 :group 'uce) 219 220(defun uce-reply-to-uce (&optional ignored) 221 "Send reply to UCE in Rmail. 222UCE stands for unsolicited commercial email. Function will set up reply 223buffer with default To: to the sender, his postmaster, his abuse@ 224address, and postmaster of the mail relay used." 225 (interactive) 226 (let ((message-buffer 227 (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer) 228 ((eq uce-mail-reader 'rmail) "RMAIL") 229 (t (error 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))))) 233 (or (get-buffer message-buffer) 234 (error (concat "No buffer " message-buffer ", cannot find UCE"))) 235 (switch-to-buffer message-buffer) 236 ;; We need the message with headers pruned. 237 (if full-header-p 238 (rmail-toggle-header 1)) 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. 244 (if to 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) 254 (setq to (format "%s, postmaster%s, abuse%s" 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) 259 (copy-region-as-kill (point-min) (point-max))) 260 ((eq uce-mail-reader 'rmail) 261 (save-excursion 262 (save-restriction 263 (rmail-toggle-header 1) 264 (widen) 265 (rmail-maybe-set-message-counters) 266 (copy-region-as-kill (rmail-msgbeg rmail-current-message) 267 (rmail-msgend rmail-current-message)))))) 268 ;; Restore the pruned header state we found. 269 (if full-header-p 270 (rmail-toggle-header 0)) 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) 279 (let ((case-fold-search t)) 280 (while (looking-at "Summary-Line:\\|Mail-From:") 281 (forward-line 1))) 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) 291 (goto-char (point-min)) 292 (search-forward "*** EOOH ***\n") 293 (beginning-of-line) 294 (forward-line -1))) 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))) 312 (setq to (format "%s, postmaster@%s" 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))) 328 (setq to (format "%s, postmaster@%s" 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") 372 (forward-char (cadr (insert-file-contents "~/.signature")))))) 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)))) 388 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 396;;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221 397;;; uce.el ends here 398