Commit | Line | Data |
---|---|---|
23f87bed | 1 | ;;; spam-report.el --- Reporting spam |
e84b4b86 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. |
23f87bed | 4 | |
01c52d31 MB |
5 | ;; Author: Ted Zlatanov <tzz@lifelogs.com> |
6 | ;; Keywords: network, spam, mail, gmane, report | |
23f87bed MB |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
23f87bed | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
23f87bed MB |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
5e809f55 | 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
23f87bed MB |
18 | ;; GNU General Public License for more details. |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
23f87bed MB |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; This module addresses a few aspects of spam reporting under Gnus. Page | |
26 | ;;; breaks are used for grouping declarations and documentation relating to | |
27 | ;;; each particular aspect. | |
28 | ||
29 | ;;; Code: | |
30 | (require 'gnus) | |
31 | (require 'gnus-sum) | |
32 | ||
8abf1b22 | 33 | (autoload 'mm-url-insert "mm-url") |
23f87bed MB |
34 | |
35 | (defgroup spam-report nil | |
d0859c9a MB |
36 | "Spam reporting configuration." |
37 | :group 'mail | |
38 | :group 'news) | |
23f87bed MB |
39 | |
40 | (defcustom spam-report-gmane-regex nil | |
41 | "Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\" | |
42 | If you are using spam.el, consider setting gnus-spam-process-newsgroups | |
43 | or the gnus-group-spam-exit-processor-report-gmane group/topic parameter | |
44 | instead." | |
45 | :type '(radio (const nil) | |
ad136a7c | 46 | (regexp :value "^nntp\+.*:gmane\.")) |
23f87bed MB |
47 | :group 'spam-report) |
48 | ||
23f87bed | 49 | (defcustom spam-report-gmane-use-article-number t |
c96ec15a MB |
50 | "Whether the article number (faster!) or the header should be used. |
51 | ||
52 | You must set this to nil if you don't read Gmane groups directly | |
53 | from news.gmane.org, e.g. when using local newsserver such as | |
54 | leafnode." | |
23f87bed MB |
55 | :type 'boolean |
56 | :group 'spam-report) | |
57 | ||
58 | (defcustom spam-report-url-ping-function | |
59 | 'spam-report-url-ping-plain | |
61b397cd MB |
60 | "Function to use for url ping spam reporting. |
61 | The function must accept the arguments `host' and `report'." | |
23f87bed MB |
62 | :type '(choice |
63 | (const :tag "Connect directly" | |
64 | spam-report-url-ping-plain) | |
65 | (const :tag "Use the external program specified in `mm-url-program'" | |
61b397cd MB |
66 | spam-report-url-ping-mm-url) |
67 | (const :tag "Store request URLs in `spam-report-requests-file'" | |
68 | spam-report-url-to-file) | |
69 | (function :tag "User defined function" nil)) | |
23f87bed MB |
70 | :group 'spam-report) |
71 | ||
61b397cd MB |
72 | (defcustom spam-report-requests-file |
73 | (nnheader-concat gnus-directory "spam/" "spam-report-requests.url") | |
74 | ;; Is there a convention for the extension of such a file? | |
75 | ;; Should we use `spam-directory'? | |
76 | "File where spam report request are stored." | |
77 | :type 'file | |
78 | :group 'spam-report) | |
79 | ||
01c52d31 MB |
80 | (defcustom spam-report-resend-to nil |
81 | "Email address that spam articles are resent to when reporting. | |
82 | If not set, the user will be prompted to enter a value which will be | |
83 | saved for future use." | |
a931698a | 84 | :type '(choice (const :tag "Prompt" nil) string) |
01c52d31 MB |
85 | :group 'spam-report) |
86 | ||
61b397cd MB |
87 | (defvar spam-report-url-ping-temp-agent-function nil |
88 | "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. | |
89 | This variable will store the value of `spam-report-url-ping-function' from | |
90 | before `spam-report-agentize' was run, so that `spam-report-deagentize' can | |
91 | undo that change.") | |
92 | ||
01c52d31 MB |
93 | (defun spam-report-resend (articles &optional ham) |
94 | "Report an article as spam by resending via email. | |
95 | Reports is as ham when HAM is set." | |
96 | (dolist (article articles) | |
c9fc72fa | 97 | (gnus-message 6 |
01c52d31 MB |
98 | "Reporting %s article %d to <%s>..." |
99 | (if ham "ham" "spam") | |
100 | article spam-report-resend-to) | |
101 | (unless spam-report-resend-to | |
c9fc72fa | 102 | (customize-set-variable |
01c52d31 MB |
103 | spam-report-resend-to |
104 | (read-from-minibuffer "email address to resend SPAM/HAM to? "))) | |
3ed8598c | 105 | ;; This is yanked from the `gnus-summary-resend-message' function. |
01c52d31 MB |
106 | ;; It involves rendering the SPAM, which is undesirable, but there does |
107 | ;; not seem to be a nicer way to achieve this. | |
108 | ;; select this particular article | |
109 | (gnus-summary-select-article nil nil nil article) | |
110 | ;; resend it to the destination address | |
20a673b2 | 111 | (with-current-buffer gnus-original-article-buffer |
01c52d31 MB |
112 | (message-resend spam-report-resend-to)))) |
113 | ||
114 | (defun spam-report-resend-ham (articles) | |
115 | "Report an article as ham by resending via email." | |
116 | (spam-report-resend articles t)) | |
117 | ||
e3e955fe MB |
118 | (defconst spam-report-gmane-max-requests 4 |
119 | "Number of reports to send before waiting for a response.") | |
120 | ||
121 | (defvar spam-report-gmane-wait nil | |
122 | "When non-nil, wait until we get a server response. | |
123 | This makes sure we don't DOS the host, if many reports are | |
124 | submitted at once. Internal variable.") | |
125 | ||
01c52d31 MB |
126 | (defun spam-report-gmane-ham (&rest articles) |
127 | "Report ARTICLES as ham (unregister) through Gmane." | |
128 | (interactive (gnus-summary-work-articles current-prefix-arg)) | |
e3e955fe MB |
129 | (let ((count 0)) |
130 | (dolist (article articles) | |
131 | (setq count (1+ count)) | |
132 | (let ((spam-report-gmane-wait | |
133 | (zerop (% count spam-report-gmane-max-requests)))) | |
134 | (spam-report-gmane-internal t article))))) | |
01c52d31 MB |
135 | |
136 | (defun spam-report-gmane-spam (&rest articles) | |
137 | "Report ARTICLES as spam through Gmane." | |
138 | (interactive (gnus-summary-work-articles current-prefix-arg)) | |
e3e955fe MB |
139 | (let ((count 0)) |
140 | (dolist (article articles) | |
141 | (setq count (1+ count)) | |
142 | (let ((spam-report-gmane-wait | |
143 | (zerop (% count spam-report-gmane-max-requests)))) | |
144 | (spam-report-gmane-internal nil article))))) | |
01c52d31 MB |
145 | |
146 | ;; `spam-report-gmane' was an interactive entry point, so we should provide an | |
147 | ;; alias. | |
148 | (defalias 'spam-report-gmane 'spam-report-gmane-spam) | |
149 | ||
150 | (defun spam-report-gmane-internal (unspam article) | |
151 | "Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM." | |
152 | (when (and gnus-newsgroup-name | |
153 | (or (null spam-report-gmane-regex) | |
154 | (string-match spam-report-gmane-regex gnus-newsgroup-name))) | |
155 | (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org"))) | |
156 | (gnus-message 6 "Reporting article %d to %s..." article rpt-host) | |
157 | (cond | |
158 | ;; Special-case nnweb groups -- these have the URL to use in | |
159 | ;; the Xref headers. | |
160 | ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb) | |
161 | (spam-report-url-ping | |
162 | rpt-host | |
163 | (concat | |
164 | "/" | |
165 | (gnus-replace-in-string | |
166 | (gnus-replace-in-string | |
167 | (gnus-replace-in-string | |
168 | (mail-header-xref (gnus-summary-article-header article)) | |
169 | "/raw" ":silent") | |
170 | "^.*article.gmane.org/" "") | |
171 | "/" ":")))) | |
172 | (spam-report-gmane-use-article-number | |
173 | (spam-report-url-ping | |
174 | rpt-host | |
175 | (format "/%s:%d" | |
176 | (gnus-group-real-name gnus-newsgroup-name) | |
177 | article))) | |
178 | (t | |
23f87bed | 179 | (with-current-buffer nntp-server-buffer |
01c52d31 | 180 | (erase-buffer) |
23f87bed | 181 | (gnus-request-head article gnus-newsgroup-name) |
d752cf53 MB |
182 | (let ((case-fold-search t) |
183 | field host report url) | |
184 | ;; First check for X-Report-Spam because it's more specific to | |
185 | ;; spam reporting than Archived-At. OTOH, all new articles on | |
186 | ;; Gmane don't have X-Report-Spam anymore (unless Lars changes his | |
187 | ;; mind :-)). | |
188 | ;; | |
189 | ;; There might be more than one Archived-At header so we need to | |
190 | ;; find (and transform) the one related to Gmane. | |
191 | (setq field (or (gnus-fetch-field "X-Report-Spam") | |
01c52d31 | 192 | (gnus-fetch-field "X-Report-Unspam") |
d752cf53 | 193 | (gnus-fetch-field "Archived-At"))) |
01c52d31 MB |
194 | (if (not (stringp field)) |
195 | (if (and (setq field (gnus-fetch-field "Xref")) | |
196 | (string-match "[^ ]+ +\\([^ ]+\\)" field)) | |
197 | (setq report (concat "/" (match-string 1 field)) | |
198 | host rpt-host)) | |
199 | (setq host | |
200 | (progn | |
201 | (string-match | |
202 | (concat "http://\\([a-z]+\\.gmane\\.org\\)" | |
203 | "\\(/[^:/]+[:/][0-9]+\\)") | |
204 | field) | |
205 | (match-string 1 field))) | |
206 | (setq report (match-string 2 field))) | |
207 | (when host | |
208 | (when (string-equal "permalink.gmane.org" host) | |
209 | (setq host rpt-host) | |
210 | (setq report (gnus-replace-in-string | |
211 | report "/\\([0-9]+\\)$" ":\\1"))) | |
212 | (setq url (format "http://%s%s" host report))) | |
d752cf53 MB |
213 | (if (not (and host report url)) |
214 | (gnus-message | |
215 | 3 "Could not find a spam report header in article %d..." | |
216 | article) | |
01c52d31 MB |
217 | (gnus-message 7 "Reporting article through URL %s..." url) |
218 | (spam-report-url-ping host report))))))))) | |
23f87bed MB |
219 | |
220 | (defun spam-report-url-ping (host report) | |
221 | "Ping a host through HTTP, addressing a specific GET resource using | |
222 | the function specified by `spam-report-url-ping-function'." | |
d752cf53 MB |
223 | ;; Example: |
224 | ;; host: "spam.gmane.org" | |
225 | ;; report: "/gmane.some.group:123456" | |
23f87bed MB |
226 | (funcall spam-report-url-ping-function host report)) |
227 | ||
01c52d31 MB |
228 | (defcustom spam-report-user-mail-address |
229 | (and (stringp user-mail-address) | |
230 | (gnus-replace-in-string user-mail-address "@" "<at>")) | |
231 | "Mail address of this user used for spam reports to Gmane. | |
232 | This is initialized based on `user-mail-address'." | |
233 | :type '(choice string | |
234 | (const :tag "Don't expose address" nil)) | |
330f707b | 235 | :version "23.1" ;; No Gnus |
01c52d31 MB |
236 | :group 'spam-report) |
237 | ||
238 | (defvar spam-report-user-agent | |
239 | (if spam-report-user-mail-address | |
240 | (format "%s (%s) %s" "spam-report.el" | |
241 | spam-report-user-mail-address | |
242 | (gnus-extended-version)) | |
243 | (format "%s %s" "spam-report.el" | |
244 | (gnus-extended-version)))) | |
245 | ||
23f87bed MB |
246 | (defun spam-report-url-ping-plain (host report) |
247 | "Ping a host through HTTP, addressing a specific GET resource." | |
248 | (let ((tcp-connection)) | |
249 | (with-temp-buffer | |
250 | (or (setq tcp-connection | |
251 | (open-network-stream | |
252 | "URL ping" | |
253 | (buffer-name) | |
254 | host | |
255 | 80)) | |
256 | (error "Could not open connection to %s" host)) | |
257 | (set-marker (process-mark tcp-connection) (point-min)) | |
71e691a5 | 258 | (gnus-set-process-query-on-exit-flag tcp-connection nil) |
23f87bed MB |
259 | (process-send-string |
260 | tcp-connection | |
01c52d31 MB |
261 | (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n" |
262 | report spam-report-user-agent host)) | |
e3e955fe MB |
263 | ;; Wait until we get something so we don't DOS the host, if |
264 | ;; `spam-report-gmane-wait' is let-bound to t. | |
265 | (when spam-report-gmane-wait | |
266 | (gnus-message 7 "Waiting for response from %s..." host) | |
267 | (while (and (memq (process-status tcp-connection) '(open run)) | |
268 | (zerop (buffer-size))) | |
d832b437 | 269 | (accept-process-output tcp-connection 1)) |
e3e955fe | 270 | (gnus-message 7 "Waiting for response from %s... done" host))))) |
23f87bed | 271 | |
61b397cd MB |
272 | ;;;###autoload |
273 | (defun spam-report-process-queue (&optional file keep) | |
274 | "Report all queued requests from `spam-report-requests-file'. | |
275 | ||
276 | If FILE is given, use it instead of `spam-report-requests-file'. | |
277 | If KEEP is t, leave old requests in the file. If KEEP is the | |
278 | symbol `ask', query before flushing the queue file." | |
279 | (interactive | |
280 | (list (read-file-name | |
281 | "File: " | |
282 | (file-name-directory spam-report-requests-file) | |
283 | spam-report-requests-file | |
284 | nil | |
285 | (file-name-nondirectory spam-report-requests-file)) | |
286 | current-prefix-arg)) | |
287 | (if (eq spam-report-url-ping-function 'spam-report-url-to-file) | |
288 | (error (concat "Cannot process requests when " | |
289 | "`spam-report-url-ping-function' is " | |
290 | "`spam-report-url-to-file'.")) | |
291 | (gnus-message 7 "Processing requests using `%s'." | |
292 | spam-report-url-ping-function)) | |
293 | (or file (setq file spam-report-requests-file)) | |
20a673b2 | 294 | (with-current-buffer (find-file-noselect file) |
61b397cd MB |
295 | (goto-char (point-min)) |
296 | (while (and (not (eobp)) | |
297 | (re-search-forward | |
01c52d31 | 298 | "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) |
e3e955fe MB |
299 | (let ((spam-report-gmane-wait |
300 | (zerop (% (mm-line-number-at-pos) | |
301 | spam-report-gmane-max-requests)))) | |
302 | (gnus-message 6 "Reporting %s%s..." | |
303 | (match-string 1) (match-string 2)) | |
304 | (funcall spam-report-url-ping-function | |
305 | (match-string 1) (match-string 2))) | |
61b397cd MB |
306 | (forward-line 1)) |
307 | (if (or (eq keep nil) | |
308 | (and (eq keep 'ask) | |
309 | (y-or-n-p | |
310 | (format | |
311 | "Flush requests from `%s'? " (current-buffer))))) | |
312 | (progn | |
313 | (gnus-message 7 "Flushing request file `%s'" | |
314 | spam-report-requests-file) | |
315 | (erase-buffer) | |
316 | (save-buffer) | |
317 | (kill-buffer (current-buffer))) | |
318 | (gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file)))) | |
319 | ||
320 | ;;;###autoload | |
23f87bed MB |
321 | (defun spam-report-url-ping-mm-url (host report) |
322 | "Ping a host through HTTP, addressing a specific GET resource. Use | |
323 | the external program specified in `mm-url-program' to connect to | |
324 | server." | |
325 | (with-temp-buffer | |
e9bd5782 | 326 | (let ((url (format "http://%s%s" host report))) |
23f87bed MB |
327 | (mm-url-insert url t)))) |
328 | ||
61b397cd MB |
329 | ;;;###autoload |
330 | (defun spam-report-url-to-file (host report) | |
331 | "Collect spam report requests in `spam-report-requests-file'. | |
332 | Customize `spam-report-url-ping-function' to use this function." | |
e9bd5782 | 333 | (let ((url (format "http://%s%s" host report)) |
61b397cd MB |
334 | (file spam-report-requests-file)) |
335 | (gnus-make-directory (file-name-directory file)) | |
336 | (gnus-message 9 "Writing URL `%s' to file `%s'" url file) | |
337 | (with-temp-buffer | |
338 | (insert url) | |
339 | (newline) | |
340 | (append-to-file (point-min) (point-max) file)))) | |
341 | ||
342 | ;;;###autoload | |
343 | (defun spam-report-agentize () | |
344 | "Add spam-report support to the Agent. | |
345 | Spam reports will be queued with \\[spam-report-url-to-file] when | |
346 | the Agent is unplugged, and will be submitted in a batch when the | |
347 | Agent is plugged." | |
348 | (interactive) | |
349 | (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) | |
350 | (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) | |
351 | ||
352 | ;;;###autoload | |
353 | (defun spam-report-deagentize () | |
354 | "Remove spam-report support from the Agent. | |
355 | Spam reports will be queued with the method used when | |
356 | \\[spam-report-agentize] was run." | |
357 | (interactive) | |
358 | (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) | |
359 | (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) | |
360 | ||
361 | (defun spam-report-plug-agent () | |
362 | "Adjust spam report settings for plugged state. | |
363 | Process queued spam reports." | |
364 | ;; Process the queue, unless the user only wanted to report to a file | |
365 | ;; anyway. | |
366 | (unless (equal spam-report-url-ping-temp-agent-function | |
367 | 'spam-report-url-to-file) | |
368 | (spam-report-process-queue)) | |
369 | ;; Set the reporting function, if we have memorized something otherwise, | |
370 | ;; stick with plain URL reporting. | |
371 | (setq spam-report-url-ping-function | |
372 | (or spam-report-url-ping-temp-agent-function | |
373 | 'spam-report-url-ping-plain))) | |
374 | ||
375 | (defun spam-report-unplug-agent () | |
376 | "Restore spam report settings for unplugged state." | |
377 | ;; save the old value | |
378 | (setq spam-report-url-ping-temp-agent-function | |
379 | spam-report-url-ping-function) | |
380 | ;; store all reports to file | |
381 | (setq spam-report-url-ping-function | |
382 | 'spam-report-url-to-file)) | |
383 | ||
23f87bed MB |
384 | (provide 'spam-report) |
385 | ||
23f87bed | 386 | ;;; spam-report.el ends here. |