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

   1 ;;; spam.el --- Identifying spam
   2 ;; Copyright (C) 2002 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: network
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; This module addresses a few aspects of spam control under Gnus.  Page
  27 ;;; breaks are used for grouping declarations and documentation relating to
  28 ;;; each particular aspect.
  29
  30 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
  31 ;;; comments, below, for supplementary explanations or discussions.
  32
  33 ;;; Several TODO items are marked as such
  34
  35 ;;; Code:
  36
  37 (require 'gnus-sum)
  38
  39 (require 'gnus-uu)                      ; because of key prefix issues
  40 (require 'gnus) ; for the definitions of group content classification and spam processors
  41
  42 ;; FIXME!  We should not require `message' until we actually need
  43 ;; them.  Best would be to declare needed functions as auto-loadable.
  44 (require 'message)
  45
  46 ;; Attempt to load BBDB macros
  47 (eval-when-compile
  48   (condition-case nil
  49       (require 'bbdb-com)
  50     (file-error (defalias 'bbdb-search 'ignore))))
  51
  52 ;; autoload executable-find
  53 (eval-and-compile
  54   ;; executable-find is not autoloaded in Emacs 20
  55   (autoload 'executable-find "executable"))
  56
  57 ;; autoload ifile-spam-filter
  58 (eval-and-compile
  59   (autoload 'ifile-spam-filter "ifile-gnus"))
  60
  61 ;; autoload query-dig
  62 (eval-and-compile
  63   (autoload 'query-dig "dig"))
  64
  65 ;; autoload query-dns
  66 (eval-and-compile
  67   (autoload 'query-dns "dns"))
  68
  69 ;;; Main parameters.
  70
  71 (defgroup spam nil
  72   "Spam configuration.")
  73
  74 (defcustom spam-directory "~/News/spam/"
  75   "Directory for spam whitelists and blacklists."
  76   :type 'directory
  77   :group 'spam)
  78
  79 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
  80   "The location of the whitelist.
  81 The file format is one regular expression per line.
  82 The regular expression is matched against the address."
  83   :type 'file
  84   :group 'spam)
  85
  86 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
  87   "The location of the blacklist.
  88 The file format is one regular expression per line.
  89 The regular expression is matched against the address."
  90   :type 'file
  91   :group 'spam)
  92
  93 (defcustom spam-use-dig t
  94   "Whether query-dig should be used instead of query-dns."
  95   :type 'boolean
  96   :group 'spam)
  97
  98 (defcustom spam-use-blacklist nil
  99   "Whether the blacklist should be used by spam-split."
 100   :type 'boolean
 101   :group 'spam)
 102
 103 (defcustom spam-use-whitelist nil
 104   "Whether the whitelist should be used by spam-split."
 105   :type 'boolean
 106   :group 'spam)
 107
 108 (defcustom spam-use-blackholes nil
 109   "Whether blackholes should be used by spam-split."
 110   :type 'boolean
 111   :group 'spam)
 112
 113 (defcustom spam-use-bogofilter nil
 114   "Whether bogofilter should be used by spam-split."
 115   :type 'boolean
 116   :group 'spam)
 117
 118 (defcustom spam-use-BBDB nil
 119   "Whether BBDB should be used by spam-split."
 120   :type 'boolean
 121   :group 'spam)
 122
 123 (defcustom spam-use-ifile nil
 124   "Whether ifile should be used by spam-split."
 125   :type 'boolean
 126   :group 'spam)
 127
 128 (defcustom spam-split-group "spam"
 129   "Group name where incoming spam should be put by spam-split."
 130   :type 'string
 131   :group 'spam)
 132
 133 ;; FIXME!  The mailgroup list evidently depends on other choices made by the
 134 ;; user, so the built-in default below is not likely to be appropriate.
 135 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
 136   "Mailgroups with spam contents.
 137 All unmarked article in such group receive the spam mark on group entry."
 138   :type '(repeat (string :tag "Group"))
 139   :group 'spam)
 140
 141 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" "relays.visi.com")
 142   "List of blackhole servers."
 143   :type '(repeat (string :tag "Server"))
 144   :group 'spam)
 145
 146 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 'gnus-killed-mark 'gnus-kill-file-mark 'gnus-low-score-mark)
 147   "Marks considered as being ham (positively not spam).
 148 Such articles will be processed as ham (non-spam) on group exit."
 149   :type '(set
 150           (variable-item gnus-del-mark)
 151           (variable-item gnus-read-mark)
 152           (variable-item gnus-killed-mark)
 153           (variable-item gnus-kill-file-mark)
 154           (variable-item gnus-low-score-mark))
 155   :group 'spam)
 156
 157 (defcustom spam-spam-marks (list 'gnus-spam-mark)
 158   "Marks considered as being spam (positively spam).
 159 Such articles will be transmitted to `bogofilter -s' on group exit."
 160   :type '(set
 161           (variable-item gnus-spam-mark)
 162           (variable-item gnus-killed-mark)
 163           (variable-item gnus-kill-file-mark)
 164           (variable-item gnus-low-score-mark))
 165   :group 'spam)
 166
 167 (defcustom spam-face 'gnus-splash-face
 168   "Face for spam-marked articles"
 169   :type 'face
 170   :group 'spam)
 171
 172 (defgroup spam-bogofilter nil
 173   "Spam bogofilter configuration."
 174   :group 'spam)
 175
 176 (defcustom spam-bogofilter-output-buffer-name "*Bogofilter Output*"
 177   "Name of buffer when displaying `bogofilter -v' output."
 178   :type 'string
 179   :group 'spam-bogofilter)
 180
 181 (defcustom spam-bogofilter-initial-timeout 40
 182   "Timeout in seconds for the initial reply from the `bogofilter' program."
 183   :type 'integer
 184   :group 'spam-bogofilter)
 185
 186 (defcustom spam-bogofilter-subsequent-timeout 15
 187   "Timeout in seconds for any subsequent reply from the `bogofilter' program."
 188   :type 'integer
 189   :group 'spam-bogofilter)
 190
 191 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 192   "File path of the Bogofilter executable program."
 193   :type '(choice (file :tag "Location of bogofilter")
 194                  (const :tag "Bogofilter is not installed"))
 195   :group 'spam-bogofilter)
 196
 197 ;; FIXME!  In the following regexp, we should explain which tool produces
 198 ;; which kind of header.  I do not even remember them all by now.  X-Junk
 199 ;; (and previously X-NoSpam) are produced by the `NoSpam' tool, which has
 200 ;; never been published, so it might not be reasonable leaving it in the
 201 ;; list.
 202 (defcustom spam-bogofilter-spaminfo-header-regexp "^X-\\(jf\\|Junk\\|NoSpam\\|Spam\\|SB\\)[^:]*:"
 203   "Regexp for spam markups in headers.
 204 Markup from spam recognisers, as well as `Xref', are to be removed from
 205 articles before they get registered by Bogofilter."
 206   :type 'regexp
 207   :group 'spam-bogofilter)
 208
 209 ;;; Key bindings for spam control.
 210
 211 (gnus-define-keys gnus-summary-mode-map
 212   "St" spam-bogofilter-score
 213   "Sx" gnus-summary-mark-as-spam
 214   "Mst" spam-bogofilter-score
 215   "Msx" gnus-summary-mark-as-spam
 216   "\M-d" gnus-summary-mark-as-spam)
 217
 218 ;;; How to highlight a spam summary line.
 219
 220 ;; TODO: How do we redo this every time spam-face is customized?
 221
 222 (push '((eq mark gnus-spam-mark) . spam-face)
 223       gnus-summary-highlight)
 224
 225 ;; convenience functions
 226 (defun spam-group-spam-contents-p (group)
 227   (if (stringp group)
 228       (or (member group spam-junk-mailgroups)
 229           (memq 'gnus-group-spam-classification-spam (gnus-parameter-spam-contents group)))
 230     nil))
 231
 232 (defun spam-group-ham-contents-p (group)
 233   (if (stringp group)
 234       (memq 'gnus-group-spam-classification-ham (gnus-parameter-spam-contents group))
 235     nil))
 236
 237 (defun spam-group-processor-p (group processor)
 238   (if (and (stringp group)
 239            (symbolp processor))
 240       (member processor (car (gnus-parameter-spam-process group)))
 241     nil))
 242
 243 (defun spam-group-processor-bogofilter-p (group)
 244   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 245
 246 (defun spam-group-processor-ifile-p (group)
 247   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 248
 249 (defun spam-group-processor-blacklist-p (group)
 250   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 251
 252 (defun spam-group-processor-whitelist-p (group)
 253   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 254
 255 (defun spam-group-processor-BBDB-p (group)
 256   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 257
 258 ;;; Hooks dispatching.  A bit raw for now.
 259
 260 (defun spam-summary-prepare ()
 261   (spam-mark-junk-as-spam-routine))
 262
 263 (defun spam-summary-prepare-exit ()
 264   ;; The spam processors are invoked for any group, spam or ham or neither
 265   (when (or (and spam-use-bogofilter spam-bogofilter-path)
 266             (spam-group-processor-bogofilter-p gnus-newsgroup-name))
 267     (spam-bogofilter-register-routine))
 268
 269   (when (or spam-use-ifile
 270             (spam-group-processor-ifile-p gnus-newsgroup-name))
 271     (spam-ifile-register-routine))
 272
 273   (when (or spam-use-blacklist
 274             (spam-group-processor-bogofilter-p gnus-newsgroup-name))
 275     (spam-blacklist-register-routine))
 276
 277   ;; Only for spam groups, we expire and maybe move articles
 278   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 279     (spam-mark-spam-as-expired-and-move-routine (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 280
 281   (when (spam-group-ham-contents-p gnus-newsgroup-name)
 282     (when (or spam-use-whitelist
 283               (spam-group-processor-whitelist-p gnus-newsgroup-name))
 284       (spam-whitelist-register-routine))
 285     (when (or spam-use-BBDB
 286               (spam-group-processor-BBDB-p gnus-newsgroup-name))
 287       (spam-BBDB-register-routine))))
 288
 289 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
 290 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
 291
 292 (defun spam-mark-junk-as-spam-routine ()
 293   ;; check the global list of group names spam-junk-mailgroups and the group parameters
 294   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 295     (let ((articles gnus-newsgroup-articles)
 296           article)
 297       (while articles
 298         (setq article (pop articles))
 299         (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
 300           (gnus-summary-mark-article article gnus-spam-mark))))))
 301
 302 (defun spam-mark-spam-as-expired-and-move-routine (&optional group)
 303   (let ((articles gnus-newsgroup-articles)
 304         article)
 305     (while articles
 306       (setq article (pop articles))
 307       (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 308         (gnus-summary-mark-article article gnus-expirable-mark)
 309         (when (stringp group)
 310           (let ((gnus-current-article article))
 311             (gnus-summary-move-article nil group)))))))
 312
 313 (defun spam-generic-register-routine (spam-func ham-func)
 314   (let ((articles gnus-newsgroup-articles)
 315         article mark ham-articles spam-articles spam-mark-values ham-mark-values)
 316
 317     ;; marks are stored as symbolic values, so we have to dereference them for memq to work
 318     ;; we wouldn't have to do this if gnus-summary-article-mark returned a symbol.
 319     (dolist (mark spam-ham-marks)
 320       (push (symbol-value mark) ham-mark-values))
 321
 322     (dolist (mark spam-spam-marks)
 323       (push (symbol-value mark) spam-mark-values))
 324
 325     (while articles
 326       (setq article (pop articles)
 327             mark (gnus-summary-article-mark article))
 328       (cond ((memq mark spam-mark-values) (push article spam-articles))
 329             ((memq article gnus-newsgroup-saved))
 330             ((memq mark ham-mark-values) (push article ham-articles))))
 331     (when (and ham-articles ham-func)
 332       (mapc ham-func ham-articles))     ; we use mapc because unlike mapcar it discards the return values
 333     (when (and spam-articles spam-func)
 334       (mapc spam-func spam-articles)))) ; we use mapc because unlike mapcar it discards the return values
 335
 336 (defun spam-fetch-field-from-fast (article)
 337   "Fetch the `from' field quickly, using the Gnus internal gnus-data-list function"
 338   (if (and (numberp article)
 339            (assoc article (gnus-data-list nil)))
 340       (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
 341     nil))
 342
 343 \f
 344 ;;;; Spam determination.
 345
 346 (defvar spam-list-of-checks
 347   '((spam-use-blacklist  . spam-check-blacklist)
 348     (spam-use-whitelist  . spam-check-whitelist)
 349     (spam-use-BBDB       . spam-check-BBDB)
 350     (spam-use-ifile      . spam-check-ifile)
 351     (spam-use-blackholes . spam-check-blackholes)
 352     (spam-use-bogofilter . spam-check-bogofilter))
 353 "The spam-list-of-checks list contains pairs associating a parameter
 354 variable with a spam checking function.  If the parameter variable is
 355 true, then the checking function is called, and its value decides what
 356 happens.  Each individual check may return `nil', `t', or a mailgroup
 357 name.  The value `nil' means that the check does not yield a decision,
 358 and so, that further checks are needed.  The value `t' means that the
 359 message is definitely not spam, and that further spam checks should be
 360 inhibited.  Otherwise, a mailgroup name is returned where the mail
 361 should go, and further checks are also inhibited.  The usual mailgroup
 362 name is the value of `spam-split-group', meaning that the message is
 363 definitely a spam.")
 364
 365 (defun spam-split ()
 366   "Split this message into the `spam' group if it is spam.
 367 This function can be used as an entry in `nnmail-split-fancy', for
 368 example like this: (: spam-split)
 369
 370 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 371   (interactive)
 372
 373   (let ((list-of-checks spam-list-of-checks)
 374         decision)
 375     (while (and list-of-checks (not decision))
 376       (let ((pair (pop list-of-checks)))
 377         (when (symbol-value (car pair))
 378           (setq decision (funcall (cdr pair))))))
 379     (if (eq decision t)
 380         nil
 381       decision)))
 382 \f
 383 ;;;; Blackholes.
 384
 385 (defun spam-check-blackholes ()
 386   "Check the Received headers for blackholed relays."
 387   (let ((headers (message-fetch-field "received"))
 388         ips matches)
 389     (when headers
 390       (with-temp-buffer
 391         (insert headers)
 392         (goto-char (point-min))
 393         (while (re-search-forward
 394                 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
 395           (message "Blackhole search found host IP %s." (match-string 1))
 396           (push (mapconcat 'identity
 397                            (nreverse (split-string (match-string 1) "\\."))
 398                            ".")
 399                 ips)))
 400       (dolist (server spam-blackhole-servers)
 401         (dolist (ip ips)
 402           (let ((query-string (concat ip "." server)))
 403             (if spam-use-dig
 404                 (let ((query-result (query-dig query-string)))
 405                   (when query-result
 406                     (message "spam detected with blackhole check of relay %s (dig query result '%s')" query-string query-result)
 407                     (push (list ip server query-result)
 408                           matches)))
 409               ;; else, if not using dig.el
 410               (when (query-dns query-string)
 411                 (push (list ip server (query-dns query-string 'TXT))
 412                       matches)))))))
 413     (when matches
 414       spam-split-group)))
 415 \f
 416 ;;;; BBDB
 417 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov <sacha@giotto.sj.ru>
 418
 419 ;; all this is done inside a condition-case to trap errors
 420 (condition-case nil
 421     (progn
 422
 423       (require 'bbdb-com)
 424
 425       (defun spam-enter-ham-BBDB (from)
 426         "Enter an address into the BBDB; implies ham (non-spam) sender"
 427         (when (stringp from)
 428           (let* ((parsed-address (gnus-extract-address-components from))
 429                  (name (or (car parsed-address) "Ham Sender"))
 430                  (net-address (car (cdr parsed-address))))
 431             (message "Adding address %s to BBDB" from)
 432             (when (and net-address
 433                        (not (bbdb-search (bbdb-records) nil nil net-address)))
 434               (bbdb-create-internal name nil net-address nil nil "ham sender added by spam.el")))))
 435
 436       (defun spam-BBDB-register-routine ()
 437         (spam-generic-register-routine
 438          ;; spam function
 439          nil
 440          ;; ham function
 441          (lambda (article)
 442            (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 443
 444       (defun spam-check-BBDB ()
 445         "Mail from people in the BBDB is never considered spam"
 446         (let ((who (message-fetch-field "from")))
 447           (when who
 448             (setq who (regexp-quote (cadr (gnus-extract-address-components who))))
 449             (if (bbdb-search (bbdb-records) nil nil who) nil spam-split-group)))))
 450
 451   (file-error (progn
 452                 (setq spam-list-of-checks
 453                       (delete (assoc 'spam-use-BBDB spam-list-of-checks)
 454                               spam-list-of-checks))
 455                 (defun spam-check-BBDB ()
 456                   message "spam-check-BBDB was invoked, but it shouldn't have")
 457                 (defun spam-BBDB-register-routine ()
 458                   (spam-generic-register-routine nil nil)))))
 459
 460 \f
 461 ;;;; ifile
 462 ;;; uses ifile-gnus.el from http://www.ai.mit.edu/people/jhbrown/ifile-gnus.html
 463 ;;; check the ifile backend; return nil if the mail was NOT classified as spam
 464 ;;; TODO: we can't (require 'ifile-gnus), because it will insinuate itself automatically
 465 (defun spam-check-ifile ()
 466   (let ((ifile-primary-spam-group spam-split-group))
 467     (ifile-spam-filter nil)))
 468
 469 ;; TODO: add ifile registration
 470 ;; We need ifile-gnus.el to support nnimap; we could feel the message
 471 ;; directly to ifile like we do with bogofilter but that's ugly.
 472 (defun spam-ifile-register-routine ()
 473   (spam-generic-register-routine nil nil))
 474
 475 \f
 476 ;;;; Blacklists and whitelists.
 477
 478 (defvar spam-whitelist-cache nil)
 479 (defvar spam-blacklist-cache nil)
 480
 481 (defun spam-enter-whitelist (address)
 482   "Enter ADDRESS into the whitelist."
 483   (interactive "sAddress: ")
 484   (spam-enter-list address spam-whitelist)
 485   (setq spam-whitelist-cache nil))
 486
 487 (defun spam-enter-blacklist (address)
 488   "Enter ADDRESS into the blacklist."
 489   (interactive "sAddress: ")
 490   (spam-enter-list address spam-blacklist)
 491   (setq spam-blacklist-cache nil))
 492
 493 (defun spam-enter-list (address file)
 494   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 495   (unless (file-exists-p (file-name-directory file))
 496     (make-directory (file-name-directory file) t))
 497   (save-excursion
 498     (set-buffer
 499      (find-file-noselect file))
 500     (goto-char (point-max))
 501     (unless (bobp)
 502       (insert "\n"))
 503     (insert address "\n")
 504     (save-buffer)))
 505
 506 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
 507 (defun spam-check-whitelist ()
 508   ;; FIXME!  Should it detect when file timestamps change?
 509   (unless spam-whitelist-cache
 510     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 511   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
 512
 513 (defun spam-check-blacklist ()
 514   ;; FIXME!  Should it detect when file timestamps change?
 515   (unless spam-blacklist-cache
 516     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 517   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 518
 519 (eval-and-compile
 520   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 521                                    'point-at-eol
 522                                  'line-end-position)))
 523
 524 (defun spam-parse-list (file)
 525   (when (file-readable-p file)
 526     (let (contents address)
 527       (with-temp-buffer
 528         (insert-file-contents file)
 529         (while (not (eobp))
 530           (setq address (buffer-substring (point) (spam-point-at-eol)))
 531           (forward-line 1)
 532           (unless (zerop (length address))
 533             (setq address (regexp-quote address))
 534             (while (string-match "\\\\\\*" address)
 535               (setq address (replace-match ".*" t t address)))
 536             (push address contents))))
 537       (nreverse contents))))
 538
 539 (defun spam-from-listed-p (cache)
 540   (let ((from (message-fetch-field "from"))
 541         found)
 542     (while cache
 543       (when (string-match (pop cache) from)
 544         (setq found t
 545               cache nil)))
 546     found))
 547
 548 (defun spam-blacklist-register-routine ()
 549   (spam-generic-register-routine
 550    ;; the spam function
 551    (lambda (article)
 552      (let ((from (spam-fetch-field-from-fast article)))
 553        (when (stringp from)
 554            (spam-enter-blacklist from))))
 555    ;; the ham function
 556    nil))
 557
 558 (defun spam-whitelist-register-routine ()
 559   (spam-generic-register-routine
 560    ;; the spam function
 561    nil
 562    ;; the ham function
 563    (lambda (article)
 564      (let ((from (spam-fetch-field-from-fast article)))
 565        (when (stringp from)
 566            (spam-enter-whitelist from))))))
 567
 568 \f
 569 ;;;; Bogofilter
 570
 571 ;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
 572
 573 ;;; This page is for those wanting to control spam with the help of Eric
 574 ;;; Raymond's speedy Bogofilter, see http://www.tuxedo.org/~esr/bogofilter.
 575 ;;; This has been tested with a locally patched copy of version 0.4.
 576
 577 ;;; Make sure Bogofilter is installed.  Bogofilter internally uses Judy fast
 578 ;;; associative arrays, so you need to install Judy first, and Bogofilter
 579 ;;; next.  Fetch both distributions by visiting the following links and
 580 ;;; downloading the latest version of each:
 581 ;;;
 582 ;;;     http://sourceforge.net/projects/judy/
 583 ;;;     http://www.tuxedo.org/~esr/bogofilter/
 584 ;;;
 585 ;;; Unpack the Judy distribution and enter its main directory.  Then do:
 586 ;;;
 587 ;;;     ./configure
 588 ;;;     make
 589 ;;;     make install
 590 ;;;
 591 ;;; You will likely need to become super-user for the last step.  Then, unpack
 592 ;;; the Bogofilter distribution and enter its main directory:
 593 ;;;
 594 ;;;     make
 595 ;;;     make install
 596 ;;;
 597 ;;; Here as well, you need to become super-user for the last step.  Now,
 598 ;;; initialize your word lists by doing, under your own identity:
 599 ;;;
 600 ;;;     mkdir ~/.bogofilter
 601 ;;;     touch ~/.bogofilter/badlist
 602 ;;;     touch ~/.bogofilter/goodlist
 603 ;;;
 604 ;;; These two files are text files you may edit, but you normally don't!
 605
 606 ;;; The `M-d' command gets added to Gnus summary mode, marking current article
 607 ;;; as spam, showing it with the `H' mark.  Whenever you see a spam article,
 608 ;;; make sure to mark its summary line with `M-d' before leaving the group.
 609 ;;; Some groups, as per variable `spam-junk-mailgroups' below, receive articles
 610 ;;; from Gnus splitting on clues added by spam recognisers, so for these
 611 ;;; groups, we tack an `H' mark at group entry for all summary lines which
 612 ;;; would otherwise have no other mark.  Make sure to _remove_ `H' marks for
 613 ;;; any article which is _not_ genuine spam, before leaving such groups: you
 614 ;;; may use `M-u' to "unread" the article, or `d' for declaring it read the
 615 ;;; non-spam way.  When you leave a group, all `H' marked articles, saved or
 616 ;;; unsaved, are sent to Bogofilter which will study them as spam samples.
 617
 618 ;;; Messages may also be deleted in various other ways, and unless
 619 ;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for default
 620 ;;; read or explicit delete, marks `X' and 'K' for automatic or explicit
 621 ;;; kills, as well as mark `Y' for low scores, are all considered to be
 622 ;;; associated with articles which are not spam.  This assumption might be
 623 ;;; false, in particular if you use kill files or score files as means for
 624 ;;; detecting genuine spam, you should then adjust `spam-ham-marks-form'.  When
 625 ;;; you leave a group, all _unsaved_ articles bearing any the above marks are
 626 ;;; sent to Bogofilter which will study these as not-spam samples.  If you
 627 ;;; explicit kill a lot, you might sometimes end up with articles marked `K'
 628 ;;; which you never saw, and which might accidentally contain spam.  Best is
 629 ;;; to make sure that real spam is marked with `H', and nothing else.
 630
 631 ;;; All other marks do not contribute to Bogofilter pre-conditioning.  In
 632 ;;; particular, ticked, dormant or souped articles are likely to contribute
 633 ;;; later, when they will get deleted for real, so there is no need to use
 634 ;;; them prematurely.  Explicitly expired articles do not contribute, command
 635 ;;; `E' is a way to get rid of an article without Bogofilter ever seeing it.
 636
 637 ;;; In a word, with a minimum of care for associating the `H' mark for spam
 638 ;;; articles only, Bogofilter training all gets fairly automatic.  You should
 639 ;;; do this until you get a few hundreds of articles in each category, spam
 640 ;;; or not.  The shell command `head -1 ~/.bogofilter/*' shows both article
 641 ;;; counts.  The command `S S' in summary mode, either for debugging or for
 642 ;;; curiosity, triggers Bogofilter into displaying in another buffer the
 643 ;;; "spamicity" score of the current article (between 0.0 and 1.0), together
 644 ;;; with the article words which most significantly contribute to the score.
 645
 646 ;;; The real way for using Bogofilter, however, is to have some use tool like
 647 ;;; `procmail' for invoking it on message reception, then adding some
 648 ;;; recognisable header in case of detected spam.  Gnus splitting rules might
 649 ;;; later trip on these added headers and react by sorting such articles into
 650 ;;; specific junk folders as per `spam-junk-mailgroups'.  Here is a possible
 651 ;;; `.procmailrc' contents (still untested -- please tell me how it goes):
 652 ;;;
 653 ;;; :0HBf:
 654 ;;; * ? bogofilter
 655 ;;; | formail -bfI "X-Spam-Status: Yes"
 656
 657 (defun spam-check-bogofilter ()
 658   ;; Dynamic spam check.  I do not know how to check the exit status,
 659   ;; so instead, read `bogofilter -v' output.
 660   (when (and spam-use-bogofilter spam-bogofilter-path)
 661     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 662     (when (save-excursion
 663             (set-buffer spam-bogofilter-output-buffer-name)
 664             (goto-char (point-min))
 665             (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
 666       spam-split-group)))
 667
 668 (defun spam-bogofilter-score ()
 669   "Use `bogofilter -v' on the current article.
 670 This yields the 15 most discriminant words for this article and the
 671 spamicity coefficient of each, and the overall article spamicity."
 672   (interactive)
 673   (when (and spam-use-bogofilter spam-bogofilter-path)
 674     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 675     (with-current-buffer spam-bogofilter-output-buffer-name
 676       (unless (zerop (buffer-size))
 677         (if (<= (count-lines (point-min) (point-max)) 1)
 678             (progn
 679               (goto-char (point-max))
 680               (when (bolp)
 681                 (backward-char 1))
 682               (message "%s" (buffer-substring (point-min) (point))))
 683           (goto-char (point-min))
 684           (display-buffer (current-buffer)))))))
 685
 686 (defun spam-bogofilter-register-routine ()
 687   (let ((articles gnus-newsgroup-articles)
 688         article mark ham-articles spam-articles spam-mark-values ham-mark-values)
 689
 690     ;; marks are stored as symbolic values, so we have to dereference them for memq to work
 691     ;; we wouldn't have to do this if gnus-summary-article-mark returned a symbol.
 692     (dolist (mark spam-ham-marks)
 693       (push (symbol-value mark) ham-mark-values))
 694
 695     (dolist (mark spam-spam-marks)
 696       (push (symbol-value mark) spam-mark-values))
 697
 698     (while articles
 699       (setq article (pop articles)
 700             mark (gnus-summary-article-mark article))
 701       (cond ((memq mark spam-mark-values) (push article spam-articles))
 702             ((memq article gnus-newsgroup-saved))
 703             ((memq mark ham-mark-values) (push article ham-articles))))
 704     (when ham-articles
 705       (spam-bogofilter-articles "ham" "-n" ham-articles))
 706     (when spam-articles
 707       (spam-bogofilter-articles "SPAM" "-s" spam-articles))))
 708
 709 (defun spam-bogofilter-articles (type option articles)
 710   (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
 711         (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
 712         (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp "\\|Xref:"))
 713         (counter 0)
 714         prefix process article)
 715     (when type
 716       (setq prefix (format "Studying %d articles as %s..." (length articles)
 717                            type))
 718       (message "%s" prefix))
 719     (save-excursion (set-buffer output-buffer) (erase-buffer))
 720     (setq process (start-process "bogofilter" output-buffer
 721                                  spam-bogofilter-path "-F" option))
 722     (process-kill-without-query process t)
 723     (unwind-protect
 724         (save-window-excursion
 725           (while articles
 726             (setq counter (1+ counter))
 727             (when prefix
 728               (message "%s %d" prefix counter))
 729             (setq article (pop articles))
 730             (gnus-summary-goto-subject article)
 731             (gnus-summary-show-article t)
 732             (gnus-eval-in-buffer-window article-copy
 733               (insert-buffer-substring gnus-original-article-buffer)
 734               ;; Remove spam classification redundant headers: they may induce
 735               ;; unwanted biases in later analysis.
 736               (message-remove-header remove-regexp t)
 737               ;; Bogofilter really wants From envelopes for counting articles.
 738               ;; Fake one at the beginning, make sure there will be no other.
 739               (goto-char (point-min))
 740               (if (looking-at "From ")
 741                   (forward-line 1)
 742                 (insert "From nobody " (current-time-string) "\n"))
 743               (let (case-fold-search)
 744                 (while (re-search-forward "^From " nil t)
 745                   (beginning-of-line)
 746                   (insert ">")))
 747               (process-send-region process (point-min) (point-max))
 748               (erase-buffer))))
 749       ;; Sending the EOF is unwind-protected.  This is to prevent lost copies
 750       ;; of `bogofilter', hung on reading their standard input, in case the
 751       ;; whole registering process gets interrupted by the user.
 752       (process-send-eof process))
 753     (kill-buffer article-copy)
 754     ;; Receive process output.  It sadly seems that we still have to protect
 755     ;; ourselves against hung `bogofilter' processes.
 756     (let ((status (process-status process))
 757           (timeout (* 1000 spam-bogofilter-initial-timeout))
 758           (quanta 200))                 ; also counted in milliseconds
 759       (while (and (not (eq status 'exit)) (> timeout 0))
 760         ;; `accept-process-output' timeout is counted in microseconds.
 761         (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
 762                           (* 1000 spam-bogofilter-subsequent-timeout)
 763                         (- timeout quanta))
 764               status (process-status process)))
 765       (if (eq status 'exit)
 766           (when prefix
 767             (message "%s done!" prefix))
 768         ;; Sigh!  The process did time out...  Become brutal!
 769         (interrupt-process process)
 770         (message "%s %d INTERRUPTED!  (Article %d, status %s)"
 771                  (or prefix "Bogofilter process...")
 772                  counter article status)
 773         ;; Give some time for user to read.  Sitting redisplays but gives up
 774         ;; if input is pending.  Sleeping does not give up, but it does not
 775         ;; redisplay either.  Mix both: let's redisplay and not give up.
 776         (sit-for 1)
 777         (sleep-for 3)))))
 778
 779 (provide 'spam)
 780
 781 ;;; spam.el ends here.