1 ;;; elmo-spam.el --- Spam filtering interface to processor.
3 ;; Copyright (C) 2003 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
4 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Author: Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
7 ;; Keywords: mail, net news, spam
9 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
33 (eval-when-compile (require 'cl))
39 (defgroup elmo-spam nil
40 "Spam configuration for wanderlust."
43 (defcustom elmo-spam-scheme nil
44 "*Scheme of spam processor implementation. "
45 :type '(choice (const :tag "none" nil)
46 (const :tag "Bogofilter" bogofilter)
47 (const :tag "Spamfilter" spamfilter)
48 (const :tag "SpamAssassin" sa)
49 (const :tag "Header" header)
50 (const :tag "Bsfilter" bsfilter))
54 (luna-define-class elsp-generic ()))
57 (luna-define-generic elmo-spam-buffer-spam-p (processor buffer
59 "Return non-nil if contents of BUFFER is spam.
60 PROCESSOR is spam processor structure.
61 If optional augument REGISTER is non-nil,
62 register according to the classification.")
64 (luna-define-generic elmo-spam-register-spam-buffer (processor
67 "Register contents of BUFFER as spam.
68 PROCESSOR is spam processor structure.
69 If optional argument RESTORE is non-nil, unregister from non-spam list.")
71 (luna-define-generic elmo-spam-register-good-buffer (processor
74 "Register contents of BUFFER as non-spam.
75 PROCESSOR is spam processor structure.
76 If optional argument RESTORE is non-nil, unregister from spam list.")
79 (luna-define-generic elmo-spam-modified-p (processor)
80 "Return non-nil if status of PROCESSOR is modified.")
82 (luna-define-generic elmo-spam-save-status (processor)
83 "Save status of the PROCESSOR.")
85 (luna-define-generic elmo-spam-message-spam-p (processor folder number
87 "Return non-nil if the message in the FOLDER with NUMBER is spam.
88 PROCESSOR is spam processor structure.
89 If optional augument REGISTER is non-nil,
90 register according to the classification.")
92 (luna-define-generic elmo-spam-list-spam-messages (processor
93 folder &optional numbers)
94 "Return a list of message numbers which is classified as spam.
95 PROCESSOR is spam processor structure.
96 FOLDER is the ELMO folder structure.
97 If optional argument NUMBERS is specified and is a list of message numbers,
98 messages are searched from the list.")
100 (luna-define-generic elmo-spam-register-spam-messages (processor
104 "Register contents of messages as spam.
105 PROCESSOR is spam processor structure.
106 FOLDER is the ELMO folder structure.
107 If optional argument NUMBERS is specified and is a list of message numbers,
108 messages are searched from the list.
109 If optional argument RESTORE is non-nil, unregister from non-spam list.")
111 (luna-define-generic elmo-spam-register-good-messages (processor
115 "Register contents of messages as non spam.
116 PROCESSOR is spam processor structure.
117 FOLDER is the ELMO folder structure.
118 If optional argument NUMBERS is specified and is a list of message numbers,
119 messages are searched from the list.
120 If optional argument RESTORE is non-nil, unregister from spam list.")
123 (defun elmo-spam-message-fetch (folder number)
124 (let (elmo-message-fetch-threshold)
125 (when enable-multibyte-characters
126 (set-buffer-multibyte nil))
129 (elmo-find-fetch-strategy folder number nil 'entire)
133 (luna-define-method elmo-spam-message-spam-p ((processor elsp-generic)
134 folder number &optional register)
136 (elmo-spam-message-fetch folder number)
137 (elmo-spam-buffer-spam-p processor (current-buffer) register)))
139 (luna-define-method elmo-spam-list-spam-messages ((processor elsp-generic)
140 folder &optional numbers)
141 (let ((numbers (or numbers (elmo-folder-list-messages folder t t)))
143 (dolist (number numbers)
144 (when (elmo-spam-message-spam-p processor folder number)
145 (setq spam-list (cons number spam-list)))
146 (elmo-progress-notify 'elmo-spam-check-spam))
147 (nreverse spam-list)))
149 (luna-define-method elmo-spam-register-spam-messages ((processor elsp-generic)
153 (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
155 (dolist (number numbers)
157 (elmo-spam-message-fetch folder number)
158 (elmo-spam-register-spam-buffer processor (current-buffer) restore)
159 (elmo-progress-notify 'elmo-spam-register)))))
161 (luna-define-method elmo-spam-register-good-messages ((processor elsp-generic)
165 (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
167 (dolist (number numbers)
169 (elmo-spam-message-fetch folder number)
170 (elmo-spam-register-good-buffer processor (current-buffer) restore)
171 (elmo-progress-notify 'elmo-spam-register)))))
173 (provide 'elsp-generic)
175 (defvar elmo-spam-processor-internal nil)
177 (defun elmo-spam-processor (&optional if-exists)
178 (or elmo-spam-processor-internal
180 (let* ((scheme (or elmo-spam-scheme 'generic))
181 (class (intern (format "elsp-%s" scheme))))
183 (setq elmo-spam-processor-internal
184 (luna-make-entity class))))))
186 ;; Backend for header match
188 (luna-define-class elsp-header (elsp-generic)))
190 (defgroup elmo-spam-header nil
191 "Spam header configuration."
194 (defcustom elmo-spam-header-good-alist '(("X-Spam-Flag" . "No"))
195 "*Regular expression for positive header good matches."
196 :type '(repeat (cons (string :tag "Header name")
197 (regexp :tag "Regular expression to match good header")))
198 :group 'elmo-spam-header)
200 (defcustom elmo-spam-header-spam-alist '(("X-Spam-Flag" . "Yes"))
201 "*Regular expression for positive header spam matches."
202 :type '(repeat (cons (string :tag "Header name")
203 (regexp :tag "Regular expression to match spam header")))
204 :group 'elmo-spam-header)
206 (defun elmo-spam-header-check-headers (fetch-field-function)
208 (dolist (pair elmo-spam-header-good-alist)
209 (let ((field-body (funcall fetch-field-function (car pair))))
210 (when (and field-body (string-match (cdr pair) field-body))
212 (dolist (pair elmo-spam-header-spam-alist)
213 (let ((field-body (funcall fetch-field-function (car pair))))
214 (when (and field-body (string-match (cdr pair) field-body))
217 (luna-define-method elmo-spam-buffer-spam-p ((processor elsp-header)
218 buffer &optional register)
219 (with-current-buffer buffer
221 (std11-narrow-to-header)
222 (elmo-spam-header-check-headers #'elmo-decoded-field-body))))
224 (luna-define-method elmo-spam-message-spam-p ((processor elsp-header)
225 folder number &optional register)
226 (let ((entity (elmo-message-entity folder number))
230 (elmo-spam-header-check-headers
232 (or (elmo-message-entity-field entity
233 (intern (downcase field-name))
237 (setq buffer (get-buffer-create
238 (generate-new-buffer-name
239 " *elmo-spam-work*")))
241 (elmo-spam-message-fetch folder number)
242 (std11-narrow-to-header))
243 (elmo-decoded-field-body field-name))))))
244 (and buffer (kill-buffer buffer)))))
246 (luna-define-method elmo-spam-register-spam-messages ((processor elsp-header)
250 (elmo-progress-notify 'elmo-spam-register (length numbers)))
252 (luna-define-method elmo-spam-register-good-messages ((processor elsp-header)
256 (elmo-progress-notify 'elmo-spam-register (length numbers)))
258 (provide 'elsp-header)
262 (product-provide (provide 'elmo-spam) (require 'elmo-version))
264 ;;; elmo-spam.el ends here