procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tidy up commentary.

Browse source 
(rmail-current-message): Remove unneeded declaration.
(uce-message-text, uce-default-headers): Fix custom type.
(rmail-buffer, rmail-msg-is-pruned): Declare.
(uce-reply-to-uce): Add autoload cookie.  Doc fix.  Update for mbox Rmail.
This commit is contained in:
Glenn Morris 2009-01-31 02:50:28 +00:00
parent b83b70b812
commit 9f08b1415d
1 changed files with 119 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

259
lisp/mail/uce.el
View file

@ -1,11 +1,11 @@
;;; uce.el --- facilitate reply to unsolicited commercial email
;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
;; Keywords: uce, unsolicited commercial email
;; Keywords: mail, uce, unsolicited commercial email
;; This file is part of GNU Emacs.
@ -24,43 +24,68 @@
;;; Commentary:
;; Code in this file provides semi-automatic means of replying to
;; UCE's you might get. It works currently only with Rmail and Gnus.
;; If you would like to make it work with other mail readers,
;; Rmail-specific section is marked below. If you want to play with
;; code, please let me know about your changes so I can incorporate
;; them. I'd appreciate it.
;; The code in this file provides a semi-automatic means of replying
;; to unsolicited commercial email (UCE) you might get. Currently, it
;; only works with Rmail and Gnus. If you would like to make it work
;; with other mail readers, see the mail-client dependent section of
;; uce-reply-to-uce. Please let me know about your changes so I can
;; incorporate them. I'd appreciate it.
;; Function uce-reply-to-uce, if called when current message in RMAIL
;; buffer is a UCE, will setup *mail* buffer in the following way: it
;; scans full headers of message for 1) normal return address of
;; sender (From, Reply-To lines); and puts these addresses into To:
;; header, it also puts abuse@offenders.host address there 2) mailhub
;; that first saw this message; and puts address of its postmaster
;; into To: header 3) finally, it looks at Message-Id and adds
;; posmaster of that host to the list of addresses.
;; The command uce-reply-to-uce, if called when the current message
;; buffer is a UCE, will setup a reply *mail* buffer as follows. It
;; scans the full headers of the message for: 1) the normal return
;; address of the sender (From, Reply-To lines), and puts these
;; addresses into the To: header, along with abuse@offenders.host; 2)
;; the mailhub that first saw this message, and adds the address of
;; its postmaster into the To: header; and 3), finally, it looks at
;; the Message-Id and adds the postmaster of that host to the list of
;; addresses.
;; Then, we add "Errors-To: nobody@localhost" header, so that if some
;; of these addresses are not actually correct, we will never see
;; Then, we add an "Errors-To: nobody@localhost" header, so that if
;; some of these addresses are not actually correct, we will never see
;; bounced mail. Also, mail-self-blind and mail-archive-file-name
;; take no effect: the ideology is that we don't want to save junk or
;; replies to junk.
;; Then we put template into buffer (customizable message that
;; explains what has happened), customizable signature, and the
;; Then we insert a template into the buffer (a customizable message
;; that explains what has happened), customizable signature, and the
;; original message with full headers and envelope for postmasters.
;; Then buffer is left for editing.
;; Then the buffer is left for editing.
;; The reason that function uce-reply-to-uce is Rmail dependant is
;; that we want full headers of the original message, nothing
;; stripped. If we use normal means of inserting of the original
;; message into *mail* buffer headers like Received: (not really
;; headers, but envelope lines) will be stripped while they bear
;; valuable for us and postmasters information. I do wish that there
;; would be some way to write this function in some portable way, but
;; I am not aware of any.
;; The reason that the function uce-reply-to-uce is mail-client
;; dependent is that we want the full headers of the original message,
;; nothing stripped. If we use the normal means of inserting the
;; original message into the *mail* buffer, headers like Received:
;; (not really headers, but envelope lines) will be stripped, while
;; they bear valuable information for us and postmasters. I do wish
;; that there would be some portable way to write this function, but I
;; am not aware of any.
;;; Change log:
;; Usage:
;; Place uce.el in your load-path (and optionally byte-compile it).
;; Add the following line to your ~/.emacs:
;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
;; If you want to use it with Gnus rather than Rmail:
;; (setq uce-mail-reader 'gnus)
;; Options:
;; uce-message-text is a template that will be inserted into buffer.
;; It has a reasonable default. If you want to write some scarier
;; one, please do so and send it to me. Please keep it polite.
;; uce-signature behaves just like mail-signature. If nil, nothing is
;; inserted, if t, file ~/.signature is used, if a string, its
;; contents are inserted into buffer.
;; uce-uce-separator is a line that separates your message from the
;; UCE that you enclose.
;; uce-subject-line will be used as the subject of the outgoing message.
;;; Change Log:
;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
@ -83,39 +108,11 @@
;; latest Gnus. Lars told him it should work for all versions of Gnus
;; younger than three years.
;; Setup:
;; Add the following line to your ~/.emacs:
;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
;; If you want to use it with Gnus also use
;; (setq uce-mail-reader 'gnus)
;; store this file (uce.el) somewhere in load-path and byte-compile it.
;;; Variables:
;; uce-message-text is template that will be inserted into buffer. It
;; has reasonable default. If you want to write some scarier one,
;; please do so and send it to me. Please keep it polite.
;; uce-signature behaves just like mail-signature. If nil, nothing is
;; inserted, if t, file ~/.signature is used, if a string, its
;; contents are inserted into buffer.
;; uce-uce-separator is line that separates your message from the UCE
;; that you enclose.
;; uce-subject-line will be used as subject of outgoing message. If
;; nil, left blank.
;;; Code:
(defvar gnus-original-article-buffer)
(defvar mail-reply-buffer)
(defvar rmail-current-message)
(require 'sendmail)
;; Those sections of code which are dependent upon
@ -184,7 +181,7 @@ 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
:type '(choice (const nil) string)
:group 'uce)
(defcustom uce-uce-separator
@ -206,7 +203,7 @@ as your signature."
"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
:type '(choice (const nil) string)
:group 'uce)
(defcustom uce-subject-line
@ -215,40 +212,47 @@ These are mostly meant for headers that prevent delivery errors reporting."
:type 'string
:group 'uce)
;; End of user options.
(defvar rmail-buffer)
(declare-function rmail-msg-is-pruned "rmail" ())
(declare-function mail-strip-quoted-names "mail-utils" (address))
(declare-function rmail-maybe-set-message-counters "rmail" ())
(declare-function rmail-msgbeg "rmail" (n))
(declare-function rmail-msgend "rmail" (n))
(declare-function rmail-toggle-header "rmail" (&optional arg))
;;;###autoload
(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."
"Compose a reply to unsolicited commercial email (UCE).
Sets up a reply buffer addressed to: the sender, his postmaster,
his abuse@ address, and the postmaster of the mail relay used.
You might need to set `uce-mail-reader' before using this."
(interactive)
;; Start of mail-client dependent section.
(let ((message-buffer
(cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
((eq uce-mail-reader 'rmail) "RMAIL")
((eq uce-mail-reader 'rmail) (bound-and-true-p rmail-buffer))
(t (error
"Variable uce-mail-reader set to unrecognized value"))))
(full-header-p (and (eq uce-mail-reader 'rmail)
(not (rmail-msg-is-pruned)))))
(or (get-buffer message-buffer)
(error "No buffer %s, cannot find UCE" message-buffer))
pruned)
(or (and message-buffer (get-buffer message-buffer))
(error "No mail buffer, cannot find UCE"))
(switch-to-buffer message-buffer)
;; We need the message with headers pruned.
(if full-header-p
(rmail-toggle-header 1))
;; Why? All we do is get the from and reply-to headers. ?
(and (eq uce-mail-reader 'rmail)
(not (setq pruned (rmail-msg-is-pruned)))
(rmail-toggle-header 1))
(let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
(reply-to (mail-fetch-field "reply-to"))
temp)
;; Initial setting of the list of recipients of our message; that's
;; what they are pretending to be.
(if to
(setq to (format "%s" (mail-strip-quoted-names to)))
(setq to ""))
(setq to (if to
(format "%s" (mail-strip-quoted-names 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)
@ -260,31 +264,22 @@ address, and postmaster of the mail relay used."
to sender-host sender-host))))
(setq mail-send-actions nil)
(setq mail-reply-buffer nil)
(cond ((eq uce-mail-reader 'gnus)
(copy-region-as-kill (point-min) (point-max)))
((eq uce-mail-reader 'rmail)
(save-excursion
(save-restriction
(rmail-toggle-header 1)
(widen)
(rmail-maybe-set-message-counters)
(copy-region-as-kill (rmail-msgbeg rmail-current-message)
(rmail-msgend rmail-current-message))))))
;; Restore the pruned header state we found.
(if full-header-p
(rmail-toggle-header 0))
(when (eq uce-mail-reader 'rmail)
(rmail-toggle-header 0)
(rmail-maybe-set-message-counters)) ; why?
(copy-region-as-kill (point-min) (point-max))
;; Restore the initial header state we found.
(and pruned (rmail-toggle-header 1))
(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))))
(goto-char (point-min))
;; Delete any internal Rmail headers.
(when (eq uce-mail-reader 'rmail)
(search-forward "\n\n")
(while (re-search-backward "^X-RMAIL" nil t)
(delete-region (point) (line-beginning-position 2)))
(goto-char (point-min)))
;; Now find the mail hub that first accepted this message.
;; This should try to find the last Received: header.
;; Sometimes there may be other headers inbetween Received: headers.
@ -293,22 +288,15 @@ address, and postmaster of the mail relay used."
(re-search-forward "^Lines:")
(beginning-of-line))
((eq uce-mail-reader 'rmail)
(goto-char (point-min))
(search-forward "*** EOOH ***\n")
(beginning-of-line)
(forward-line -1)))
(search-forward "\n\n")))
(re-search-backward "^Received:")
(beginning-of-line)
;; Is this always good? It's the only thing I saw when I checked
;; a few messages.
(let ((eol (save-excursion (end-of-line) (point))))
;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
(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")))))
;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
(unless (re-search-forward "\\(from\\|by\\) " (line-end-position) 'move)
(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)
@ -317,34 +305,25 @@ address, and postmaster of the mail relay used."
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
(if (and (search-forward "\nMessage-Id: " nil t)
;; Not all Message-Id:'s have an `@' sign.
(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)
;; Does Gnus always have Lines: in the end?
(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))
;; End of Rmail dependent section.
(and (search-forward "\nMessage-Id: " nil t)
;; Not all Message-Id:'s have an `@' sign.
(search-forward "@" (line-end-position) 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)))))))
(when (eq uce-mail-reader 'gnus)
;; Does Gnus always have Lines: in the end?
(re-search-forward "^Lines:")
(beginning-of-line)
(setq temp (point))
(search-forward "\n\n" nil t)
(forward-line -1)
(delete-region temp (point)))
;; End of mail-client dependent section.
(auto-save-mode auto-save-default)
(mail-mode)
(goto-char (point-min))
@ -387,7 +366,7 @@ address, and postmaster of the mail relay used."
(if to (goto-char to))
(or to (set-buffer-modified-p nil))
;; Run hooks before we leave buffer for editing. Reasonable usage
;; might be to set up special key bindings, replace standart
;; might be to set up special key bindings, replace standard
;; functions in mail-mode, etc.
(run-hooks 'mail-setup-hook 'uce-setup-hook))))