elmo/elmo-spam.el

   1 ;;; elmo-spam.el --- Spam filtering interface to processor.
   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
  33 (eval-when-compile (require 'cl))
  34
  35 (require 'luna)
  36 (require 'elmo-util)
  37 (require 'elmo)
  38
  39 (defgroup elmo-spam nil
  40   "Spam configuration for wanderlust."
  41   :group 'elmo)
  42
  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))
  51   :group 'elmo-spam)
  52
  53 (eval-and-compile
  54   (luna-define-class elsp-generic ()))
  55
  56 ;; required method
  57 (luna-define-generic elmo-spam-buffer-spam-p (processor buffer
  58                                                         &optional register)
  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.")
  63
  64 (luna-define-generic elmo-spam-register-spam-buffer (processor
  65                                                      buffer
  66                                                      &optional restore)
  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.")
  70
  71 (luna-define-generic elmo-spam-register-good-buffer (processor
  72                                                      buffer
  73                                                      &optional restore)
  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.")
  77
  78 ;; optional method
  79 (luna-define-generic elmo-spam-modified-p (processor)
  80   "Return non-nil if status of PROCESSOR is modified.")
  81
  82 (luna-define-generic elmo-spam-save-status (processor)
  83   "Save status of the PROCESSOR.")
  84
  85 (luna-define-generic elmo-spam-message-spam-p (processor folder number
  86                                                          &optional register)
  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.")
  91
  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.")
  99
 100 (luna-define-generic elmo-spam-register-spam-messages (processor
 101                                                        folder
 102                                                        &optional
 103                                                        numbers restore)
 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.")
 110
 111 (luna-define-generic elmo-spam-register-good-messages (processor
 112                                                        folder
 113                                                        &optional
 114                                                        numbers restore)
 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.")
 121
 122 ;; for internal use
 123 (defun elmo-spam-message-fetch (folder number)
 124   (let (elmo-message-fetch-threshold)
 125     (when enable-multibyte-characters
 126       (set-buffer-multibyte nil))
 127     (elmo-message-fetch
 128      folder number
 129      (elmo-find-fetch-strategy folder number nil 'entire)
 130      'unread)))
 131
 132 (defun elmo-spam-process-messages-as-mbox (folder numbers number-per-process
 133                                                   function &rest args)
 134   (with-temp-buffer
 135     (while numbers
 136       (let ((count 0))
 137         (while (and numbers (< count number-per-process))
 138           (insert "From MAILER-DAEMON@example.com\n")
 139           (let ((begin (point)))
 140             (insert
 141              (with-temp-buffer
 142                (elmo-spam-message-fetch folder (car numbers))
 143                (buffer-string)))
 144             (goto-char begin)
 145             (while (re-search-forward "^>*From " nil t)
 146               (goto-char (match-beginning 0))
 147               (insert ?>)
 148               (forward-line))
 149             (goto-char (point-max))
 150             (insert "\n\n"))
 151           (setq count (1+ count)
 152                 numbers (cdr numbers)))
 153         (apply function count args)
 154         (erase-buffer)))))
 155
 156 ;; generic implement
 157 (luna-define-method elmo-spam-message-spam-p ((processor elsp-generic)
 158                                               folder number &optional register)
 159   (with-temp-buffer
 160     (elmo-spam-message-fetch folder number)
 161     (elmo-spam-buffer-spam-p processor (current-buffer) register)))
 162
 163 (luna-define-method elmo-spam-list-spam-messages ((processor elsp-generic)
 164                                                   folder &optional numbers)
 165   (let ((numbers (or numbers (elmo-folder-list-messages folder t t)))
 166         spam-list)
 167     (dolist (number numbers)
 168       (when (elmo-spam-message-spam-p processor folder number)
 169         (setq spam-list (cons number spam-list)))
 170       (elmo-progress-notify 'elmo-spam-check-spam))
 171     (nreverse spam-list)))
 172
 173 (luna-define-method elmo-spam-register-spam-messages ((processor elsp-generic)
 174                                                       folder
 175                                                       &optional
 176                                                       numbers restore)
 177   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
 178     (with-temp-buffer
 179       (dolist (number numbers)
 180         (erase-buffer)
 181         (elmo-spam-message-fetch folder number)
 182         (elmo-spam-register-spam-buffer processor (current-buffer) restore)
 183         (elmo-progress-notify 'elmo-spam-register)))))
 184
 185 (luna-define-method elmo-spam-register-good-messages ((processor elsp-generic)
 186                                                       folder
 187                                                       &optional
 188                                                       numbers restore)
 189   (let ((numbers (or numbers (elmo-folder-list-messages folder t t))))
 190     (with-temp-buffer
 191       (dolist (number numbers)
 192         (erase-buffer)
 193         (elmo-spam-message-fetch folder number)
 194         (elmo-spam-register-good-buffer processor (current-buffer) restore)
 195         (elmo-progress-notify 'elmo-spam-register)))))
 196
 197 (provide 'elsp-generic)
 198
 199 (defvar elmo-spam-processor-internal nil)
 200
 201 (defun elmo-spam-processor (&optional if-exists)
 202   (or elmo-spam-processor-internal
 203       (unless if-exists
 204         (let* ((scheme (or elmo-spam-scheme 'generic))
 205                (class (intern (format "elsp-%s" scheme))))
 206           (require class)
 207           (setq elmo-spam-processor-internal
 208                 (luna-make-entity class))))))
 209
 210 ;; Backend for header match
 211 (eval-and-compile
 212   (luna-define-class elsp-header (elsp-generic)))
 213
 214 (defgroup elmo-spam-header nil
 215   "Spam header configuration."
 216   :group 'elmo-spam)
 217
 218 (defcustom elmo-spam-header-good-alist '(("X-Spam-Flag" . "No"))
 219   "*Regular expression for positive header good matches."
 220   :type '(repeat (cons (string :tag "Header name")
 221                        (regexp :tag "Regular expression to match good header")))
 222   :group 'elmo-spam-header)
 223
 224 (defcustom elmo-spam-header-spam-alist '(("X-Spam-Flag" . "Yes"))
 225   "*Regular expression for positive header spam matches."
 226   :type '(repeat (cons (string :tag "Header name")
 227                        (regexp :tag "Regular expression to match spam header")))
 228   :group 'elmo-spam-header)
 229
 230 (defun elmo-spam-header-check-headers (fetch-field-function)
 231   (catch 'done
 232     (dolist (pair elmo-spam-header-good-alist)
 233       (let ((field-body (funcall fetch-field-function (car pair))))
 234         (when (and field-body (string-match (cdr pair) field-body))
 235           (throw 'done nil))))
 236     (dolist (pair elmo-spam-header-spam-alist)
 237       (let ((field-body (funcall fetch-field-function (car pair))))
 238         (when (and field-body (string-match (cdr pair) field-body))
 239           (throw 'done t))))))
 240
 241 (luna-define-method elmo-spam-buffer-spam-p ((processor elsp-header)
 242                                              buffer &optional register)
 243   (with-current-buffer buffer
 244     (save-restriction
 245       (std11-narrow-to-header)
 246       (elmo-spam-header-check-headers #'elmo-decoded-field-body))))
 247
 248 (luna-define-method elmo-spam-message-spam-p ((processor elsp-header)
 249                                               folder number &optional register)
 250   (let ((entity (elmo-message-entity folder number))
 251         buffer)
 252     (unwind-protect
 253         (save-excursion
 254           (elmo-spam-header-check-headers
 255            (lambda (field-name)
 256              (or (elmo-message-entity-field entity
 257                                             (intern (downcase field-name))
 258                                             'string)
 259                  (progn
 260                    (unless buffer
 261                      (setq buffer (get-buffer-create
 262                                    (generate-new-buffer-name
 263                                     " *elmo-spam-work*")))
 264                      (set-buffer buffer)
 265                      (elmo-spam-message-fetch folder number)
 266                      (std11-narrow-to-header))
 267                    (elmo-decoded-field-body field-name))))))
 268       (and buffer (kill-buffer buffer)))))
 269
 270 (luna-define-method elmo-spam-register-spam-messages ((processor elsp-header)
 271                                                       folder
 272                                                       &optional
 273                                                       numbers restore)
 274   (elmo-progress-notify 'elmo-spam-register (length numbers)))
 275
 276 (luna-define-method elmo-spam-register-good-messages ((processor elsp-header)
 277                                                       folder
 278                                                       &optional
 279                                                       numbers restore)
 280   (elmo-progress-notify 'elmo-spam-register (length numbers)))
 281
 282 (provide 'elsp-header)
 283
 284
 285 (require 'product)
 286 (product-provide (provide 'elmo-spam) (require 'elmo-version))
 287
 288 ;;; elmo-spam.el ends here