Merge from emacs--devo--0

[gnus] / lisp / spam-report.el

diff --git a/lisp/spam-report.el b/lisp/spam-report.el
index abbb8d1..701682a 100644 (file)
--- a/lisp/spam-report.el
+++ b/lisp/spam-report.el
@@ -1,6 +1,6 @@
 ;;; spam-report.el --- Reporting spam
 
-;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: network, spam, mail, gmane, report
@@ -9,7 +9,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -50,7 +50,11 @@ instead."
   :group 'spam-report)
 
 (defcustom spam-report-gmane-use-article-number t
-  "Whether the article number (faster!) or the header should be used."
+  "Whether the article number (faster!) or the header should be used.
+
+You must set this to nil if you don't read Gmane groups directly
+from news.gmane.org, e.g. when using local newsserver such as
+leafnode."
   :type 'boolean
   :group 'spam-report)
 
@@ -138,13 +142,30 @@ Reports is as ham when HAM is set."
                 (string-match spam-report-gmane-regex gnus-newsgroup-name)))
     (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org")))
       (gnus-message 6 "Reporting article %d to %s..." article rpt-host)
-      (if spam-report-gmane-use-article-number
-         (spam-report-url-ping
-          rpt-host
-          (format "/%s:%d"
-                  (gnus-group-real-name gnus-newsgroup-name)
-                  article))
+      (cond
+       ;; Special-case nnweb groups -- these have the URL to use in
+       ;; the Xref headers.
+       ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb)
+       (spam-report-url-ping
+        rpt-host
+        (concat
+         "/"
+         (gnus-replace-in-string
+          (gnus-replace-in-string
+           (gnus-replace-in-string
+            (mail-header-xref (gnus-summary-article-header article))
+            "/raw" ":silent")
+           "^.*article.gmane.org/" "")
+          "/" ":"))))
+       (spam-report-gmane-use-article-number
+       (spam-report-url-ping
+        rpt-host
+        (format "/%s:%d"
+                (gnus-group-real-name gnus-newsgroup-name)
+                article)))
+       (t
        (with-current-buffer nntp-server-buffer
+         (erase-buffer)
          (gnus-request-head article gnus-newsgroup-name)
          (let ((case-fold-search t)
                field host report url)
@@ -158,24 +179,31 @@ Reports is as ham when HAM is set."
            (setq field (or (gnus-fetch-field "X-Report-Spam")
                            (gnus-fetch-field "X-Report-Unspam")
                            (gnus-fetch-field "Archived-At")))
-           (setq host (progn
-                        (string-match
-                         (concat "http://\\([a-z]+\\.gmane\\.org\\)"
-                                 "\\(/[^:/]+[:/][0-9]+\\)")
-                         field)
-                        (match-string 1 field)))
-           (setq report (match-string 2 field))
-           (when (string-equal "permalink.gmane.org" host)
-             (setq host rpt-host)
-             (setq report (gnus-replace-in-string
-                           report "/\\([0-9]+\\)$" ":\\1")))
-           (setq url (format "http://%s%s" host report))
+           (if (not (stringp field))
+               (if (and (setq field (gnus-fetch-field "Xref"))
+                        (string-match "[^ ]+ +\\([^ ]+\\)" field))
+                   (setq report (concat "/" (match-string 1 field))
+                         host rpt-host))
+             (setq host
+                   (progn
+                     (string-match
+                      (concat "http://\\([a-z]+\\.gmane\\.org\\)"
+                              "\\(/[^:/]+[:/][0-9]+\\)")
+                      field)
+                     (match-string 1 field)))
+             (setq report (match-string 2 field)))
+           (when host
+             (when (string-equal "permalink.gmane.org" host)
+               (setq host rpt-host)
+               (setq report (gnus-replace-in-string
+                             report "/\\([0-9]+\\)$" ":\\1")))
+             (setq url (format "http://%s%s" host report)))
            (if (not (and host report url))
                (gnus-message
                 3 "Could not find a spam report header in article %d..."
                 article)
              (gnus-message 7 "Reporting article through URL %s..." url)
-             (spam-report-url-ping host report))))))))
+             (spam-report-url-ping host report)))))))))
 
 (defun spam-report-url-ping (host report)
   "Ping a host through HTTP, addressing a specific GET resource using
@@ -218,7 +246,11 @@ This is initialized based on `user-mail-address'."
       (process-send-string
        tcp-connection
        (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
-              report spam-report-user-agent host)))))
+              report spam-report-user-agent host))
+      ;; Wait until we get something so we don't DOS the host. 
+      (while (and (memq (process-status tcp-connection) '(open run))
+                 (zerop (buffer-size)))
+       (accept-process-output tcp-connection)))))
 
 ;;;###autoload
 (defun spam-report-process-queue (&optional file keep)