elmo/elsp-bogofilter.el

   1 ;;; elsp-bogofilter.el --- Bogofilter support for elmo-spam.
   2
   3 ;; Copyright (C) 2003 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   4 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news, spam
   8
   9 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  10
  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)
  14 ;; any later version.
  15 ;;
  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.
  20 ;;
  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.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32 (require 'elmo-spam)
  33 (require 'luna)
  34
  35 (defgroup elmo-spam-bogofilter nil
  36   "Spam bogofilter configuration."
  37   :group 'elmo-spam)
  38
  39 (defcustom elmo-spam-bogofilter-program "bogofilter"
  40   "*Program name of the Bogofilter."
  41   :type '(string :tag "Program name of the bogofilter")
  42   :group 'elmo-spam-bogofilter)
  43
  44 (defcustom elmo-spam-bogofilter-args nil
  45   "*Argument list for bogofilter."
  46   :type '(repeat string)
  47   :group 'elmo-spam-bogofilter)
  48
  49 (defcustom elmo-spam-bogofilter-database-directory nil
  50   "*Directory path of the Bogofilter databases."
  51   :type '(choice (directory :tag "Location of the Bogofilter database directory")
  52                  (const :tag "Use the default"))
  53   :group 'elmo-spam-bogofilter)
  54
  55 (defcustom elmo-spam-bogofilter-max-messages-per-process 30
  56   "Number of messages processed at once."
  57   :type 'integer
  58   :group 'elmo-spam-bogofilter)
  59
  60 (defcustom elmo-spam-bogofilter-arguments-alist
  61   '((classify
  62      (if elmo-spam-bogofilter-debug "-vv")
  63      (if register "-u")
  64      (if elmo-spam-bogofilter-database-directory
  65          (list "-d" elmo-spam-bogofilter-database-directory)))
  66     (register
  67      (if elmo-spam-bogofilter-debug "-vv")
  68      (if spam "-s" "-n")
  69      (if restore (if spam "-N" "-S"))
  70      (if elmo-spam-bogofilter-database-directory
  71          (list "-d" elmo-spam-bogofilter-database-directory))))
  72   "*An alist of options that are used with call bogofilter process.
  73 Each element is a list of following:
  74 \(TYPE [SEXP...])
  75 TYPE is a symbol from `classify' or `register'.
  76 SEXP is an expression to get options.
  77 Must be return a string or list of string."
  78   :type '(repeat (cons (choice (const :tag "Classify" classify)
  79                                (const :tag "Register" register))
  80                        (repeat sexp)))
  81   :group 'elmo-spam-bogofilter)
  82
  83 (defcustom elmo-spam-bogofilter-debug nil
  84   "Non-nil to debug elmo bogofilter spam backend."
  85   :type 'boolean
  86   :group 'elmo-spam-bogofilter)
  87
  88
  89 (eval-and-compile
  90   (luna-define-class elsp-bogofilter (elsp-generic)))
  91
  92 (defsubst elmo-spam-bogofilter-call (&optional args)
  93   (apply #'call-process-region
  94          (point-min) (point-max)
  95          elmo-spam-bogofilter-program
  96          nil (if elmo-spam-bogofilter-debug
  97                  (get-buffer-create "*Debug ELMO SPAM Bogofilter*"))
  98          nil
  99          (append elmo-spam-bogofilter-args
 100                  (delq nil args))))
 101
 102 (defmacro elmo-spam-bogofilter-arguments (type)
 103   `(elmo-flatten
 104     (mapcar #'eval
 105             (cdr (assq ,type elmo-spam-bogofilter-arguments-alist)))))
 106
 107 (luna-define-method elmo-spam-buffer-spam-p ((processor elsp-bogofilter)
 108                                              buffer &optional register)
 109   (with-current-buffer buffer
 110     (= 0 (elmo-spam-bogofilter-call
 111           (elmo-spam-bogofilter-arguments 'classify)))))
 112
 113 (defsubst elsp-bogofilter-register-buffer (buffer spam restore)
 114   (with-current-buffer buffer
 115     (elmo-spam-bogofilter-call
 116      (elmo-spam-bogofilter-arguments 'register))))
 117
 118 (luna-define-method elmo-spam-register-spam-buffer ((processor elsp-bogofilter)
 119                                                     buffer &optional restore)
 120   (elsp-bogofilter-register-buffer buffer t restore))
 121
 122 (luna-define-method elmo-spam-register-good-buffer ((processor elsp-bogofilter)
 123                                                     buffer &optional restore)
 124   (elsp-bogofilter-register-buffer buffer nil restore))
 125
 126 (defsubst elmo-spam-bogofilter-register-messages (folder numbers spam restore)
 127   (if (not (< 0 elmo-spam-bogofilter-max-messages-per-process))
 128       (error "\
 129 non-positive value for `elmo-spam-bogofilter-max-messages-per-process'"))
 130   (with-temp-buffer
 131     (while numbers
 132       (let ((count 0))
 133         (while (and numbers
 134                     (< count elmo-spam-bogofilter-max-messages-per-process))
 135           (insert "From MAILER-DAEMON\n"
 136                   (with-temp-buffer
 137                     (elmo-spam-message-fetch folder (car numbers))
 138                     (goto-char (point-min))
 139                     (while (re-search-forward "^>*From " nil t)
 140                       (goto-char (match-beginning 0))
 141                       (insert ?>)
 142                       (forward-line))
 143                     (buffer-substring (point-min) (point-max)))
 144                   "\n\n")
 145           (setq count (1+ count)
 146                 numbers (cdr numbers)))
 147         (elsp-bogofilter-register-buffer (current-buffer) spam restore)
 148         (elmo-progress-notify 'elmo-spam-register count)
 149         (erase-buffer)))))
 150
 151 (luna-define-method elmo-spam-register-spam-messages :around
 152   ((processor elsp-bogofilter) folder &optional numbers restore)
 153   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
 154     (if (> (length numbers) 1)
 155         (elmo-spam-bogofilter-register-messages folder numbers t restore)
 156       (luna-call-next-method))))
 157
 158 (luna-define-method elmo-spam-register-good-messages :around
 159   ((processor elsp-bogofilter) folder &optional numbers restore)
 160   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
 161     (if (> (length numbers) 1)
 162         (elmo-spam-bogofilter-register-messages folder numbers nil restore)
 163       (luna-call-next-method))))
 164
 165 (require 'product)
 166 (product-provide (provide 'elsp-bogofilter) (require 'elmo-version))
 167
 168 ;;; elsp-bogofilter.el ends here