elmo/elsp-bsfilter.el

   1 ;;; elsp-bsfilter.el --- Bsfilter support for elmo-spam.
   2
   3 ;; Copyright (C) 2004 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   4 ;; Copyright (C) 2004 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-bsfilter nil
  36   "Spam bsfilter configuration."
  37   :group 'elmo-spam)
  38
  39 (defcustom elmo-spam-bsfilter-shell-program "ruby"
  40   "*"
  41   :type 'string
  42   :group 'elmo-spam-bsfilter)
  43
  44 (defcustom elmo-spam-bsfilter-shell-switch nil
  45   "*"
  46   :type 'string
  47   :group 'elmo-spam-bsfilter)
  48
  49 (defcustom elmo-spam-bsfilter-program (exec-installed-p "bsfilter")
  50   "*Program name of the Bsfilter."
  51   :type '(string :tag "Program name of the bsfilter")
  52   :group 'elmo-spam-bsfilter)
  53
  54 (defcustom elmo-spam-bsfilter-args nil
  55   "*Argument list for bsfilter."
  56   :type '(repeat string)
  57   :group 'elmo-spam-bsfilter)
  58
  59 (defcustom elmo-spam-bsfilter-update-switch "--auto-update"
  60   "*The switch that Bsfilter uses to update database with classify."
  61   :type 'string
  62   :group 'elmo-spam-bsfilter)
  63
  64 (defcustom elmo-spam-bsfilter-database-directory nil
  65   "*Directory path of the Bsfilter databases."
  66   :type '(choice (directory :tag "Location of the Bsfilter database directory")
  67                  (const :tag "Use the default"))
  68   :group 'elmo-spam-bsfilter)
  69
  70 (defcustom elmo-spam-bsfilter-max-files-per-process 100
  71   "Number of files processed at once."
  72   :type 'integer
  73   :group 'elmo-spam-bsfilter)
  74
  75 (defcustom elmo-spam-bsfilter-max-messages-per-process 30
  76   "Number of messages processed at once."
  77   :type 'integer
  78   :group 'elmo-spam-bsfilter)
  79
  80 (defcustom elmo-spam-bsfilter-use-remote
  81   (and elmo-spam-bsfilter-shell-program
  82        (let ((program (file-name-nondirectory
  83                        elmo-spam-bsfilter-shell-program))
  84              (remote-shells '("ssh" "rsh")))
  85          (catch 'found
  86            (dolist (shell remote-shells)
  87              (when (string-match (concat "\\`" shell) program)
  88                (throw 'found t)))
  89            nil)))
  90   "*Non-nil disables local file feature."
  91   :type 'boolean
  92   :group 'elmo-spam-bsfilter)
  93
  94 (defcustom elmo-spam-bsfilter-debug nil
  95   "Non-nil to debug elmo bsfilter spam backend."
  96   :type 'boolean
  97   :group 'elmo-spam-bsfilter)
  98
  99 (eval-and-compile
 100   (luna-define-class elsp-bsfilter (elsp-generic)))
 101
 102 (defsubst elsp-bsfilter-call-bsfilter (&rest args)
 103   (apply #'call-process-region
 104          (point-min) (point-max)
 105          elmo-spam-bsfilter-shell-program
 106          nil (if elmo-spam-bsfilter-debug
 107                  (get-buffer-create "*Debug ELMO Bsfilter*"))
 108          nil
 109          (append (if elmo-spam-bsfilter-shell-switch
 110                      (list elmo-spam-bsfilter-shell-switch))
 111                  (if elmo-spam-bsfilter-program
 112                      (list elmo-spam-bsfilter-program))
 113                  elmo-spam-bsfilter-args
 114                  (if elmo-spam-bsfilter-database-directory
 115                      (list "--homedir" elmo-spam-bsfilter-database-directory))
 116                  (elmo-flatten args))))
 117
 118 (luna-define-method elmo-spam-buffer-spam-p ((processor elsp-bsfilter)
 119                                              buffer &optional register)
 120   (with-current-buffer buffer
 121     (= 0 (elsp-bsfilter-call-bsfilter
 122           (if register elmo-spam-bsfilter-update-switch)))))
 123
 124 (defun elsp-bsfilter-list-spam-filter (process output)
 125   (when (buffer-live-p (process-buffer process))
 126     (with-current-buffer (process-buffer process)
 127       (save-excursion
 128         (goto-char (process-mark process))
 129         (insert output)
 130         (set-marker (process-mark process) (point)))
 131       (while (re-search-forward "^combined probability.+\r?\n" nil t)
 132         (delete-region (match-beginning 0) (match-end 0))
 133         (elmo-progress-notify 'elmo-spam-check-spam))
 134       (when elmo-spam-bsfilter-debug
 135         (with-current-buffer (get-buffer-create "*Debug ELMO Bsfilter*")
 136           (goto-char (point-max))
 137           (insert output))))))
 138
 139 (defsubst elsp-bsfilter-start-list-spam (targets)
 140   (let ((process
 141          (apply #'start-process
 142                 "elsp-bsfilter"
 143                 (current-buffer)
 144                 elmo-spam-bsfilter-shell-program
 145                 (append (if elmo-spam-bsfilter-shell-switch
 146                             (list elmo-spam-bsfilter-shell-switch))
 147                         (if elmo-spam-bsfilter-program
 148                             (list elmo-spam-bsfilter-program))
 149                         elmo-spam-bsfilter-args
 150                         (list "--list-spam")
 151                         (if elmo-spam-bsfilter-database-directory
 152                             (list "--homedir"
 153                                   elmo-spam-bsfilter-database-directory))
 154                         targets))))
 155     (set-process-filter process #'elsp-bsfilter-list-spam-filter)
 156     process))
 157
 158 (defsubst elsp-bsfilter-read-list-spam (results hash)
 159   (goto-char (point-min))
 160   (while (not (eobp))
 161     (let* ((filename (buffer-substring (point) (save-excursion
 162                                                  (end-of-line)
 163                                                  (point))))
 164            (number (elmo-get-hash-val filename hash)))
 165       (when number
 166         (setq results (cons number results)))
 167       (forward-line)))
 168   results)
 169
 170 (luna-define-method elmo-spam-list-spam-messages :around
 171   ((processor elsp-bsfilter) folder &optional numbers)
 172   (if (or elmo-spam-bsfilter-use-remote
 173           (not (elmo-folder-message-file-p folder)))
 174       (luna-call-next-method)
 175     (let* ((nth-of-targets (1- (or elmo-spam-bsfilter-max-files-per-process
 176                                    100)))
 177            (numbers (or numbers (elmo-folder-list-messages folder t t)))
 178            (hash (elmo-make-hash (length numbers)))
 179            (targets (mapcar
 180                      (lambda (number)
 181                        (let ((filename (elmo-message-file-name folder number)))
 182                          (elmo-set-hash-val filename number hash)
 183                          filename))
 184                      numbers))
 185            results)
 186       (with-temp-buffer
 187         (while targets
 188           (let* ((last (nthcdr nth-of-targets targets))
 189                  (next (cdr last)))
 190             (when last
 191               (setcdr last nil))
 192             (let ((process (elsp-bsfilter-start-list-spam targets)))
 193               (while (memq (process-status process) '(open run))
 194                 (accept-process-output process 1))
 195               (setq results (elsp-bsfilter-read-list-spam results hash)))
 196             (erase-buffer)
 197             (setq targets next))))
 198       results)))
 199
 200
 201 (defsubst elsp-bsfilter-register-buffer (buffer spam restore &optional mbox)
 202   (with-current-buffer buffer
 203     (elsp-bsfilter-call-bsfilter
 204      "--update"
 205      (if restore (if spam "--sub-clean" "--sub-spam"))
 206      (if spam "--add-spam" "--add-clean")
 207      (if mbox "--mbox"))))
 208
 209 (luna-define-method elmo-spam-register-spam-buffer ((processor elsp-bsfilter)
 210                                                     buffer &optional restore)
 211   (elsp-bsfilter-register-buffer buffer t restore))
 212
 213 (luna-define-method elmo-spam-register-good-buffer ((processor elsp-bsfilter)
 214                                                     buffer &optional restore)
 215   (elsp-bsfilter-register-buffer buffer nil restore))
 216
 217 (defsubst elmo-spam-bsfilter-register-messages (folder numbers spam restore)
 218   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
 219     (if (and (> (length numbers) 1)
 220              elmo-spam-bsfilter-max-messages-per-process
 221              (> elmo-spam-bsfilter-max-messages-per-process 0))
 222         (elmo-spam-process-messages-as-mbox
 223          folder numbers
 224          elmo-spam-bsfilter-max-messages-per-process
 225          (lambda (count spam restore)
 226            (elsp-bsfilter-register-buffer (current-buffer) spam restore 'mbox)
 227            (elmo-progress-notify 'elmo-spam-register count))
 228          spam restore)
 229       (luna-call-next-method))))
 230
 231 (luna-define-method elmo-spam-register-spam-messages :around
 232   ((processor elsp-bsfilter) folder &optional numbers restore)
 233   (elmo-spam-bsfilter-register-messages folder numbers t restore))
 234
 235 (luna-define-method elmo-spam-register-good-messages :around
 236   ((processor elsp-bsfilter) folder &optional numbers restore)
 237   (elmo-spam-bsfilter-register-messages folder numbers nil restore))
 238
 239 (require 'product)
 240 (product-provide (provide 'elsp-bsfilter) (require 'elmo-version))
 241
 242 ;;; elsp-bsfilter.el ends here