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