X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fspam.el;h=07c3651be9efa70a1c99590d6a0de09c44a65432;hb=1ea316e372f66b58739d21012914b4f33b75e897;hp=111f6710010805c737e6f3e6b6a76633346ce16c;hpb=113c24ae67a2bd4aa0dbca8f2086bddf1bb16521;p=gnus

diff --git a/lisp/spam.el b/lisp/spam.el
index 111f67100..07c3651be 100644
--- a/lisp/spam.el
+++ b/lisp/spam.el
@@ -223,6 +223,18 @@ Enable this if you want Gnus to invoke Bogofilter on new messages."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-use-bsfilter-headers nil
+  "Whether bsfilter headers should be used by `spam-split'.
+Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-use-bsfilter nil
+  "Whether bsfilter should be invoked by `spam-split'.
+Enable this if you want Gnus to invoke Bsfilter on new messages."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-use-BBDB nil
   "Whether BBDB should be used by `spam-split'."
   :type 'boolean
@@ -277,6 +289,8 @@ them."
 			       spam-use-bogofilter-headers
 			       spam-use-spamassassin
 			       spam-use-spamassassin-headers
+			       spam-use-bsfilter
+			       spam-use-bsfilter-headers
 			       spam-use-BBDB
 			       spam-use-BBDB-exclusive
 			       spam-use-ifile
@@ -434,6 +448,53 @@ your main source of newsgroup names."
 		 (const :tag "Use the default"))
   :group 'spam-bogofilter)
 
+(defgroup spam-bsfilter nil
+  "Spam bsfilter configuration."
+  :group 'spam)
+
+(defcustom spam-bsfilter-path (executable-find "bsfilter")
+  "File path of the Bsfilter executable program."
+  :type '(choice (file :tag "Location of bsfilter")
+		 (const :tag "Bsfilter is not installed"))
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-header "X-Spam-Flag"
+  "The header inserted by Bsfilter to flag spam."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-probability-header "X-Spam-Probability"
+  "The header that Bsfilter inserts in messages."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-spam-switch "--add-spam"
+  "The switch that Bsfilter uses to register spam messages."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-ham-switch "--add-ham"
+  "The switch that Bsfilter uses to register ham messages."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
+  "The switch that Bsfilter uses to unregister ham messages."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
+  "The switch that Bsfilter uses to unregister spam messages."
+  :type 'string
+  :group 'spam-bsfilter)
+
+(defcustom spam-bsfilter-database-directory nil
+  "Directory path of the Bsfilter databases."
+  :type '(choice (directory
+		  :tag "Location of the Bsfilter database directory")
+		 (const :tag "Use the default"))
+  :group 'spam-bsfilter)
+
 (defgroup spam-spamoracle nil
   "Spam spamoracle configuration."
   :group 'spam)
@@ -600,6 +661,7 @@ finds ham or spam.")
 (defvar spam-list-of-processors
   '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
     (gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
+    (gnus-group-spam-exit-processor-bsfilter	 spam spam-use-bsfilter)
     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
@@ -607,6 +669,7 @@ finds ham or spam.")
     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
+    (gnus-group-ham-exit-processor-bsfilter      ham spam-use-bsfilter)
     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
@@ -686,14 +749,65 @@ Respects the process/prefix convention."
     (gnus-summary-remove-process-mark article)
     (spam-report-gmane article)))
 
-(defun spam-generic-score ()
-  (interactive)
+(defun spam-necessary-extra-headers ()
+  "Return the extra headers spam.el thinks are necessary."
+  (let (list)
+    (when (or spam-use-spamassassin
+	      spam-use-spamassassin-headers
+	      spam-use-regex-headers)
+      (push 'X-Spam-Status list))
+    list))
+
+(defun spam-user-format-function-S (headers)
+  (when headers
+    (spam-summary-score headers)))
+
+(defun spam-article-sort-by-spam-status (h1 h2)
+  "Sort articles by score."
+  (let (result)
+    (dolist (header (spam-necessary-extra-headers))
+      (let ((s1 (spam-summary-score h1 header))
+	    (s2 (spam-summary-score h2 header)))
+      (unless (= s1 s2)
+	(setq result (< s1 s2))
+	(return))))
+    result))
+
+(defun spam-extra-header-to-number (header headers)
+  "Transform an extra header to a number."
+  (if (gnus-extra-header header headers)
+      (cond
+       ((eq header 'X-Spam-Status)
+	(string-to-number (gnus-replace-in-string
+			   (gnus-extra-header header headers)
+			   ".*hits=" "")))
+       (t nil))
+    nil))
+
+(defun spam-summary-score (headers &optional specific-header)
+  "Score an article for the summary buffer, as fast as possible.
+With SPECIFIC-HEADER, returns only that header's score.
+Will not return a nil score."
+  (let (score)
+    (dolist (header 
+	     (if specific-header
+		 (list specific-header)
+	       (spam-necessary-extra-headers)))
+      (setq score 
+	    (spam-extra-header-to-number header headers))
+      (when score 
+	(return)))
+    (or score 0)))
+
+(defun spam-generic-score (&optional recheck)
   "Invoke whatever scoring method we can."
-  (if (or
-       spam-use-spamassassin
-       spam-use-spamassassin-headers)
-      (spam-spamassassin-score)
-    (spam-bogofilter-score)))
+  (interactive "P")
+  (cond
+   ((or spam-use-spamassassin spam-use-spamassassin-headers)
+    (spam-spamassassin-score recheck))
+   ((or spam-use-bsfilter spam-use-bsfilter-headers)
+    (spam-bsfilter-score recheck))
+   (t (spam-bogofilter-score recheck))))
 
 ;;; Summary entry and exit processing.
 
@@ -733,7 +847,8 @@ Respects the process/prefix convention."
 	    ;; call spam-register-routine with specific articles to unregister,
 	    ;; when there are articles to unregister and the check is enabled
 	    (when (and unregister-list (symbol-value check))
-	      (spam-register-routine classification check t unregister-list))))))
+	      (spam-register-routine
+	       classification check t unregister-list))))))
 
     ;; find all the spam processors applicable to this group
     (dolist (processor-param spam-list-of-processors)
@@ -745,16 +860,22 @@ Respects the process/prefix convention."
 	  (spam-register-routine classification check))))
 
     (unless (and spam-move-spam-nonspam-groups-only
-		 (not (spam-group-spam-contents-p gnus-newsgroup-name)))
-      (gnus-message 5 "Marking spam as expired and moving it to %s"
-		    gnus-newsgroup-name)
-      (spam-mark-spam-as-expired-and-move-routine
-       (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+		 (spam-group-spam-contents-p gnus-newsgroup-name))
+      (let* ((group (gnus-parameter-spam-process-destination
+		     gnus-newsgroup-name))
+	     (num (spam-mark-spam-as-expired-and-move-routine group)))
+	(when (> num 0)
+	  (gnus-message 6
+			"%d spam messages are marked as expired and moved it to %s"
+			num group))))
 
     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
     ;; expire spam, in case the above did not expire them
-    (gnus-message 5 "Marking spam as expired without moving it")
-    (spam-mark-spam-as-expired-and-move-routine nil)
+    (let ((num (spam-mark-spam-as-expired-and-move-routine nil)))
+      (when (> num 0)
+	(gnus-message 6
+		      "%d spam messages are markd as expired without moving it"
+		      num)))
 
     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 	      (and (spam-group-spam-contents-p gnus-newsgroup-name)
@@ -770,15 +891,19 @@ Respects the process/prefix convention."
 	    (spam-register-routine classification check)))))
 
     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
-      (gnus-message 5 "Copying ham")
-      (spam-ham-copy-routine
-       (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
+      (let ((num
+	     (spam-ham-copy-routine
+	      (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+	(when (> num 0)
+	  (gnus-message 6 "%d ham messages are copied" num))))
 
     ;; now move all ham articles out of spam groups
     (when (spam-group-spam-contents-p gnus-newsgroup-name)
-      (gnus-message 5 "Moving ham messages from spam group")
-      (spam-ham-move-routine
-       (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+      (let ((num
+	     (spam-ham-move-routine
+	      (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+	(when (> num 0)
+	  (gnus-message 6 "%d ham messages are moved from spam group" num)))))
 
   (setq spam-old-ham-articles nil)
   (setq spam-old-spam-articles nil))
@@ -801,7 +926,7 @@ When either list is nil, the other is returned."
   ;; check the global list of group names spam-junk-mailgroups and the
   ;; group parameters
   (when (spam-group-spam-contents-p gnus-newsgroup-name)
-    (gnus-message 5 "Marking %s articles as spam"
+    (gnus-message 6 "Marking %s articles as spam"
 		  (if spam-mark-only-unseen-as-spam
 		      "unseen"
 		    "unread"))
@@ -848,7 +973,8 @@ When either list is nil, the other is returned."
 	  (let ((gnus-novice-user nil))	; don't ask me if I'm sure
 	    (gnus-summary-delete-article nil))))
 
-      (gnus-summary-yank-process-mark))))
+      (gnus-summary-yank-process-mark)
+      (length tomove))))
 
 (defun spam-ham-copy-or-move-routine (copy groups)
   (gnus-summary-kill-process-mark)
@@ -892,9 +1018,10 @@ When either list is nil, the other is returned."
 	  (gnus-summary-set-process-mark article))
 	(when todo
 	  (let ((gnus-novice-user nil))	; don't ask me if I'm sure
-	    (gnus-summary-delete-article nil))))))
+	    (gnus-summary-delete-article nil)))))
 
-  (gnus-summary-yank-process-mark))
+    (gnus-summary-yank-process-mark)
+    (length todo)))
 
 (defun spam-ham-copy-routine (&rest groups)
   (if (and (car-safe groups) (listp (car-safe groups)))
@@ -949,7 +1076,7 @@ When either list is nil, the other is returned."
 	  (mail-header-extra data-header))
 	 (t
 	  nil))
-	(gnus-message 5 "Article %d has a nil data header" article)))))
+	(gnus-message 6 "Article %d has a nil data header" article)))))
 
 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
   (spam-fetch-field-fast article 'from prepared-data-header))
@@ -1005,7 +1132,9 @@ When either list is nil, the other is returned."
     (spam-use-spamassassin-headers 	. 	spam-check-spamassassin-headers)
     (spam-use-spamassassin 		. 	spam-check-spamassassin)
     (spam-use-bogofilter-headers 	. 	spam-check-bogofilter-headers)
-    (spam-use-bogofilter 	 	. 	spam-check-bogofilter))
+    (spam-use-bogofilter 	 	. 	spam-check-bogofilter)
+    (spam-use-bsfilter-headers		.	spam-check-bsfilter-headers)
+    (spam-use-bsfilter			.	spam-check-bsfilter))
   "The spam-list-of-checks list contains pairs associating a
 parameter variable with a spam checking function.  If the
 parameter variable is true, then the checking function is called,
@@ -1025,6 +1154,7 @@ definitely a spam.")
     spam-use-regex-body
     spam-use-stat
     spam-use-bogofilter
+    spam-use-bsfilter
     spam-use-blackholes
     spam-use-spamassassin
     spam-use-spamoracle)
@@ -1071,7 +1201,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 			 (and specific-checks (memq (car pair) specific-checks))
 			 ;; or, given no specific checks, spam-use-CHECK is set
 			 (and (null specific-checks) (symbol-value (car pair))))
-		    (gnus-message 5 "spam-split: calling the %s function"
+		    (gnus-message 6 "spam-split: calling the %s function"
 				  (symbol-name (cdr pair)))
 		    (setq decision (funcall (cdr pair)))
 		    ;; if we got a decision at all, save the current check
@@ -1121,7 +1251,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	     registry-lookup)
 	 
 	 (unless id
-	   (gnus-message 5 "Article %d has no message ID!" article))
+	   (gnus-message 6 "Article %d has no message ID!" article))
 	 
 	 (when (and id spam-log-to-registry)
 	   (setq registry-lookup (spam-log-registration-type id 'incoming))
@@ -1208,7 +1338,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (spam-use-bogofilter spam-bogofilter-register-ham-routine
 			 spam-bogofilter-register-spam-routine
 			 spam-bogofilter-unregister-ham-routine
-			 spam-bogofilter-unregister-spam-routine))
+			 spam-bogofilter-unregister-spam-routine)
+    (spam-use-bsfilter	 spam-bsfilter-register-ham-routine
+			 spam-bsfilter-register-spam-routine
+			 spam-bsfilter-unregister-ham-routine
+			 spam-bsfilter-unregister-spam-routine))
   "The spam-registration-functions list contains pairs
 associating a parameter variable with the ham and spam
 registration functions, and the ham and spam unregistration
@@ -1392,7 +1526,7 @@ functions")
 	   type
 	   new-cell-list))
       (progn
-	(gnus-message 5 (format "%s call with bad ID, type, spam-check, or group"
+	(gnus-message 6 (format "%s call with bad ID, type, spam-check, or group"
 				"spam-log-undo-registration"))
 	nil))))
 
@@ -1468,7 +1602,7 @@ functions")
       (with-temp-buffer
 	(insert headers)
 	(goto-char (point-min))
-	(gnus-message 5 "Checking headers for relay addresses")
+	(gnus-message 6 "Checking headers for relay addresses")
 	(while (re-search-forward
 		"\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
 	  (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
@@ -1486,13 +1620,13 @@ functions")
 		(if spam-use-dig
 		    (let ((query-result (query-dig query-string)))
 		      (when query-result
-			(gnus-message 5 "(DIG): positive blackhole check '%s'"
+			(gnus-message 6 "(DIG): positive blackhole check '%s'"
 				      query-result)
 			(push (list ip server query-result)
 			      matches)))
 		  ;; else, if not using dig.el
 		  (when (query-dns query-string)
-		    (gnus-message 5 "positive blackhole check")
+		    (gnus-message 6 "positive blackhole check")
 		    (push (list ip server (query-dns query-string 'TXT))
 			  matches)))))))))
     (when matches
@@ -1543,7 +1677,7 @@ functions")
 		   (record (and net-address
 				(bbdb-search-simple nil net-address))))
 	      (when net-address
-		(gnus-message 5 "%s address %s %s BBDB"
+		(gnus-message 6 "%s address %s %s BBDB"
 			      (if remove "Deleting" "Adding")
 			      from
 			      (if remove "from" "to"))
@@ -1942,13 +2076,14 @@ REMOVE not nil, remove the ADDRESSES."
 	  spam-split-group)))))
 
 ;; return something sensible if the score can't be determined
-(defun spam-bogofilter-score ()
+(defun spam-bogofilter-score (&optional recheck)
   "Get the Bogofilter spamicity score"
-  (interactive)
+  (interactive "P")
   (save-window-excursion
     (gnus-summary-show-article t)
     (set-buffer gnus-article-buffer)
-    (let ((score (or (spam-check-bogofilter-headers t)
+    (let ((score (or (unless recheck
+		       (spam-check-bogofilter-headers t))
 		     (spam-check-bogofilter t))))
       (gnus-summary-show-article)
       (message "Spamicity score %s" score)
@@ -2107,13 +2242,14 @@ REMOVE not nil, remove the ADDRESSES."
 	(spam-check-spamassassin-headers score)))))
 
 ;; return something sensible if the score can't be determined
-(defun spam-spamassassin-score ()
+(defun spam-spamassassin-score (&optional recheck)
   "Get the SpamAssassin score"
-  (interactive)
+  (interactive "P")
   (save-window-excursion
     (gnus-summary-show-article t)
     (set-buffer gnus-article-buffer)
-    (let ((score (or (spam-check-spamassassin-headers t)
+    (let ((score (or (unless recheck
+		       (spam-check-spamassassin-headers t))
 		     (spam-check-spamassassin t))))
       (gnus-summary-show-article)
       (message "SpamAssassin score %s" score)
@@ -2160,13 +2296,113 @@ REMOVE not nil, remove the ADDRESSES."
 
 (defun spam-spamassassin-unregister-ham-routine (articles)
   (spam-spamassassin-register-with-sa-learn articles nil t))
+
+
+;;;; Bsfilter
+;;; based mostly on the bogofilter code
+(defun spam-check-bsfilter-headers (&optional score)
+  (if score
+      (or (nnmail-fetch-field spam-bsfilter-probability-header)
+	  "0")
+    (let ((header (nnmail-fetch-field spam-bsfilter-header))
+	  (spam-split-group (if spam-split-symbolic-return
+				'spam
+			      spam-split-group)))
+      (when header ; return nil when no header
+	(when (string-match "YES" header)
+	  spam-split-group)))))
+
+;; return something sensible if the score can't be determined
+(defun spam-bsfilter-score (&optional recheck)
+  "Get the Bsfilter spamicity score"
+  (interactive "P")
+  (save-window-excursion
+    (gnus-summary-show-article t)
+    (set-buffer gnus-article-buffer)
+    (let ((score (or (unless recheck
+		       (spam-check-bsfilter-headers t))
+		     (spam-check-bsfilter t))))
+      (gnus-summary-show-article)
+      (message "Spamicity score %s" score)
+      (or score "0"))))
+
+(defun spam-check-bsfilter (&optional score)
+  "Check the Bsfilter backend for the classification of this message"
+  (let ((article-buffer-name (buffer-name))
+	(dir spam-bsfilter-database-directory)
+	return)
+    (with-temp-buffer
+      (let ((temp-buffer-name (buffer-name)))
+	(save-excursion
+	  (set-buffer article-buffer-name)
+	  (apply 'call-process-region
+		 (point-min) (point-max)
+		 spam-bsfilter-path
+		 nil temp-buffer-name nil
+		 "--pipe"
+		 "--insert-flag"
+		 "--insert-probability"
+		 (when dir
+		   (list "--homedir" dir))))
+	(setq return (spam-check-bsfilter-headers score))))
+    return))
+
+(defun spam-bsfilter-register-with-bsfilter (articles
+					     spam
+					     &optional unregister)
+  "Register an article, given as a string, as spam or non-spam."
+  (dolist (article articles)
+    (let ((article-string (spam-get-article-as-string article))
+	  (switch (if unregister
+		      (if spam
+			  spam-bsfilter-spam-strong-switch
+			spam-bsfilter-ham-strong-switch)
+		    (if spam
+			spam-bsfilter-spam-switch
+		      spam-bsfilter-ham-switch))))
+      (when (stringp article-string)
+	(with-temp-buffer
+	  (insert article-string)
+	  (apply 'call-process-region
+		 (point-min) (point-max)
+		 spam-bsfilter-path
+		 nil nil nil switch
+		 "--update"
+		 (when spam-bsfilter-database-directory
+		   (list "--homedir"
+			 spam-bsfilter-database-directory))))))))
+
+(defun spam-bsfilter-register-spam-routine (articles &optional unregister)
+  (spam-bsfilter-register-with-bsfilter articles t unregister))
+
+(defun spam-bsfilter-unregister-spam-routine (articles)
+  (spam-bsfilter-register-spam-routine articles t))
+
+(defun spam-bsfilter-register-ham-routine (articles &optional unregister)
+  (spam-bsfilter-register-with-bsfilter articles nil unregister))
+
+(defun spam-bsfilter-unregister-ham-routine (articles)
+  (spam-bsfilter-register-ham-routine articles t))
+
 
 ;;;; Hooks
 
 ;;;###autoload
-(defun spam-initialize ()
-  "Install the spam.el hooks and do other initialization"
+(defun spam-initialize (&rest symbols)
+  "Install the spam.el hooks and do other initialization.
+When SYMBOLS is given, set those variables to t.  This is so you
+can call spam-initialize before you set spam-use-* variables on
+explicitly, and matters only if you need the extra headers
+installed through spam-necessary-extra-headers."
   (interactive)
+
+  (dolist (var symbols)
+    (set var t))
+
+  (dolist (header (spam-necessary-extra-headers))
+    (add-to-list 'nnmail-extra-headers header)
+    (add-to-list 'gnus-extra-headers header))
+
   (setq spam-install-hooks t)
   ;; TODO: How do we redo this every time spam-face is customized?
   (push '((eq mark gnus-spam-mark) . spam-face)
@@ -2196,4 +2432,5 @@ REMOVE not nil, remove the ADDRESSES."
 
 (provide 'spam)
 
+;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
 ;;; spam.el ends here