From: hmurata Date: Sat, 22 May 2004 08:09:04 +0000 (+0000) Subject: * elmo-spam.el (elmo-spam-scheme): Add `header' as a candidate. X-Git-Tag: wl-2_11_29~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ead2813df5935b15f77b2d2830646bc704373fc4;p=elisp%2Fwanderlust.git * elmo-spam.el (elmo-spam-scheme): Add `header' as a candidate. (elsp-header): New backend. * elmo-util.el (elmo-decoded-field-body): New function. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index f6bae66..42c2923 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,10 @@ +2004-05-22 Hiroya Murata + + * elmo-spam.el (elmo-spam-scheme): Add `header' as a candidate. + (elsp-header): New backend. + + * elmo-util.el (elmo-decoded-field-body): New function. + 2004-05-16 Hiroya Murata * elmo-version.el (elmo-version): Up to 2.11.28. diff --git a/elmo/elmo-spam.el b/elmo/elmo-spam.el index 63bd6f4..936f47b 100644 --- a/elmo/elmo-spam.el +++ b/elmo/elmo-spam.el @@ -46,6 +46,7 @@ (const :tag "Bogofilter" bogofilter) (const :tag "Spamfilter" spamfilter) (const :tag "SpamAssassin" sa) + (const :tag "Header" header) (const :tag "Bsfilter" bsfilter)) :group 'elmo-spam) @@ -90,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, @@ -183,6 +184,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)) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 9d2a8d2..bf6e891 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1276,6 +1276,12 @@ SPEC is a list as followed (LABEL MAX-VALUE [FORMAT])." (and value (std11-unfold-string value)))) +(defun elmo-decoded-field-body (field-name &optional mode) + (let ((field-body (elmo-field-body field-name))) + (and field-body + (elmo-set-work-buf + (mime-decode-field-body field-body field-name mode))))) + (defun elmo-address-quote-specials (word) "Make quoted string of WORD if needed." (let ((lal (std11-lexical-analyze word)))