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