Merge branch 'master' of https://git.gnus.org/gnus

[gnus] / lisp / spam-report.el

diff --git a/lisp/spam-report.el b/lisp/spam-report.el
index c45728e..30e0ae5 100644 (file)
--- a/lisp/spam-report.el
+++ b/lisp/spam-report.el
@@ -1,26 +1,25 @@
 ;;; spam-report.el --- Reporting spam
 
 ;;; spam-report.el --- Reporting spam
 

-;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;   Free Software Foundation, Inc.

 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: network, spam, mail, gmane, report
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: network, spam, mail, gmane, report
 
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -32,8 +31,7 @@
 (require 'gnus)
 (require 'gnus-sum)
 
 (require 'gnus)
 (require 'gnus-sum)
 

-(eval-and-compile
-  (autoload 'mm-url-insert "mm-url"))
+(autoload 'mm-url-insert "mm-url")

 
 (defgroup spam-report nil
   "Spam reporting configuration."
 
 (defgroup spam-report nil
   "Spam reporting configuration."


@@ -97,12 +95,12 @@ undo that change.")
   "Report an article as spam by resending via email.
 Reports is as ham when HAM is set."
   (dolist (article articles)
   "Report an article as spam by resending via email.
 Reports is as ham when HAM is set."
   (dolist (article articles)

-    (gnus-message 6 
+    (gnus-message 6

                  "Reporting %s article %d to <%s>..."
                  (if ham "ham" "spam")
                  article spam-report-resend-to)
     (unless spam-report-resend-to
                  "Reporting %s article %d to <%s>..."
                  (if ham "ham" "spam")
                  article spam-report-resend-to)
     (unless spam-report-resend-to

-      (customize-set-variable 
+      (customize-set-variable

        spam-report-resend-to
        (read-from-minibuffer "email address to resend SPAM/HAM to? ")))
     ;; This is ganked from the `gnus-summary-resend-message' function.
        spam-report-resend-to
        (read-from-minibuffer "email address to resend SPAM/HAM to? ")))
     ;; This is ganked from the `gnus-summary-resend-message' function.


@@ -111,25 +109,40 @@ Reports is as ham when HAM is set."
     ;; select this particular article
     (gnus-summary-select-article nil nil nil article)
     ;; resend it to the destination address
     ;; select this particular article
     (gnus-summary-select-article nil nil nil article)
     ;; resend it to the destination address

-    (save-excursion
-      (set-buffer gnus-original-article-buffer)
+    (with-current-buffer gnus-original-article-buffer

       (message-resend spam-report-resend-to))))
 
 (defun spam-report-resend-ham (articles)
   "Report an article as ham by resending via email."
   (spam-report-resend articles t))
 
       (message-resend spam-report-resend-to))))
 
 (defun spam-report-resend-ham (articles)
   "Report an article as ham by resending via email."
   (spam-report-resend articles t))
 

+(defconst spam-report-gmane-max-requests 4
+  "Number of reports to send before waiting for a response.")
+
+(defvar spam-report-gmane-wait nil
+  "When non-nil, wait until we get a server response.
+This makes sure we don't DOS the host, if many reports are
+submitted at once.  Internal variable.")
+

 (defun spam-report-gmane-ham (&rest articles)
   "Report ARTICLES as ham (unregister) through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))
 (defun spam-report-gmane-ham (&rest articles)
   "Report ARTICLES as ham (unregister) through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))

-  (dolist (article articles)
-    (spam-report-gmane-internal t article)))
+  (let ((count 0))
+    (dolist (article articles)
+      (setq count (1+ count))
+      (let ((spam-report-gmane-wait
+            (zerop (% count spam-report-gmane-max-requests))))
+       (spam-report-gmane-internal t article)))))

 
 (defun spam-report-gmane-spam (&rest articles)
   "Report ARTICLES as spam through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))
 
 (defun spam-report-gmane-spam (&rest articles)
   "Report ARTICLES as spam through Gmane."
   (interactive (gnus-summary-work-articles current-prefix-arg))

-  (dolist (article articles)
-    (spam-report-gmane-internal nil article)))
+  (let ((count 0))
+    (dolist (article articles)
+      (setq count (1+ count))
+      (let ((spam-report-gmane-wait
+            (zerop (% count spam-report-gmane-max-requests))))
+       (spam-report-gmane-internal nil article)))))

 
 ;; `spam-report-gmane' was an interactive entry point, so we should provide an
 ;; alias.
 
 ;; `spam-report-gmane' was an interactive entry point, so we should provide an
 ;; alias.


@@ -220,7 +233,7 @@ the function specified by `spam-report-url-ping-function'."
 This is initialized based on `user-mail-address'."
   :type '(choice string
                 (const :tag "Don't expose address" nil))
 This is initialized based on `user-mail-address'."
   :type '(choice string
                 (const :tag "Don't expose address" nil))

-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus

   :group 'spam-report)
 
 (defvar spam-report-user-agent
   :group 'spam-report)
 
 (defvar spam-report-user-agent


@@ -243,14 +256,19 @@ This is initialized based on `user-mail-address'."
                 80))
          (error "Could not open connection to %s" host))
       (set-marker (process-mark tcp-connection) (point-min))
                 80))
          (error "Could not open connection to %s" host))
       (set-marker (process-mark tcp-connection) (point-min))

+      (gnus-set-process-query-on-exit-flag tcp-connection nil)

       (process-send-string
        tcp-connection
        (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
               report spam-report-user-agent host))
       (process-send-string
        tcp-connection
        (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
               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)))))
+      ;; Wait until we get something so we don't DOS the host, if
+      ;; `spam-report-gmane-wait' is let-bound to t.
+      (when spam-report-gmane-wait
+       (gnus-message 7 "Waiting for response from %s..." host)
+       (while (and (memq (process-status tcp-connection) '(open run))
+                   (zerop (buffer-size)))
+         (accept-process-output tcp-connection 1))
+       (gnus-message 7 "Waiting for response from %s... done" host)))))

 
 ;;;###autoload
 (defun spam-report-process-queue (&optional file keep)
 
 ;;;###autoload
 (defun spam-report-process-queue (&optional file keep)


@@ -274,13 +292,18 @@ symbol `ask', query before flushing the queue file."
     (gnus-message 7 "Processing requests using `%s'."
                  spam-report-url-ping-function))
   (or file (setq file spam-report-requests-file))
     (gnus-message 7 "Processing requests using `%s'."
                  spam-report-url-ping-function))
   (or file (setq file spam-report-requests-file))

-  (save-excursion
-    (set-buffer (find-file-noselect file))
+  (with-current-buffer (find-file-noselect file)

     (goto-char (point-min))
     (while (and (not (eobp))
                (re-search-forward
                 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t))
     (goto-char (point-min))
     (while (and (not (eobp))
                (re-search-forward
                 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t))

-      (funcall spam-report-url-ping-function (match-string 1) (match-string 2))
+      (let ((spam-report-gmane-wait
+            (zerop (% (mm-line-number-at-pos)
+                      spam-report-gmane-max-requests))))
+       (gnus-message 6 "Reporting %s%s..."
+                     (match-string 1) (match-string 2))
+       (funcall spam-report-url-ping-function
+                (match-string 1) (match-string 2)))

       (forward-line 1))
     (if (or (eq keep nil)
            (and (eq keep 'ask)
       (forward-line 1))
     (if (or (eq keep nil)
            (and (eq keep 'ask)


@@ -361,5 +384,4 @@ Process queued spam reports."
 
 (provide 'spam-report)
 
 
 (provide 'spam-report)
 

-;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022

 ;;; spam-report.el ends here.
 ;;; spam-report.el ends here.