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