(require 'sendmail)
(defgroup uce nil
"Facilitate reply to unsolicited commercial email."
:prefix "uce-"
:group 'mail)
(defcustom uce-mail-reader 'rmail
"A symbol indicating which mail reader you are using.
Choose from: `gnus', `rmail'."
:type '(choice (const gnus) (const rmail))
:version "20.3"
:group 'uce)
(defcustom uce-setup-hook nil
"Hook to run after UCE rant message is composed.
This hook is run after `mail-setup-hook', which is run as well."
:type 'hook
:group 'uce)
(defcustom uce-message-text
"Recently, I have received an Unsolicited Commercial E-mail from you.
I do not like UCE's and I would like to inform you that sending
unsolicited messages to someone while he or she may have to pay for
reading your message may be illegal. Anyway, it is highly annoying
and not welcome by anyone. It is rude, after all.
If you think that this is a good way to advertise your products or
services you are mistaken. Spamming will only make people hate you, not
buy from you.
If you have any list of people you send unsolicited commercial emails to,
REMOVE me from such list immediately. I suggest that you make this list
just empty.
----------------------------------------------------
If you are not an administrator of any site and still have received
this message then your email address is being abused by some spammer.
They fake your address in From: or Reply-To: header. In this case,
you might want to show this message to your system administrator, and
ask him/her to investigate this matter.
Note to the postmaster(s): I append the text of UCE in question to
this message; I would like to hear from you about action(s) taken.
This message has been sent to postmasters at the host that is
mentioned as original sender's host (I do realize that it may be
faked, but I think that if your domain name is being abused this way
you might want to learn about it, and take actions) and to the
postmaster whose host was used as mail relay for this message. If
message was sent not by your user, could you please compare time when
this message was sent (use time in Received: field of the envelope
rather than Date: field) with your sendmail logs and see what host was
using your sendmail at this moment of time.
Thank you."
"This is the text that `uce-reply-to-uce' command will put in reply buffer.
Some of spamming programs in use will be set up to read all incoming
to spam address email, and will remove people who put the word `remove'
on beginning of some line from the spamming list. So, when you set it
up, it might be a good idea to actually use this feature.
Value nil means insert no text by default, lets you type it in."
:type 'string
:group 'uce)
(defcustom uce-uce-separator
"----- original unsolicited commercial email follows -----"
"Line that will begin quoting of the UCE.
Value nil means use no separator."
:type '(choice (const nil) string)
:group 'uce)
(defcustom uce-signature mail-signature
"Text to put as your signature after the note to UCE sender.
Value nil means none, t means insert `~/.signature' file (if it happens
to exist), if this variable is a string this string will be inserted
as your signature."
:type '(choice (const nil) (const t) string)
:group 'uce)
(defcustom uce-default-headers
"Errors-To: nobody@localhost\nPrecedence: bulk\n"
"Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
These are mostly meant for headers that prevent delivery errors reporting."
:type 'string
:group 'uce)
(defcustom uce-subject-line
"Spam alert: unsolicited commercial e-mail"
"Subject of the message that will be sent in response to a UCE."
:type 'string
:group 'uce)
(defun uce-reply-to-uce (&optional ignored)
"Send reply to UCE in Rmail.
UCE stands for unsolicited commercial email. Function will set up reply
buffer with default To: to the sender, his postmaster, his abuse@
address, and postmaster of the mail relay used."
(interactive)
(let ((message-buffer
(cond ((eq uce-mail-reader 'gnus) "*Article*")
((eq uce-mail-reader 'rmail) "RMAIL")
(t (error
"Variable uce-mail-reader set to unrecognized value")))))
(or (get-buffer message-buffer)
(error (concat "No buffer " message-buffer ", cannot find UCE")))
(switch-to-buffer message-buffer)
(let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
(reply-to (mail-fetch-field "reply-to"))
temp)
(if to
(setq to (format "%s" (mail-strip-quoted-names to)))
(setq to ""))
(if reply-to
(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
(let (first-at-sign end-of-hostname sender-host)
(setq first-at-sign (string-match "@" to)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
(if (string-match "\\." sender-host)
(setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
(setq mail-reply-buffer nil)
(cond ((eq uce-mail-reader 'gnus)
(article-hide-headers -1)
(copy-region-as-kill (point-min) (point-max))
(article-hide-headers))
((eq uce-mail-reader 'rmail)
(save-excursion
(save-restriction
(widen)
(rmail-maybe-set-message-counters)
(copy-region-as-kill (rmail-msgbeg rmail-current-message)
(rmail-msgend rmail-current-message))))))
(switch-to-buffer "*mail*")
(erase-buffer)
(setq temp (point))
(yank)
(goto-char temp)
(if (eq uce-mail-reader 'rmail)
(progn
(forward-line 2)
(let ((case-fold-search t))
(while (looking-at "Summary-Line:\\|Mail-From:")
(forward-line 1)))
(delete-region temp (point))))
(cond ((eq uce-mail-reader 'gnus)
(re-search-forward "^Lines:")
(beginning-of-line))
((eq uce-mail-reader 'rmail)
(beginning-of-buffer)
(search-forward "*** EOOH ***\n")
(beginning-of-line)
(forward-line -1)))
(re-search-backward "^Received:")
(beginning-of-line)
(let ((eol (save-excursion (end-of-line) (point))))
(if (not (re-search-forward "\\(from\\|by\\) " eol t))
(progn
(goto-char eol)
(if (looking-at "[ \t\n]+\\(from\\|by\\) ")
(goto-char (match-end 0))
(error "Failed to extract hub address")))))
(setq temp (point))
(search-forward " ")
(forward-char -1)
(if (string-match "\\." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
(if (and (search-forward "\nMessage-Id: " nil t)
(let ((bol (point))
eol)
(end-of-line)
(setq eol (point))
(goto-char bol)
(search-forward "@" eol t)))
(progn
(setq temp (point))
(search-forward ">")
(forward-char -1)
(if (string-match "\\." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(cond ((eq uce-mail-reader 'gnus)
(re-search-forward "^Lines:")
(beginning-of-line))
((eq uce-mail-reader 'rmail)
(search-forward "\n*** EOOH ***\n")
(forward-line -1)))
(setq temp (point))
(search-forward "\n\n" nil t)
(if (eq uce-mail-reader 'gnus)
(forward-line -1))
(delete-region temp (point))
(auto-save-mode auto-save-default)
(mail-mode)
(goto-char (point-min))
(insert "To: ")
(save-excursion
(if to
(let ((fill-prefix "\t")
(address-start (point)))
(insert to "\n")
(fill-region-as-paragraph address-start (point)))
(newline))
(insert "Subject: " uce-subject-line "\n")
(if uce-default-headers
(insert uce-default-headers))
(if mail-default-headers
(insert mail-default-headers))
(if mail-default-reply-to
(insert "Reply-to: " mail-default-reply-to "\n"))
(insert mail-header-separator "\n")
(if to (setq to (point)))
(if uce-message-text
(insert uce-message-text))
(cond ((eq uce-signature t)
(if (file-exists-p "~/.signature")
(progn
(insert "\n\n-- \n")
(insert-file "~/.signature")
(exchange-point-and-mark))))
(uce-signature
(insert "\n\n-- \n" uce-signature)))
(if uce-uce-separator
(insert "\n\n" uce-uce-separator "\n"))
(goto-char (point-max))
(or (bolp) (newline)))
(if to (goto-char to))
(or to (set-buffer-modified-p nil))
(run-hooks 'mail-setup-hook 'uce-setup-hook))))
(defun uce-insert-ranting (&optional ignored)
"Insert text of the usual reply to UCE into current buffer."
(interactive "P")
(insert uce-message-text))
(provide 'uce)