Mercurial > emacs
comparison lisp/gnus/spam-report.el @ 85712:a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 28 Oct 2007 09:18:39 +0000 |
parents | 24202b793a08 |
children | 107ccd98fa12 |
comparison
equal
deleted
inserted
replaced
85711:b6f5dc84b2e1 | 85712:a3c27999decb |
---|---|
1 ;;; spam-report.el --- Reporting spam | 1 ;;; spam-report.el --- Reporting spam |
2 | 2 |
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. | 3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Teodor Zlatanov <tzz@lifelogs.com> | 5 ;; Author: Ted Zlatanov <tzz@lifelogs.com> |
6 ;; Keywords: network | 6 ;; Keywords: network, spam, mail, gmane, report |
7 | 7 |
8 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
9 | 9 |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | 10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 ;; it under the terms of the GNU General Public License as published by | 11 ;; it under the terms of the GNU General Public License as published by |
78 ;; Should we use `spam-directory'? | 78 ;; Should we use `spam-directory'? |
79 "File where spam report request are stored." | 79 "File where spam report request are stored." |
80 :type 'file | 80 :type 'file |
81 :group 'spam-report) | 81 :group 'spam-report) |
82 | 82 |
83 (defcustom spam-report-resend-to nil | |
84 "Email address that spam articles are resent to when reporting. | |
85 If not set, the user will be prompted to enter a value which will be | |
86 saved for future use." | |
87 :type 'string | |
88 :group 'spam-report) | |
89 | |
83 (defvar spam-report-url-ping-temp-agent-function nil | 90 (defvar spam-report-url-ping-temp-agent-function nil |
84 "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. | 91 "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. |
85 This variable will store the value of `spam-report-url-ping-function' from | 92 This variable will store the value of `spam-report-url-ping-function' from |
86 before `spam-report-agentize' was run, so that `spam-report-deagentize' can | 93 before `spam-report-agentize' was run, so that `spam-report-deagentize' can |
87 undo that change.") | 94 undo that change.") |
88 | 95 |
89 (defun spam-report-gmane (&rest articles) | 96 (defun spam-report-resend (articles &optional ham) |
90 "Report an article as spam through Gmane" | 97 "Report an article as spam by resending via email. |
98 Reports is as ham when HAM is set." | |
91 (dolist (article articles) | 99 (dolist (article articles) |
92 (when (and gnus-newsgroup-name | 100 (gnus-message 6 |
93 (or (null spam-report-gmane-regex) | 101 "Reporting %s article %d to <%s>..." |
94 (string-match spam-report-gmane-regex gnus-newsgroup-name))) | 102 (if ham "ham" "spam") |
95 (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) | 103 article spam-report-resend-to) |
96 (if spam-report-gmane-use-article-number | 104 (unless spam-report-resend-to |
97 (spam-report-url-ping | 105 (customize-set-variable |
98 "spam.gmane.org" | 106 spam-report-resend-to |
99 (format "/%s:%d" | 107 (read-from-minibuffer "email address to resend SPAM/HAM to? "))) |
100 (gnus-group-real-name gnus-newsgroup-name) | 108 ;; This is ganked from the `gnus-summary-resend-message' function. |
101 article)) | 109 ;; It involves rendering the SPAM, which is undesirable, but there does |
110 ;; not seem to be a nicer way to achieve this. | |
111 ;; select this particular article | |
112 (gnus-summary-select-article nil nil nil article) | |
113 ;; resend it to the destination address | |
114 (save-excursion | |
115 (set-buffer gnus-original-article-buffer) | |
116 (message-resend spam-report-resend-to)))) | |
117 | |
118 (defun spam-report-resend-ham (articles) | |
119 "Report an article as ham by resending via email." | |
120 (spam-report-resend articles t)) | |
121 | |
122 (defun spam-report-gmane-ham (&rest articles) | |
123 "Report ARTICLES as ham (unregister) through Gmane." | |
124 (interactive (gnus-summary-work-articles current-prefix-arg)) | |
125 (dolist (article articles) | |
126 (spam-report-gmane-internal t article))) | |
127 | |
128 (defun spam-report-gmane-spam (&rest articles) | |
129 "Report ARTICLES as spam through Gmane." | |
130 (interactive (gnus-summary-work-articles current-prefix-arg)) | |
131 (dolist (article articles) | |
132 (spam-report-gmane-internal nil article))) | |
133 | |
134 ;; `spam-report-gmane' was an interactive entry point, so we should provide an | |
135 ;; alias. | |
136 (defalias 'spam-report-gmane 'spam-report-gmane-spam) | |
137 | |
138 (defun spam-report-gmane-internal (unspam article) | |
139 "Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM." | |
140 (when (and gnus-newsgroup-name | |
141 (or (null spam-report-gmane-regex) | |
142 (string-match spam-report-gmane-regex gnus-newsgroup-name))) | |
143 (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org"))) | |
144 (gnus-message 6 "Reporting article %d to %s..." article rpt-host) | |
145 (cond | |
146 ;; Special-case nnweb groups -- these have the URL to use in | |
147 ;; the Xref headers. | |
148 ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb) | |
149 (spam-report-url-ping | |
150 rpt-host | |
151 (concat | |
152 "/" | |
153 (gnus-replace-in-string | |
154 (gnus-replace-in-string | |
155 (gnus-replace-in-string | |
156 (mail-header-xref (gnus-summary-article-header article)) | |
157 "/raw" ":silent") | |
158 "^.*article.gmane.org/" "") | |
159 "/" ":")))) | |
160 (spam-report-gmane-use-article-number | |
161 (spam-report-url-ping | |
162 rpt-host | |
163 (format "/%s:%d" | |
164 (gnus-group-real-name gnus-newsgroup-name) | |
165 article))) | |
166 (t | |
102 (with-current-buffer nntp-server-buffer | 167 (with-current-buffer nntp-server-buffer |
168 (erase-buffer) | |
103 (gnus-request-head article gnus-newsgroup-name) | 169 (gnus-request-head article gnus-newsgroup-name) |
104 (let ((case-fold-search t) | 170 (let ((case-fold-search t) |
105 field host report url) | 171 field host report url) |
106 ;; First check for X-Report-Spam because it's more specific to | 172 ;; First check for X-Report-Spam because it's more specific to |
107 ;; spam reporting than Archived-At. OTOH, all new articles on | 173 ;; spam reporting than Archived-At. OTOH, all new articles on |
109 ;; mind :-)). | 175 ;; mind :-)). |
110 ;; | 176 ;; |
111 ;; There might be more than one Archived-At header so we need to | 177 ;; There might be more than one Archived-At header so we need to |
112 ;; find (and transform) the one related to Gmane. | 178 ;; find (and transform) the one related to Gmane. |
113 (setq field (or (gnus-fetch-field "X-Report-Spam") | 179 (setq field (or (gnus-fetch-field "X-Report-Spam") |
180 (gnus-fetch-field "X-Report-Unspam") | |
114 (gnus-fetch-field "Archived-At"))) | 181 (gnus-fetch-field "Archived-At"))) |
115 (setq host (progn | 182 (if (not (stringp field)) |
116 (string-match | 183 (if (and (setq field (gnus-fetch-field "Xref")) |
117 (concat "http://\\([a-z]+\\.gmane\\.org\\)" | 184 (string-match "[^ ]+ +\\([^ ]+\\)" field)) |
118 "\\(/[^:/]+[:/][0-9]+\\)") | 185 (setq report (concat "/" (match-string 1 field)) |
119 field) | 186 host rpt-host)) |
120 (match-string 1 field))) | 187 (setq host |
121 (setq report (match-string 2 field)) | 188 (progn |
122 (when (string-equal "permalink.gmane.org" host) | 189 (string-match |
123 (setq host "spam.gmane.org") | 190 (concat "http://\\([a-z]+\\.gmane\\.org\\)" |
124 (setq report (gnus-replace-in-string | 191 "\\(/[^:/]+[:/][0-9]+\\)") |
125 report "/\\([0-9]+\\)$" ":\\1"))) | 192 field) |
126 (setq url (format "http://%s%s" host report)) | 193 (match-string 1 field))) |
194 (setq report (match-string 2 field))) | |
195 (when host | |
196 (when (string-equal "permalink.gmane.org" host) | |
197 (setq host rpt-host) | |
198 (setq report (gnus-replace-in-string | |
199 report "/\\([0-9]+\\)$" ":\\1"))) | |
200 (setq url (format "http://%s%s" host report))) | |
127 (if (not (and host report url)) | 201 (if (not (and host report url)) |
128 (gnus-message | 202 (gnus-message |
129 3 "Could not find a spam report header in article %d..." | 203 3 "Could not find a spam report header in article %d..." |
130 article) | 204 article) |
131 (gnus-message 7 "Reporting spam through URL %s..." url) | 205 (gnus-message 7 "Reporting article through URL %s..." url) |
132 (spam-report-url-ping host report)))))))) | 206 (spam-report-url-ping host report))))))))) |
133 | 207 |
134 (defun spam-report-url-ping (host report) | 208 (defun spam-report-url-ping (host report) |
135 "Ping a host through HTTP, addressing a specific GET resource using | 209 "Ping a host through HTTP, addressing a specific GET resource using |
136 the function specified by `spam-report-url-ping-function'." | 210 the function specified by `spam-report-url-ping-function'." |
137 ;; Example: | 211 ;; Example: |
138 ;; host: "spam.gmane.org" | 212 ;; host: "spam.gmane.org" |
139 ;; report: "/gmane.some.group:123456" | 213 ;; report: "/gmane.some.group:123456" |
140 (funcall spam-report-url-ping-function host report)) | 214 (funcall spam-report-url-ping-function host report)) |
215 | |
216 (defcustom spam-report-user-mail-address | |
217 (and (stringp user-mail-address) | |
218 (gnus-replace-in-string user-mail-address "@" "<at>")) | |
219 "Mail address of this user used for spam reports to Gmane. | |
220 This is initialized based on `user-mail-address'." | |
221 :type '(choice string | |
222 (const :tag "Don't expose address" nil)) | |
223 :version "23.0" ;; No Gnus | |
224 :group 'spam-report) | |
225 | |
226 (defvar spam-report-user-agent | |
227 (if spam-report-user-mail-address | |
228 (format "%s (%s) %s" "spam-report.el" | |
229 spam-report-user-mail-address | |
230 (gnus-extended-version)) | |
231 (format "%s %s" "spam-report.el" | |
232 (gnus-extended-version)))) | |
141 | 233 |
142 (defun spam-report-url-ping-plain (host report) | 234 (defun spam-report-url-ping-plain (host report) |
143 "Ping a host through HTTP, addressing a specific GET resource." | 235 "Ping a host through HTTP, addressing a specific GET resource." |
144 (let ((tcp-connection)) | 236 (let ((tcp-connection)) |
145 (with-temp-buffer | 237 (with-temp-buffer |
151 80)) | 243 80)) |
152 (error "Could not open connection to %s" host)) | 244 (error "Could not open connection to %s" host)) |
153 (set-marker (process-mark tcp-connection) (point-min)) | 245 (set-marker (process-mark tcp-connection) (point-min)) |
154 (process-send-string | 246 (process-send-string |
155 tcp-connection | 247 tcp-connection |
156 (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n" | 248 (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n" |
157 report (gnus-extended-version) host))))) | 249 report spam-report-user-agent host)) |
250 ;; Wait until we get something so we don't DOS the host. | |
251 (while (and (memq (process-status tcp-connection) '(open run)) | |
252 (zerop (buffer-size))) | |
253 (accept-process-output tcp-connection))))) | |
158 | 254 |
159 ;;;###autoload | 255 ;;;###autoload |
160 (defun spam-report-process-queue (&optional file keep) | 256 (defun spam-report-process-queue (&optional file keep) |
161 "Report all queued requests from `spam-report-requests-file'. | 257 "Report all queued requests from `spam-report-requests-file'. |
162 | 258 |
181 (save-excursion | 277 (save-excursion |
182 (set-buffer (find-file-noselect file)) | 278 (set-buffer (find-file-noselect file)) |
183 (goto-char (point-min)) | 279 (goto-char (point-min)) |
184 (while (and (not (eobp)) | 280 (while (and (not (eobp)) |
185 (re-search-forward | 281 (re-search-forward |
186 "http://\\([^/]+\\)\\(/.*\\) *$" (gnus-point-at-eol) t)) | 282 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) |
187 (funcall spam-report-url-ping-function (match-string 1) (match-string 2)) | 283 (funcall spam-report-url-ping-function (match-string 1) (match-string 2)) |
188 (forward-line 1)) | 284 (forward-line 1)) |
189 (if (or (eq keep nil) | 285 (if (or (eq keep nil) |
190 (and (eq keep 'ask) | 286 (and (eq keep 'ask) |
191 (y-or-n-p | 287 (y-or-n-p |