| 1 | ;;; spam-report.el --- Reporting spam |
| 2 | |
| 3 | ;; Copyright (C) 2002-2013 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Ted Zlatanov <tzz@lifelogs.com> |
| 6 | ;; Keywords: network, spam, mail, gmane, report |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 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 |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or |
| 13 | ;; (at your option) any later version. |
| 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 |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 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 | |
| 33 | (autoload 'mm-url-insert "mm-url") |
| 34 | |
| 35 | (defgroup spam-report nil |
| 36 | "Spam reporting configuration." |
| 37 | :group 'mail |
| 38 | :group 'news) |
| 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) |
| 46 | (regexp :value "^nntp\+.*:gmane\.")) |
| 47 | :group 'spam-report) |
| 48 | |
| 49 | (defcustom spam-report-gmane-use-article-number t |
| 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." |
| 55 | :type 'boolean |
| 56 | :group 'spam-report) |
| 57 | |
| 58 | (defcustom spam-report-url-ping-function |
| 59 | 'spam-report-url-ping-plain |
| 60 | "Function to use for url ping spam reporting. |
| 61 | The function must accept the arguments `host' and `report'." |
| 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'" |
| 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)) |
| 70 | :group 'spam-report) |
| 71 | |
| 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 | |
| 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." |
| 84 | :type '(choice (const :tag "Prompt" nil) string) |
| 85 | :group 'spam-report) |
| 86 | |
| 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 | |
| 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) |
| 97 | (gnus-message 6 |
| 98 | "Reporting %s article %d to <%s>..." |
| 99 | (if ham "ham" "spam") |
| 100 | article spam-report-resend-to) |
| 101 | (unless spam-report-resend-to |
| 102 | (customize-set-variable |
| 103 | spam-report-resend-to |
| 104 | (read-from-minibuffer "email address to resend SPAM/HAM to? "))) |
| 105 | ;; This is yanked from the `gnus-summary-resend-message' function. |
| 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 |
| 111 | (with-current-buffer gnus-original-article-buffer |
| 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 | |
| 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 | |
| 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)) |
| 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))))) |
| 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)) |
| 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))))) |
| 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 |
| 179 | (with-current-buffer nntp-server-buffer |
| 180 | (erase-buffer) |
| 181 | (gnus-request-head article gnus-newsgroup-name) |
| 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") |
| 192 | (gnus-fetch-field "X-Report-Unspam") |
| 193 | (gnus-fetch-field "Archived-At"))) |
| 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))) |
| 213 | (if (not (and host report url)) |
| 214 | (gnus-message |
| 215 | 3 "Could not find a spam report header in article %d..." |
| 216 | article) |
| 217 | (gnus-message 7 "Reporting article through URL %s..." url) |
| 218 | (spam-report-url-ping host report))))))))) |
| 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'." |
| 223 | ;; Example: |
| 224 | ;; host: "spam.gmane.org" |
| 225 | ;; report: "/gmane.some.group:123456" |
| 226 | (funcall spam-report-url-ping-function host report)) |
| 227 | |
| 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)) |
| 235 | :version "23.1" ;; No Gnus |
| 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 | |
| 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)) |
| 258 | (gnus-set-process-query-on-exit-flag tcp-connection nil) |
| 259 | (process-send-string |
| 260 | tcp-connection |
| 261 | (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n" |
| 262 | report spam-report-user-agent host)) |
| 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))) |
| 269 | (accept-process-output tcp-connection 1)) |
| 270 | (gnus-message 7 "Waiting for response from %s... done" host))))) |
| 271 | |
| 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)) |
| 294 | (with-current-buffer (find-file-noselect file) |
| 295 | (goto-char (point-min)) |
| 296 | (while (and (not (eobp)) |
| 297 | (re-search-forward |
| 298 | "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) |
| 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))) |
| 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 |
| 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 |
| 326 | (let ((url (format "http://%s%s" host report))) |
| 327 | (mm-url-insert url t)))) |
| 328 | |
| 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." |
| 333 | (let ((url (format "http://%s%s" host report)) |
| 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 | |
| 384 | (provide 'spam-report) |
| 385 | |
| 386 | ;;; spam-report.el ends here. |