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