cgit.sxemacs.org Git - gnus/blob - lisp/spam-stat.el

   1 ;;; spam-stat.el --- detecting spam based on statistics
   2
   3 ;; Copyright (C) 2002  Alex Schroeder
   4
   5 ;; Author: Alex Schroeder <alex@gnu.org>
   6 ;; Maintainer: Alex Schroeder <alex@gnu.org>
   7 ;; Version: 0.3.4
   8 ;; Keywords: spam filtering gnus
   9 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
  10
  11 ;; This file is NOT part of GNU Emacs.
  12
  13 ;; This is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This implements spam analysis according to Paul Graham in "A Plan
  31 ;; for Spam".  The basis for all this is a statistical distribution of
  32 ;; words for your spam and non-spam mails.  We need this information
  33 ;; in a hash-table so that the analysis can use the information when
  34 ;; looking at your mails.  Therefore, before you begin, you need tons
  35 ;; of mails (Graham uses 4000 non-spam and 4000 spam mails for his
  36 ;; experiments).
  37 ;;
  38 ;; The main interface to using spam-stat, are the following functions:
  39 ;;
  40 ;; `spam-stat-buffer-is-spam' -- called in a buffer, that buffer is
  41 ;; considered to be a new spam mail; use this for new mail that has
  42 ;; not been processed before
  43 ;;
  44 ;; `spam-stat-buffer-is-no-spam' -- called in a buffer, that buffer
  45 ;; is considered to be a new non-spam mail; use this for new mail that
  46 ;; has not been processed before
  47 ;;
  48 ;; `spam-stat-buffer-change-to-spam' -- called in a buffer, that
  49 ;; buffer is no longer considered to be normal mail but spam; use this
  50 ;; to change the status of a mail that has already been processed as
  51 ;; non-spam
  52 ;;
  53 ;; `spam-stat-buffer-change-to-non-spam' -- called in a buffer, that
  54 ;; buffer is no longer considered to be spam but normal mail; use this
  55 ;; to change the status of a mail that has already been processed as
  56 ;; spam
  57 ;;
  58 ;; `spam-stat-save' -- save the hash table to the file; the filename
  59 ;; used is stored in the variable `spam-stat-file'
  60 ;;
  61 ;; `spam-stat-load' -- load the hash table from a file; the filename
  62 ;; used is stored in the variable `spam-stat-file'
  63 ;;
  64 ;; `spam-stat-score-word' -- return the spam score for a word
  65 ;;
  66 ;; `spam-stat-score-buffer' -- return the spam score for a buffer
  67 ;;
  68 ;; `spam-stat-split-fancy' -- for fancy mail splitting; add
  69 ;; the rule (: spam-stat-split-fancy) to `nnmail-split-fancy'
  70 ;;
  71 ;; This requires the following in your ~/.gnus file:
  72 ;;
  73 ;; (require 'spam-stat)
  74 ;; (spam-stat-load)
  75
  76 ;;; Testing:
  77
  78 ;; Typical test will involve calls to the following functions:
  79 ;;
  80 ;; Reset: (setq spam-stat (make-hash-table :test 'equal))
  81 ;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
  82 ;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
  83 ;; Save table: (spam-stat-save)
  84 ;; File size: (nth 7 (file-attributes spam-stat-file))
  85 ;; Number of words: (hash-table-count spam-stat)
  86 ;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
  87 ;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
  88 ;; Reduce table size: (spam-stat-reduce-size)
  89 ;; Save table: (spam-stat-save)
  90 ;; File size: (nth 7 (file-attributes spam-stat-file))
  91 ;; Number of words: (hash-table-count spam-stat)
  92 ;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
  93 ;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
  94
  95 ;;; Dictionary Creation:
  96
  97 ;; Typically, you will filter away mailing lists etc. using specific
  98 ;; rules in `nnmail-split-fancy'.  Somewhere among these rules, you
  99 ;; will filter spam.  Here is how you would create your dictionary:
 100
 101 ;; Reset: (setq spam-stat (make-hash-table :test 'equal))
 102 ;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
 103 ;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
 104 ;; Repeat for any other non-spam group you need...
 105 ;; Reduce table size: (spam-stat-reduce-size)
 106 ;; Save table: (spam-stat-save)
 107
 108 ;;; Todo:
 109
 110 ;; Speed it up.  Integrate with Gnus such that it uses spam and expiry
 111 ;; marks to call the appropriate functions when leaving the summary
 112 ;; buffer and saves the hash table when leaving Gnus.  More testing:
 113 ;; More mails, disabling SpamAssassin, double checking algorithm, find
 114 ;; improved algorithm.
 115
 116 ;;; Thanks:
 117
 118 ;; Ted Zlatanov <tzz@lifelogs.com>
 119 ;; Jesper Harder <harder@myrealbox.com>
 120 ;; Dan Schmidt <dfan@dfan.org>
 121
 122 \f
 123
 124 ;;; Code:
 125
 126 (defgroup spam-stat nil
 127   "Statistical spam detection for Emacs.
 128 Use the functions to build a dictionary of words and their statistical
 129 distribution in spam and non-spam mails.  Then use a function to determine
 130 wether a buffer contains spam or not."
 131   :group 'gnus)
 132
 133 (defcustom spam-stat-file "~/.spam-stat.el"
 134   "File used to save and load the dictionary.
 135 See `spam-stat-to-hash-table' for the format of the file."
 136   :type 'file
 137   :group 'spam-stat)
 138
 139 (defcustom spam-stat-unknown-word-score 0.2
 140   "The score to use for unknown words.
 141 Also used for words that don't appear often enough."
 142   :type 'number
 143   :group 'spam-stat)
 144
 145 (defcustom spam-stat-max-word-length 15
 146   "Only words shorter than this will be considered."
 147   :type 'integer
 148   :group 'spam-stat)
 149
 150 (defcustom spam-stat-max-buffer-length 10240
 151   "Only the beginning of buffers will be analyzed.
 152 This variable says how many characters this will be."
 153   :type 'integer
 154   :group 'spam-stat)
 155
 156 (defcustom spam-stat-split-fancy-spam-group "mail.spam"
 157   "Name of the group where spam should be stored, if
 158 `spam-stat-split-fancy' is used in fancy splitting rules."
 159   :type 'string
 160   :group 'spam-stat)
 161
 162 (defvar spam-stat-syntax-table
 163   (let ((table (copy-syntax-table text-mode-syntax-table)))
 164     (modify-syntax-entry ?- "w" table)
 165     (modify-syntax-entry ?_ "w" table)
 166     (modify-syntax-entry ?. "w" table)
 167     (modify-syntax-entry ?! "w" table)
 168     (modify-syntax-entry ?? "w" table)
 169     (modify-syntax-entry ?+ "w" table)
 170     table)
 171   "Syntax table used when processing mails for statistical analysis.
 172 The important part is which characters are word constituents.")
 173
 174 (defvar spam-stat-buffer nil
 175   "Buffer to use for scoring while splitting.
 176 This is set by hooking into Gnus.")
 177
 178 (defvar spam-stat-buffer-name " *spam stat buffer*"
 179   "Name of the `spam-stat-buffer'.")
 180
 181 ;; Functions missing in Emacs 20
 182
 183 (eval-and-compile
 184   (when (and (not (featurep 'xemacs))
 185              (= emacs-major-version 20))
 186     ;; gethash, hash-table-count, make-hash-table, mapc
 187     (require 'cl)
 188     (defalias 'puthash 'cl-puthash)))
 189
 190 (eval-when-compile
 191   (unless (fboundp 'with-syntax-table)
 192     ;; Imported from Emacs 21.2
 193     (defmacro with-syntax-table (table &rest body) "\
 194 Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
 195 The syntax table of the current buffer is saved, BODY is evaluated, and the
 196 saved table is restored, even in case of an abnormal exit.
 197 Value is what BODY returns."
 198       (let ((old-table (make-symbol "table"))
 199             (old-buffer (make-symbol "buffer")))
 200         `(let ((,old-table (syntax-table))
 201                (,old-buffer (current-buffer)))
 202            (unwind-protect
 203                (progn
 204                  (set-syntax-table (copy-syntax-table ,table))
 205                  ,@body)
 206              (save-current-buffer
 207                (set-buffer ,old-buffer)
 208                (set-syntax-table ,old-table))))))))
 209
 210 ;; Hooking into Gnus
 211
 212 (defun spam-stat-store-current-buffer ()
 213   "Store a copy of the current buffer in `spam-stat-buffer'."
 214   (save-excursion
 215     (let ((str (buffer-string)))
 216       (set-buffer (get-buffer-create spam-stat-buffer-name))
 217       (erase-buffer)
 218       (insert str)
 219       (setq spam-stat-buffer (current-buffer)))))
 220
 221 (defun spam-stat-store-gnus-article-buffer ()
 222   "Store a copy of the current article in `spam-stat-buffer'.
 223 This uses `gnus-article-buffer'."
 224   (save-excursion
 225     (set-buffer gnus-original-article-buffer)
 226     (spam-stat-store-current-buffer)))
 227
 228 (add-hook 'nnmail-prepare-incoming-message-hook
 229           'spam-stat-store-current-buffer)
 230 (add-hook 'gnus-select-article-hook
 231           'spam-stat-store-gnus-article-buffer)
 232
 233 ;; Data -- not using defstruct in order to save space and time
 234
 235 (defvar spam-stat (make-hash-table :test 'equal)
 236   "Hash table used to store the statistics.
 237 Use `spam-stat-load' to load the file.
 238 Every word is used as a key in this table.  The value is a vector.
 239 Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
 240 `spam-stat-bad', and `spam-stat-score' to access this vector.")
 241
 242 (defvar spam-stat-ngood 0
 243   "The number of good mails in the dictionary.")
 244
 245 (defvar spam-stat-nbad 0
 246   "The number of bad mails in the dictionary.")
 247
 248 (defsubst spam-stat-good (entry)
 249   "Return the number of times this word belongs to good mails."
 250   (aref entry 0))
 251
 252 (defsubst spam-stat-bad (entry)
 253   "Return the number of times this word belongs to bad mails."
 254   (aref entry 1))
 255
 256 (defsubst spam-stat-score (entry)
 257   "Set the score of this word."
 258   (if entry
 259       (aref entry 2)
 260     spam-stat-unknown-word-score))
 261
 262 (defsubst spam-stat-set-good (entry value)
 263   "Set the number of times this word belongs to good mails."
 264   (aset entry 0 value))
 265
 266 (defsubst spam-stat-set-bad (entry value)
 267   "Set the number of times this word belongs to bad mails."
 268   (aset entry 1 value))
 269
 270 (defsubst spam-stat-set-score (entry value)
 271   "Set the score of this word."
 272   (aset entry 2 value))
 273
 274 (defsubst spam-stat-make-entry (good bad)
 275   "Return a vector with the given properties."
 276   (let ((entry (vector good bad nil)))
 277     (spam-stat-set-score entry (spam-stat-compute-score entry))
 278     entry))
 279
 280 ;; Computing
 281
 282 (defun spam-stat-compute-score (entry)
 283   "Compute the score of this word.  1.0 means spam."
 284    ;; promote all numbers to floats for the divisions
 285    (let* ((g (* 2.0 (spam-stat-good entry)))
 286           (b (float (spam-stat-bad entry))))
 287      (cond ((< (+ g b) 5)
 288             .2)
 289            ((= 0 spam-stat-ngood)
 290             .99)
 291            ((= 0 spam-stat-nbad)
 292             .01)
 293            (t
 294             (max .01
 295                  (min .99 (/ (/ b spam-stat-nbad)
 296                              (+ (/ g spam-stat-ngood)
 297                                 (/ b spam-stat-nbad)))))))))
 298
 299 ;; Parsing
 300
 301 (defmacro with-spam-stat-max-buffer-size (&rest body)
 302   "Narrows the buffer down to the first 4k characters, then evaluates BODY."
 303   `(save-restriction
 304      (when (> (- (point-max)
 305                  (point-min))
 306               spam-stat-max-buffer-length)
 307        (narrow-to-region (point-min)
 308                          (+ (point-min) spam-stat-max-buffer-length)))
 309      ,@body))
 310
 311 (defun spam-stat-buffer-words ()
 312   "Return a hash table of words and number of occurences in the buffer."
 313   (with-spam-stat-max-buffer-size
 314    (with-syntax-table spam-stat-syntax-table
 315      (goto-char (point-min))
 316      (let ((result (make-hash-table :test 'equal))
 317            word count)
 318        (while (re-search-forward "\\w+" nil t)
 319          (setq word (match-string-no-properties 0)
 320                count (1+ (gethash word result 0)))
 321          (when (< (length word) spam-stat-max-word-length)
 322            (puthash word count result)))
 323        result))))
 324
 325 (defun spam-stat-buffer-is-spam ()
 326   "Consider current buffer to be a new spam mail."
 327   (setq spam-stat-nbad (1+ spam-stat-nbad))
 328   (maphash
 329    (lambda (word count)
 330      (let ((entry (gethash word spam-stat)))
 331        (if entry
 332            (spam-stat-set-bad entry (+ count (spam-stat-bad entry)))
 333          (setq entry (spam-stat-make-entry 0 count)))
 334        (spam-stat-set-score entry (spam-stat-compute-score entry))
 335        (puthash word entry spam-stat)))
 336    (spam-stat-buffer-words)))
 337
 338 (defun spam-stat-buffer-is-non-spam ()
 339   "Consider current buffer to be a new non-spam mail."
 340   (setq spam-stat-ngood (1+ spam-stat-ngood))
 341   (maphash
 342    (lambda (word count)
 343      (let ((entry (gethash word spam-stat)))
 344        (if entry
 345            (spam-stat-set-good entry (+ count (spam-stat-good entry)))
 346          (setq entry (spam-stat-make-entry count 0)))
 347        (spam-stat-set-score entry (spam-stat-compute-score entry))
 348        (puthash word entry spam-stat)))
 349    (spam-stat-buffer-words)))
 350
 351 (defun spam-stat-buffer-change-to-spam ()
 352   "Consider current buffer no longer normal mail but spam."
 353   (setq spam-stat-nbad (1+ spam-stat-nbad)
 354         spam-stat-ngood (1- spam-stat-ngood))
 355   (maphash
 356    (lambda (word count)
 357      (let ((entry (gethash word spam-stat)))
 358        (if (not entry)
 359            (error "This buffer has unknown words in it.")
 360          (spam-stat-set-good entry (- (spam-stat-good entry) count))
 361          (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
 362          (spam-stat-set-score entry (spam-stat-compute-score entry))
 363          (puthash word entry spam-stat))))
 364    (spam-stat-buffer-words)))
 365
 366 (defun spam-stat-buffer-change-to-non-spam ()
 367   "Consider current buffer no longer spam but normal mail."
 368   (setq spam-stat-nbad (1- spam-stat-nbad)
 369         spam-stat-ngood (1+ spam-stat-ngood))
 370   (maphash
 371    (lambda (word count)
 372      (let ((entry (gethash word spam-stat)))
 373        (if (not entry)
 374            (error "This buffer has unknown words in it.")
 375          (spam-stat-set-good entry (+ (spam-stat-good entry) count))
 376          (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
 377          (spam-stat-set-score entry (spam-stat-compute-score entry))
 378          (puthash word entry spam-stat))))
 379    (spam-stat-buffer-words)))
 380
 381 ;; Saving and Loading
 382
 383 (defun spam-stat-save ()
 384   "Save the `spam-stat' hash table as lisp file."
 385   (interactive)
 386   (with-temp-buffer
 387     (let ((standard-output (current-buffer)))
 388       (insert "(setq spam-stat (spam-stat-to-hash-table '(")
 389       (maphash (lambda (word entry)
 390                  (prin1 (list word
 391                               (spam-stat-good entry)
 392                               (spam-stat-bad entry))))
 393                spam-stat)
 394       (insert ")) spam-stat-ngood "
 395               (number-to-string spam-stat-ngood)
 396               " spam-stat-nbad "
 397               (number-to-string spam-stat-nbad)
 398               ")"))
 399     (write-file spam-stat-file)))
 400
 401 (defun spam-stat-load ()
 402   "Read the `spam-stat' hash table from disk."
 403   (load-file spam-stat-file))
 404
 405 (defun spam-stat-to-hash-table (entries)
 406   "Turn list ENTRIES into a hash table and store as `spam-stat'.
 407 Every element in ENTRIES has the form \(WORD GOOD BAD) where WORD is
 408 the word string, NGOOD is the number of good mails it has appeared in,
 409 NBAD is the number of bad mails it has appeared in, GOOD is the number
 410 of times it appeared in good mails, and BAD is the number of times it
 411 has appeared in bad mails."
 412   (let ((table (make-hash-table :test 'equal)))
 413     (mapc (lambda (l)
 414             (puthash (car l)
 415                      (spam-stat-make-entry (nth 1 l) (nth 2 l))
 416                      table))
 417           entries)
 418     table))
 419
 420 (defun spam-stat-reset ()
 421   "Reset `spam-stat' to an empty hash-table.
 422 This deletes all the statistics."
 423   (interactive)
 424   (setq spam-stat (make-hash-table :test 'equal)))
 425
 426 ;; Scoring buffers
 427
 428 (defvar spam-stat-score-data nil
 429   "Raw data used in the last run of `spam-stat-score-buffer'.")
 430
 431 (defsubst spam-stat-score-word (word)
 432   "Return score for WORD.
 433 The default score for unknown words is stored in
 434 `spam-stat-unknown-word-score'."
 435   (spam-stat-score (gethash word spam-stat)))
 436
 437
 438 (defun spam-stat-buffer-words-with-scores ()
 439   "Process current buffer, return the 15 most conspicuous words.
 440 These are the words whose spam-stat differs the most from 0.5.
 441 The list returned contains elements of the form \(WORD SCORE DIFF),
 442 where DIFF is the difference between SCORE and 0.5."
 443   (with-spam-stat-max-buffer-size
 444    (with-syntax-table spam-stat-syntax-table
 445      (let (result word score)
 446        (maphash (lambda (word ignore)
 447                   (setq score (spam-stat-score-word word)
 448                         result (cons (list word score (abs (- score 0.5)))
 449                                      result)))
 450                 (spam-stat-buffer-words))
 451        (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
 452        (setcdr (nthcdr 14 result) nil)
 453        result))))
 454
 455 (defun spam-stat-score-buffer ()
 456   "Return a score describing the spam-probability for this buffer."
 457   (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
 458   (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data))
 459          (prod (apply #'* probs)))
 460     (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
 461                                        probs))))))
 462
 463 (defun spam-stat-split-fancy ()
 464   "Return the name of the spam group if the current mail is spam.
 465 Use this function on `nnmail-split-fancy'.  If you are interested in
 466 the raw data used for the last run of `spam-stat-score-buffer',
 467 check the variable `spam-stat-score-data'."
 468   (condition-case var
 469       (progn
 470         (set-buffer spam-stat-buffer)
 471         (goto-char (point-min))
 472         (when (> (spam-stat-score-buffer) 0.9)
 473           (when (boundp 'nnmail-split-trace)
 474             (mapc (lambda (entry)
 475                     (push entry nnmail-split-trace))
 476                   spam-stat-score-data))
 477           spam-stat-split-fancy-spam-group))
 478     (error (message "Error in spam-stat-split-fancy: %S" var)
 479            nil)))
 480
 481 ;; Testing
 482
 483 (defun spam-stat-process-directory (dir func)
 484   "Process all the regular files in directory DIR using function FUNC."
 485   (let* ((files (directory-files dir t "^[^.]"))
 486          (max (/ (length files) 100.0))
 487          (count 0))
 488     (with-temp-buffer
 489       (dolist (f files)
 490         (when (and (file-readable-p f)
 491                    (file-regular-p f))
 492           (setq count (1+ count))
 493           (message "Reading %.2f%%" (/ count max))
 494           (insert-file-contents f)
 495           (funcall func)
 496           (erase-buffer))))))
 497
 498 (defun spam-stat-process-spam-directory (dir)
 499   "Process all the regular files in directory DIR as spam."
 500   (interactive "D")
 501   (spam-stat-process-directory dir 'spam-stat-buffer-is-spam))
 502
 503 (defun spam-stat-process-non-spam-directory (dir)
 504   "Process all the regular files in directory DIR as non-spam."
 505   (interactive "D")
 506   (spam-stat-process-directory dir 'spam-stat-buffer-is-non-spam))
 507
 508 (defun spam-stat-count ()
 509   "Return size of `spam-stat'."
 510   (interactive)
 511   (hash-table-count spam-stat))
 512
 513 (defun spam-stat-test-directory (dir)
 514   "Test all the regular files in directory DIR for spam.
 515 If the result is 1.0, then all files are considered spam.
 516 If the result is 0.0, non of the files is considered spam.
 517 You can use this to determine error rates."
 518   (interactive "D")
 519   (let* ((files (directory-files dir t "^[^.]"))
 520          (total (length files))
 521          (score 0.0); float
 522          (max (/ total 100.0)); float
 523          (count 0))
 524     (with-temp-buffer
 525       (dolist (f files)
 526         (when (and (file-readable-p f)
 527                    (file-regular-p f))
 528           (setq count (1+ count))
 529           (message "Reading %.2f%%, score %.2f%%"
 530                    (/ count max) (/ score count))
 531           (insert-file-contents f)
 532           (when (> (spam-stat-score-buffer) 0.9)
 533             (setq score (1+ score)))
 534           (erase-buffer))))
 535     (message "Final score: %d / %d = %f" score total (/ score total))))
 536
 537 ;; Shrinking the dictionary
 538
 539 (defun spam-stat-reduce-size (&optional count distance)
 540   "Reduce the size of `spam-stat'.
 541 This removes all words that occur less than COUNT from the dictionary.
 542 COUNT defaults to 5.  It also removes all words whose spam score
 543 is less than DISTANCE from 0.5.  DISTANCE defaults to 0.1, meaning that
 544 all words with score between 0.4 and 0.6 are removed."
 545   (interactive)
 546   (setq count (or count 5)
 547         distance (or distance 0.1))
 548   (maphash (lambda (key entry)
 549              (when (or (< (+ (spam-stat-good entry)
 550                              (spam-stat-bad entry))
 551                           count)
 552                        (< (abs (- (spam-stat-score entry) 0.5))
 553                           distance))
 554                (remhash key spam-stat)))
 555            spam-stat))
 556
 557 (provide 'spam-stat)
 558
 559 ;;; spam-stat.el ends here
 560