X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-spam.el;h=350f99eb24bc32c2cf673e97c8164a83a47e4031;hb=dbe998d1d9e0bb2c424dc2c9f79fb09eda4154aa;hp=5bf47ec93b522bae9a2cacb3362cdb208bdb6186;hpb=4bede68a2b742a97316537183f9210cafdbc9320;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-spam.el b/elmo/elmo-spam.el
index 5bf47ec..350f99e 100644
--- a/elmo/elmo-spam.el
+++ b/elmo/elmo-spam.el
@@ -44,7 +44,10 @@
   "*Scheme of spam processor implementation. "
   :type '(choice (const :tag "none" nil)
 		 (const :tag "Bogofilter" bogofilter)
-		 (const :tag "Spamfilter" spamfilter))
+		 (const :tag "Spamfilter" spamfilter)
+		 (const :tag "SpamAssassin" sa)
+		 (const :tag "Header" header)
+		 (const :tag "Bsfilter" bsfilter))
   :group 'elmo-spam)
 
 (eval-and-compile
@@ -88,7 +91,7 @@ register according to the classification.")
 
 (luna-define-generic elmo-spam-list-spam-messages (processor
 						   folder &optional numbers)
-  "Return a list of message numbers which is gussed spam.
+  "Return a list of message numbers which is classified as spam.
 PROCESSOR is spam processor structure.
 FOLDER is the ELMO folder structure.
 If optional argument NUMBERS is specified and is a list of message numbers,
@@ -121,9 +124,8 @@ If optional argument RESTORE is non-nil, unregister from spam list.")
   (let (elmo-message-fetch-threshold)
     (elmo-message-fetch
      folder number
-     (elmo-find-fetch-strategy folder
-			       (elmo-message-entity folder number))
-     nil (current-buffer) 'unread)))
+     (elmo-find-fetch-strategy folder number nil 'entire)
+     'unread)))
 
 ;; generic implement
 (luna-define-method elmo-spam-message-spam-p ((processor elsp-generic)
@@ -148,7 +150,6 @@ If optional argument RESTORE is non-nil, unregister from spam list.")
 						      numbers restore)
   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
     (with-temp-buffer
-      (buffer-disable-undo (current-buffer))
       (dolist (number numbers)
 	(erase-buffer)
 	(elmo-spam-message-fetch folder number)
@@ -161,7 +162,6 @@ If optional argument RESTORE is non-nil, unregister from spam list.")
 						      numbers restore)
   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
     (with-temp-buffer
-      (buffer-disable-undo (current-buffer))
       (dolist (number numbers)
 	(erase-buffer)
 	(elmo-spam-message-fetch folder number)
@@ -181,6 +181,81 @@ If optional argument RESTORE is non-nil, unregister from spam list.")
 	  (setq elmo-spam-processor-internal
 		(luna-make-entity class))))))
 
+;; Backend for header match
+(eval-and-compile
+  (luna-define-class elsp-header (elsp-generic)))
+
+(defgroup elmo-spam-header nil
+  "Spam header configuration."
+  :group 'elmo-spam)
+
+(defcustom elmo-spam-header-good-alist '(("X-Spam-Flag" . "No"))
+  "*Regular expression for positive header good matches."
+  :type '(repeat (cons (string :tag "Header name")
+		       (regexp :tag "Regular expression to match good header")))
+  :group 'elmo-spam-header)
+
+(defcustom elmo-spam-header-spam-alist '(("X-Spam-Flag" . "Yes"))
+  "*Regular expression for positive header spam matches."
+  :type '(repeat (cons (string :tag "Header name")
+		       (regexp :tag "Regular expression to match spam header")))
+  :group 'elmo-spam-header)
+
+(defun elmo-spam-header-check-headers (fetch-field-function)
+  (catch 'done
+    (dolist (pair elmo-spam-header-good-alist)
+      (let ((field-body (funcall fetch-field-function (car pair))))
+	(when (and field-body (string-match (cdr pair) field-body))
+	  (throw 'done nil))))
+    (dolist (pair elmo-spam-header-spam-alist)
+      (let ((field-body (funcall fetch-field-function (car pair))))
+	(when (and field-body (string-match (cdr pair) field-body))
+	  (throw 'done t))))))
+
+(luna-define-method elmo-spam-buffer-spam-p ((processor elsp-header)
+					     buffer &optional register)
+  (with-current-buffer buffer
+    (save-restriction
+      (std11-narrow-to-header)
+      (elmo-spam-header-check-headers #'elmo-decoded-field-body))))
+
+(luna-define-method elmo-spam-message-spam-p ((processor elsp-header)
+					      folder number &optional register)
+  (let ((entity (elmo-message-entity folder number))
+	buffer)
+    (unwind-protect
+	(save-excursion
+	  (elmo-spam-header-check-headers
+	   (lambda (field-name)
+	     (or (elmo-message-entity-field entity
+					    (intern (downcase field-name))
+					    'decode)
+		 (progn
+		   (unless buffer
+		     (setq buffer (get-buffer-create
+				   (generate-new-buffer-name
+				    " *elmo-spam-work*")))
+		     (set-buffer buffer)
+		     (elmo-spam-message-fetch folder number)
+		     (std11-narrow-to-header))
+		   (elmo-decoded-field-body field-name))))))
+      (and buffer (kill-buffer buffer)))))
+
+(luna-define-method elmo-spam-register-spam-messages ((processor elsp-header)
+						      folder
+						      &optional
+						      numbers restore)
+  (elmo-progress-notify 'elmo-spam-register (length numbers)))
+
+(luna-define-method elmo-spam-register-good-messages ((processor elsp-header)
+						      folder
+						      &optional
+						      numbers restore)
+  (elmo-progress-notify 'elmo-spam-register (length numbers)))
+
+(provide 'elsp-header)
+
+
 (require 'product)
 (product-provide (provide 'elmo-spam) (require 'elmo-version))