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