Re: SPAM in spam group is processed into that exact same group

[Tassilo Horn <tassilo@member.fsf.org>]

On Sunday 05 December 2010 13:33:35 Lars Magne Ingebrigtsen wrote:
> Tassilo Horn <tassilo@member.fsf.org> writes:
> 
> > Could you please review the patch and apply it if it semms correct?
> 
> Your patch is nearly 3K lines long, apparently because you've
> re-indented spam.el in its entirety.  Could you send a new patch that
> just has the relevant changes?

No, Ted did so, see <87tyk8x03w.fsf@lifelogs.com>.

Ted> The patch is pretty large because I fixed formatting issues with
Ted> spam.el; sorry about that.

But anyway, here's a a patch made with "git diff -w".

--8<---------------cut here---------------start------------->8---
diff --git a/lisp/spam.el b/lisp/spam.el
index 097299f..7da3476 100644
--- a/lisp/spam.el
+++ b/lisp/spam.el
@@ -93,12 +93,16 @@ Populated by `spam-install-backend-super'.")
   "Exit behavior at the time of summary exit.
 Note that setting the `spam-use-move' or `spam-use-copy' backends on
 a group through group/topic parameters overrides this mechanism."
-  :type '(choice (const 'default :tag
-			"Move spam out of all groups.  Move ham out of spam groups.")
-		 (const 'move-all :tag
-			"Move spam out of all groups.  Move ham out of all groups.")
-		 (const 'move-none :tag
-			"Never move spam or ham out of any groups."))
+  :type '(choice
+          (const
+           'default
+           :tag "Move spam out of all groups and ham out of spam groups.")
+          (const
+           'move-all
+           :tag "Move spam out of all groups and ham out of all groups.")
+          (const
+           'move-none
+           :tag "Never move spam or ham out of any groups."))
   :group 'spam)
 
 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
@@ -938,7 +942,8 @@ This is a temporary storage function - nothing here persists."
    backend
    (intern (spam-backend-article-list-property classification unregister))))
 
-(defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
+(defun spam-backend-put-article-todo-list (backend classification list
+                                                   &optional unregister)
   "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
 With UNREGISTER, set articles to be unregistered.
 This is a temporary storage function - nothing here persists."
@@ -1059,7 +1064,7 @@ backends)."
 (spam-install-statistical-checkonly-backend 'spam-use-regex-body
 					    'spam-check-regex-body)
 
-;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead
+;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy)
 (spam-install-mover-backend 'spam-use-move
 			    'spam-move-ham-routine
 			    'spam-move-spam-routine
@@ -1432,14 +1437,41 @@ addition to the set values for the group."
 	 (gnus-check-backend-function
 	  'request-move-article gnus-newsgroup-name))
 	(respool-method (gnus-find-method-for-group gnus-newsgroup-name))
-	article mark deletep respool)
+        article mark deletep respool valid-move-destinations)
 
     (when (member 'respool groups)
       (setq respool t)			; boolean for later
       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
 
+    ;; exclude invalid move destinations
+    (dolist (group groups)
+      (unless
+          (or
+           (and
+            (eq classification 'spam)
+            (spam-group-spam-contents-p gnus-newsgroup-name)
+            (spam-group-spam-contents-p group)
+            (gnus-message
+             3
+             "Sorry, can't move spam from spam group %s to spam group %s"
+             gnus-newsgroup-name
+             group))
+           (and
+            (eq classification 'ham)
+            (spam-group-ham-contents-p gnus-newsgroup-name)
+            (spam-group-ham-contents-p group)
+            (gnus-message
+             3
+             "Sorry, can't move ham from ham group %s to ham group %s"
+             gnus-newsgroup-name
+             group)))
+        (push group valid-move-destinations)))
+
+    (setq groups (nreverse valid-move-destinations))
+
     ;; now do the actual move
     (dolist (group groups)
+
       (when (and articles (stringp group))
 
 	;; first, mark the article with the process mark and, if needed,
@@ -1465,7 +1497,8 @@ addition to the set values for the group."
 		(gnus-message 9 "Respooling article %d with method %s"
 			      article respool-method)
 		(gnus-summary-respool-article nil respool-method))
-	    (if (or (not backend-supports-deletions) ; else, we are not respooling
+            ;; else, we are not respooling
+            (if (or (not backend-supports-deletions)
 		    (> (length groups) 1))
 		(progn		    ; if copying, copy and set deletep
 		  (gnus-message 9 "Copying article %d to group %s"
@@ -1474,7 +1507,7 @@ addition to the set values for the group."
 		  (setq deletep t))
 	      (gnus-message 9 "Moving article %d to group %s"
 			    article group)
-	      (gnus-summary-move-article nil group)))))	; else move articles
+              (gnus-summary-move-article nil group)))))) ; else move articles
 
       ;; now delete the articles, unless a) copy is t, and there was a copy done
       ;;                                 b) a move was done to a single group
@@ -1487,9 +1520,8 @@ addition to the set values for the group."
 	  (when articles
 	    (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 	      (gnus-summary-delete-article nil)))))
-
       (gnus-summary-yank-process-mark)
-      (length articles))))
+    (length articles)))
 
 (defun spam-copy-spam-routine (articles)
   (spam-copy-or-move-routine
@@ -1543,7 +1575,7 @@ addition to the set values for the group."
 ;;       nil)))
 
 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
-  "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function.
+  "Fetch a FIELD for ARTICLE with the internal `gnus-data-list' function.
 When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
 When FIELD is 'number, ARTICLE can be any number (since we want
 to find it out)."
@@ -1780,7 +1812,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	  (unless (zerop delcount)
 	    (gnus-message
 	     9
-	     "%d messages were saved the trouble of unregistering and then registering"
+             "%d messages did not have to unregister and then register"
 	     delcount))
 
 	  ;; unregister articles
@@ -1873,7 +1905,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
       (gnus-error
        7
-       (format "%s call with bad ID, type, classification, spam-backend, or group"
+       (format
+        "%s call with bad ID, type, classification, spam-backend, or group"
 	       "spam-log-processing-to-registry")))))
 
 ;;; check if a ham- or spam-processor registration has been done
@@ -1930,7 +1963,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
 
 ;;; undo a ham- or spam-processor registration (the group is not used)
-(defun spam-log-undo-registration (id type classification backend &optional group)
+(defun spam-log-undo-registration (id type classification backend
+                                      &optional group)
   (when (and spam-log-to-registry
 	     (spam-log-unregistration-needed-p id type classification backend))
     (if (and (stringp id)
@@ -1948,7 +1982,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	   type
 	   new-cell-list))
       (progn
-	(gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group"
+        (gnus-error 7 (format
+                       "%s call with bad ID, type, spam-backend, or group"
 			      "spam-log-undo-registration"))
 	nil))))
 
@@ -2024,7 +2059,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (dolist (server spam-blackhole-servers)
 	(dolist (ip ips)
 	  (unless (and spam-blackhole-good-server-regex
-		       ;; match the good-server-regex against the reversed (again) IP string
+                       ;; match against the reversed (again) IP string
 		       (string-match
 			spam-blackhole-good-server-regex
 			(spam-reverse-ip-string ip)))
@@ -2390,7 +2425,8 @@ With a non-nil REMOVE, remove the ADDRESSES."
 	  (forward-line 1)
 	  ;; insert the e-mail address if detected, otherwise the raw data
 	  (unless (zerop (length address))
-	    (let ((pure-address (nth 1 (gnus-extract-address-components address))))
+            (let ((pure-address
+                   (nth 1 (gnus-extract-address-components address))))
 	      (push (or pure-address address) contents)))))
       (nreverse contents))))
 
--8<---------------cut here---------------end--------------->8---

Bye,
Tassilo