lisp/mail/uce.el

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