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