From: hmurata Date: Mon, 20 Oct 2003 12:34:37 +0000 (+0000) Subject: * wl-spam.el: New file. X-Git-Tag: wl-2_11_20~9 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=75404b9bc7f071d3dc8b9931e81b605367b556b4;p=elisp%2Fwanderlust.git * wl-spam.el: New file. * elmo-split.el (elmo-split-spam-p): New function. * elmo-spam.el: New file. * elsp-bogofilter.el: Ditto. * WL-ELS (WL-MODULES): Added wl-spam. (ELMO-MODULES): Added elmo-spam and elsp-bogofilter. --- diff --git a/ChangeLog b/ChangeLog index c9b32a2..54ecdd9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2003-10-20 Hiroya Murata + + * WL-ELS (WL-MODULES): Added wl-spam. + (ELMO-MODULES): Added elmo-spam and elsp-bogofilter. + 2003-09-22 Yuuichi Teranishi * WL-ELS (ELMO-MODULES): Added modb-entity (again). diff --git a/WL-ELS b/WL-ELS index 9b11151..ab438ba 100644 --- a/WL-ELS +++ b/WL-ELS @@ -11,6 +11,7 @@ wl-vars wl-draft wl-util wl-version wl-address wl-addrmgr wl-highlight wl-demo wl-refile wl-thread wl-fldmgr wl-expire wl-template wl-score wl-acap wl-news + wl-spam )) (defconst ELMO-MODULES '( @@ -22,6 +23,7 @@ elmo-archive elmo-pipe elmo-cache elmo-internal elmo-flag elmo-sendlog elmo-dop elmo-nmz elmo-split + elmo-spam elsp-bogofilter modb modb-entity modb-legacy modb-standard )) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index ccb801f..0046613 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,11 @@ +2003-10-20 Hiroya Murata + + * elmo-split.el (elmo-split-spam-p): New function. + + * elmo-spam.el: New file. + + * elsp-bogofilter.el: Ditto. + 2003-10-15 Yuuichi Teranishi * elmo.el (elmo-folder-next-message-number): New API. diff --git a/elmo/elmo-spam.el b/elmo/elmo-spam.el new file mode 100644 index 0000000..9d3ed38 --- /dev/null +++ b/elmo/elmo-spam.el @@ -0,0 +1,157 @@ +;;; elmo-spam.el --- Spam filtering interface to processor. + +;; Copyright (C) 2003 Hiroya Murata +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Hiroya Murata +;; Keywords: mail, net news, spam + +;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(eval-when-compile (require 'cl)) + +(require 'luna) +(require 'elmo-util) +(require 'elmo) + +(defgroup elmo-spam nil + "Spam configuration for wanderlust." + :group 'elmo) + +(defcustom elmo-spam-scheme nil + "*Scheme of spam processor implementation. " + :type '(choice (const :tag "none" nil) + (const :tag "Bogofilter" bogofilter)) + :group 'elmo-spam) + +(eval-and-compile + (luna-define-class elsp-generic ())) + +;; required method +(luna-define-generic elmo-spam-buffer-spam-p (processor buffer) + "Return non-nil if contents of BUFFER is spam. +PROCESSOR is spam processor structure.") + +(luna-define-generic elmo-spam-register-spam-buffer (processor buffer) + "Register contents of BUFFER as spam. +PROCESSOR is spam processor structure.") + +(luna-define-generic elmo-spam-register-good-buffer (processor buffer) + "Register contents of BUFFER as non spam. +PROCESSOR is spam processor structure.") + +;; optional method +(luna-define-generic elmo-spam-message-spam-p (processor folder number) + "Return non-nil if the message in the FOLDER with NUMBER is spam. +PROCESSOR is spam processor structure.") + +(luna-define-generic elmo-spam-list-spam-messages (processor + folder &optional numbers) + "Return a list of message numbers which is gussed 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, +messages are searched from the list.") + +(luna-define-generic elmo-spam-register-spam-messages (processor + folder &optional numbers) + "Register contents of messages 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, +messages are searched from the list.") + +(luna-define-generic elmo-spam-register-good-messages (processor + folder &optional numbers) + "Register contents of messages as non 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, +messages are searched from the list.") + +;; for internal use +(defun elmo-spam-message-fetch (folder number) + (let (elmo-message-fetch-threshold) + (elmo-message-fetch + folder number + (elmo-find-fetch-strategy folder + (elmo-message-entity folder number)) + nil (current-buffer) 'unread))) + +;; generic implement +(luna-define-method elmo-spam-message-spam-p ((processor elsp-generic) + folder number) + (with-temp-buffer + (elmo-spam-message-fetch folder number) + (elmo-spam-buffer-spam-p processor (current-buffer)))) + +(luna-define-method elmo-spam-list-spam-messages ((processor elsp-generic) + folder &optional numbers) + (let ((numbers (or numbers (elmo-folder-list-messages folder t t))) + spam-list) + (dolist (number numbers) + (when (elmo-spam-message-spam-p processor folder number) + (setq spam-list (cons number spam-list))) + (elmo-progress-notify 'elmo-spam-check-spam)) + (nreverse spam-list))) + +(luna-define-method elmo-spam-register-spam-messages ((processor elsp-generic) + folder &optional numbers) + (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) + (elmo-spam-register-spam-buffer processor (current-buffer)) + (elmo-progress-notify 'elmo-spam-register))))) + +(luna-define-method elmo-spam-register-good-messages ((processor elsp-generic) + folder &optional numbers) + (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) + (elmo-spam-register-good-buffer processor (current-buffer)) + (elmo-progress-notify 'elmo-spam-register))))) + +(provide 'elsp-generic) + +(defvar elmo-spam-processor-internal nil) + +(defun elmo-spam-processor () + (or elmo-spam-processor-internal + (let* ((scheme (or elmo-spam-scheme 'generic)) + (class (intern (format "elsp-%s" scheme)))) + (require class) + (setq elmo-spam-processor-internal + (luna-make-entity class))))) + +(require 'product) +(product-provide (provide 'elmo-spam) (require 'elmo-version)) + +;;; elmo-sapm.el ends here diff --git a/elmo/elmo-split.el b/elmo/elmo-split.el index db175a4..454ee11 100644 --- a/elmo/elmo-split.el +++ b/elmo/elmo-split.el @@ -37,9 +37,14 @@ ;; according to the definition of `elmo-split-rule'. ;; +;;; Code: (require 'elmo) -;;; Code: +(eval-when-compile + ;; Avoid compile warnings + (defun-maybe elmo-spam-processor) + (defun-maybe elmo-spam-buffer-spam-p (processor buffer))) + (defcustom elmo-split-rule nil "Split rule for the command `elmo-split'. The format of this variable is a list of RULEs which has form like: @@ -72,7 +77,11 @@ FIELD-NAME is a symbol of the field name. `or' ... True if one of the argument returns true. `and' ... True if all of the arguments return true. -4. A symbol. +4. Functions which accept not argument. + +`spam-p' ... True if contents of the message is guessed as spam. + +5. A symbol. When a symbol is specified, it is evaluated. @@ -211,6 +220,10 @@ It can be some ACTION as in `elmo-split-rule'." (symbol-name field))))) (equal field-value value)))) +(defun elmo-split-spam-p (buffer) + (require 'elmo-spam) + (elmo-spam-buffer-spam-p (elmo-spam-processor) buffer)) + (defun elmo-split-match (buffer field value) (with-current-buffer buffer (let ((field-value (and elmo-split-message-entity diff --git a/elmo/elsp-bogofilter.el b/elmo/elsp-bogofilter.el new file mode 100644 index 0000000..e3b161f --- /dev/null +++ b/elmo/elsp-bogofilter.el @@ -0,0 +1,111 @@ +;;; elsp-bogofilter.el --- Bogofilter support for elmo-spam. + +;; Copyright (C) 2003 Hiroya Murata +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Hiroya Murata +;; Keywords: mail, net news, spam + +;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; +(require 'elmo-spam) + +(require 'luna) +(require 'path-util) + +(defgroup elmo-spam-bogofilter nil + "Spam bogofilter configuration." + :group 'elmo-spam) + +(defcustom elmo-spam-bogofilter-program (exec-installed-p "bogofilter") + "File path of the Bogofilter executable program." + :type '(choice (file :tag "Location of bogofilter") + (const :tag "Bogofilter is not installed")) + :group 'elmo-spam-bogofilter) + +(defcustom elmo-spam-bogofilter-header "X-Bogosity" + "The header that Bogofilter inserts in messages." + :type 'string + :group 'elmo-spam-bogofilter) + +(defcustom elmo-spam-bogofilter-spam-switch "-s" + "The switch that Bogofilter uses to register spam messages." + :type 'string + :group 'elmo-spam-bogofilter) + +(defcustom elmo-spam-bogofilter-good-switch "-n" + "The switch that Bogofilter uses to register non spam messages." + :type 'string + :group 'elmo-spam-bogofilter) + +(defcustom elmo-spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" + "The regexp on `elmo-spam-bogofilter' for positive spam identification." + :type 'regexp + :group 'elmo-spam-bogofilter) + +(defcustom elmo-spam-bogofilter-database-directory nil + "Directory path of the Bogofilter databases." + :type '(choice (directory :tag "Location of the Bogofilter database directory") + (const :tag "Use the default")) + :group 'elmo-spam-bogofilter) + +(eval-and-compile + (luna-define-class elsp-bogofilter (elsp-generic))) + +(luna-define-method elmo-spam-buffer-spam-p ((processor elsp-bogofilter) + buffer) + (let ((args `("-v" "-2" + ,@(if elmo-spam-bogofilter-database-directory + (list "-d" elmo-spam-bogofilter-database-directory))))) + (with-current-buffer buffer + (= 0 (apply #'call-process-region + (point-min) (point-max) + elmo-spam-bogofilter-program + nil nil nil args))))) + +(defsubst elmo-spam-bogofilter-register-buffer (buffer spam) + (let ((args `("-v" + ,(if spam + elmo-spam-bogofilter-spam-switch + elmo-spam-bogofilter-good-switch) + ,@(if elmo-spam-bogofilter-database-directory + (list "-d" elmo-spam-bogofilter-database-directory))))) + (with-current-buffer buffer + (apply #'call-process-region + (point-min) (point-max) + elmo-spam-bogofilter-program + nil nil nil args)))) + +(luna-define-method elmo-spam-register-spam-buffer ((processor elsp-bogofilter) + buffer) + (elmo-spam-bogofilter-register-buffer buffer t)) + +(luna-define-method elmo-spam-register-good-buffer ((processor elsp-bogofilter) + buffer) + (elmo-spam-bogofilter-register-buffer buffer nil)) + +(require 'product) +(product-provide (provide 'elsp-bogofilter) (require 'elmo-version)) + +;;; elsp-bogofilter.el ends here diff --git a/samples/ja/dot.wl b/samples/ja/dot.wl index 65b2372..e0d8c04 100644 --- a/samples/ja/dot.wl +++ b/samples/ja/dot.wl @@ -367,4 +367,53 @@ ;; ません。nil ですべてのメッセージが対象になります。 ;(setq wl-summary-auto-refile-skip-marks nil) +;;; [[ spam 用の設定 ]] + +;; バックエンドに bogofilter を使う事を設定 +;(setq elmo-spam-scheme 'bogofilter) + +;(require 'wl-spam) + +;; サマリバッファで `o' (wl-summary-refile) した時, *最初*に spam かど +;; うかを判定する様にする +;(unless (memq 'wl-refile-guess-by-spam wl-refile-guess-functions) +; (setq wl-refile-guess-functions +; (cons #'wl-refile-guess-by-spam +; wl-refile-guess-functions))) + +;; サマリバッファで `C-o' (wl-summary-auto-refile) した時, *最初*に +;; spam かどうかを判定する様にする +;(unless (memq 'wl-refile-guess-by-spam wl-auto-refile-guess-functions) +; (setq wl-auto-refile-guess-functions +; (cons #'wl-refile-guess-by-spam +; wl-auto-refile-guess-functions))) + +;; refile-rule を優先したい場合 (spamfilter-wl.el や bogofilter-wl.el +;; と同じ設定) は, こっちの設定を有効にする +;(unless (memq 'wl-refile-guess-by-spam wl-auto-refile-guess-functions) +; (setq wl-auto-refile-guess-functions +; (append wl-auto-refile-guess-functions +; '(wl-refile-guess-by-spam)))) + +;; wl-spam-auto-check-policy-alist の設定に従って各サマリに移動した時 +;; に spam かどうかチェックする +;(add-hook 'wl-summary-prepared-pre-hook #'wl-summary-auto-check-spam) + +;; +inbox に入った時, spam と判定されたメッセージにリファイルマークを +;; 付ける場合の設定 +;(setq wl-spam-auto-check-policy-alist '(("\\+inbox" . refile))) + +;; refile の実行時に学習させる為の設定 +;; 以下の設定をしたからと言って常に学習する訳ではありません. 詳しくは, +;; wl-spam.el の wl-spam-undecided-folder-regexp-list と +;; wl-spam-ignored-folder-regexp-list の docstring を参照して下さい. +;(let ((actions wl-summary-mark-action-list) +; action) +; (while actions +; (setq action (car actions) +; actions (cdr actions)) +; (when (eq (wl-summary-action-symbol action) 'refile) +; (setf (nth 4 action) 'wl-summary-exec-action-refile-with-register) +; (setq actions nil)))) + ;;; dot.wl ends here diff --git a/wl/ChangeLog b/wl/ChangeLog index 16ff9e0..0ae9c07 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,9 @@ 2003-10-20 Hiroya Murata + * wl-spam.el: New file. + +2003-10-20 Hiroya Murata + * wl-refile.el (wl-refile-guess): Added second argument `functions'. * wl-action.el (wl-auto-refile-guess-functions): New variable. diff --git a/wl/wl-spam.el b/wl/wl-spam.el new file mode 100644 index 0000000..9d0fbde --- /dev/null +++ b/wl/wl-spam.el @@ -0,0 +1,194 @@ +;;; wl-spam.el --- Spam filtering interface for Wanderlust. + +;; Copyright (C) 2003 Hiroya Murata +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Hiroya Murata +;; Keywords: mail, net news, spam + +;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(eval-when-compile (require 'cl)) + +(require 'elmo-spam) +(require 'wl-summary) +(require 'wl-action) + +(defgroup wl-spam nil + "Spam configuration for wanderlust." + :group 'wl) + +(defcustom wl-spam-folder-name "+spam" + "*Spam folder." + :type 'string + :group 'wl-spam) + +(defcustom wl-spam-undecided-folder-regexp-list '("inbox") + "*List of folder regexp which is contained undecided domain." + :type '(repeat (regexp :tag "Folder Regexp")) + :group 'wl-spam) + +(defcustom wl-spam-ignored-folder-regexp-list + (list (regexp-opt (list wl-draft-folder + wl-trash-folder + wl-queue-folder))) + "*List of folder regexp which is contained ignored domain." + :type '(repeat (regexp :tag "Folder Regexp")) + :group 'wl-spam) + +(defcustom wl-spam-auto-check-policy-alist '(("inbox" . mark)) + "*Alist of Folder regexp which check spam automatically and policy." + :type '(repeat (cons (regexp :tag "Folder Regexp") + (choice (const :tag "Target mark" mark) + (const :tag "Refile mark" refile) + (const :tag "none" nil)))) + :group 'wl-spam) + + +(defun wl-spam-folder-guess-domain (folder-name) + (cond ((string= folder-name wl-spam-folder-name) + 'spam) + ((wl-string-match-member folder-name + wl-spam-undecided-folder-regexp-list) + 'undecided) + ((wl-string-match-member folder-name + wl-spam-ignored-folder-regexp-list) + 'ignore) + (t + 'good))) + +(defsubst wl-spam-map-spam-messages (folder numbers function &rest args) + (let ((total (length numbers))) + (elmo-with-progress-display (> total elmo-display-progress-threshold) + (elmo-spam-check-spam total "Checking spam...") + (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor) + folder + numbers)) + (apply function number args))) + (message "Checking spam...done"))) + +;; insinuate into summary mode +(defvar wl-summary-spam-map nil) + +(unless wl-summary-spam-map + (let ((map (make-sparse-keymap))) + (define-key map "*" 'wl-summary-target-mark-spam) + (define-key map "o" 'wl-summary-refile-spam) + (define-key map "s" 'wl-summary-register-as-spam) + (define-key map "S" 'wl-summary-register-as-spam-all) + (define-key map "n" 'wl-summary-register-as-good) + (define-key map "N" 'wl-summary-register-as-good-all) + (setq wl-summary-spam-map map) + (define-key wl-summary-mode-map "k" wl-summary-spam-map))) + +(eval-when-compile + ;; Avoid compile warnings + (defalias-maybe 'wl-summary-target-mark 'ignore) + (defalias-maybe 'wl-summary-refile-mark 'ignore)) + +(defun wl-summary-target-mark-spam (&optional folder) + "Set target mark to messages which is guessed spam in FOLDER." + (interactive) + (wl-spam-map-spam-messages (or folder wl-summary-buffer-elmo-folder) + wl-summary-buffer-number-list + #'wl-summary-target-mark)) + +(defun wl-summary-refile-spam (&optional folder) + "Set refile mark to messages which is guessed spam in FOLDER." + (interactive) + (wl-spam-map-spam-messages (or folder wl-summary-buffer-elmo-folder) + wl-summary-buffer-number-list + #'wl-summary-refile + wl-spam-folder-name)) + +(defun wl-summary-register-as-spam (&optional all) + (interactive "P") + (let ((numbers (if all + wl-summary-buffer-number-list + (list (wl-summary-message-number))))) + (elmo-spam-register-spam-messages (elmo-spam-processor) + wl-summary-buffer-elmo-folder + numbers))) + +(defun wl-summary-register-as-spam-all () + (interactive) + (wl-summary-register-as-spam 'all)) + +(defun wl-summary-register-as-good (&optional all) + (interactive "P") + (let ((numbers (if all + wl-summary-buffer-number-list + (list (wl-summary-message-number))))) + (elmo-spam-register-good-messages (elmo-spam-processor) + wl-summary-buffer-elmo-folder + numbers))) + +(defun wl-summary-register-as-good-all () + (interactive) + (wl-summary-register-as-good 'all)) + +;; hook functions and other +(defun wl-summary-auto-check-spam () + (case (cdr (elmo-string-matched-assoc (wl-summary-buffer-folder-name) + wl-spam-auto-check-policy-alist)) + (mark + (wl-summary-target-mark-spam)) + (refile + (wl-summary-refile-spam)))) + +(defun wl-summary-exec-action-refile-with-register (mark-list) + (let ((processor (elmo-spam-processor)) + (folder wl-summary-buffer-elmo-folder) + spam-list good-list) + (when (eq (wl-spam-folder-guess-domain + (elmo-folder-name-internal folder)) + 'undecided) + (dolist (info mark-list) + (case (wl-spam-folder-guess-domain (nth 2 info)) + (spam + (setq spam-list (cons (car info) spam-list))) + (good + (setq good-list (cons (car info) good-list))))) + (let ((total (+ (length spam-list) (length good-list)))) + (elmo-with-progress-display (> total elmo-display-progress-threshold) + (elmo-spam-register total "Register spam...") + (when spam-list + (elmo-spam-register-spam-messages processor folder spam-list)) + (when good-list + (elmo-spam-register-good-messages processor folder good-list))) + (message "Register spam...done"))) + ;; execute refile messages + (wl-summary-exec-action-refile mark-list))) + +(defun wl-refile-guess-by-spam (entity) + (when (elmo-spam-message-spam-p (elmo-spam-processor) + wl-summary-buffer-elmo-folder + (elmo-message-entity-number entity)) + wl-spam-folder-name)) + +(require 'product) +(product-provide (provide 'wl-spam) (require 'wl-version)) + +;;; wl-sapm.el ends here