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 ;; 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           (unless spam-ifile-all-categories
 526             (when (string-equal spam-ifile-spam-category category)
 527               (setq return spam-split-group))
 528             (setq return category)))))  ; always accept the ifile category
 529     return))
 530
 531 (defun spam-ifile-register-with-ifile (article-string category)
 532   "Register an article, given as a string, with a category.
 533 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 534   (when (stringp article-string)
 535     (let ((category (or category gnus-newsgroup-name)))
 536       (with-temp-buffer
 537         (insert-string article-string)
 538         (call-process-region (point-min) (point-max) spam-ifile-path
 539                              nil nil nil "-h" "-i" category)))))
 540
 541 (defun spam-ifile-register-spam-routine ()
 542   (spam-generic-register-routine
 543    (lambda (article)
 544      (spam-ifile-register-with-ifile
 545       (spam-get-article-as-string article) spam-ifile-spam-category))
 546    nil))
 547
 548 (defun spam-ifile-register-ham-routine ()
 549   (spam-generic-register-routine
 550    nil
 551    (lambda (article)
 552      (spam-ifile-register-with-ifile
 553       (spam-get-article-as-string article) nil))))
 554
 555 \f
 556 ;;;; Blacklists and whitelists.
 557
 558 (defvar spam-whitelist-cache nil)
 559 (defvar spam-blacklist-cache nil)
 560
 561 (defun spam-enter-whitelist (address)
 562   "Enter ADDRESS into the whitelist."
 563   (interactive "sAddress: ")
 564   (spam-enter-list address spam-whitelist)
 565   (setq spam-whitelist-cache nil))
 566
 567 (defun spam-enter-blacklist (address)
 568   "Enter ADDRESS into the blacklist."
 569   (interactive "sAddress: ")
 570   (spam-enter-list address spam-blacklist)
 571   (setq spam-blacklist-cache nil))
 572
 573 (defun spam-enter-list (address file)
 574   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 575   (unless (file-exists-p (file-name-directory file))
 576     (make-directory (file-name-directory file) t))
 577   (save-excursion
 578     (set-buffer
 579      (find-file-noselect file))
 580     (goto-char (point-max))
 581     (unless (bobp)
 582       (insert "\n"))
 583     (insert address "\n")
 584     (save-buffer)))
 585
 586 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
 587 (defun spam-check-whitelist ()
 588   ;; FIXME!  Should it detect when file timestamps change?
 589   (unless spam-whitelist-cache
 590     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 591   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
 592
 593 (defun spam-check-blacklist ()
 594   ;; FIXME!  Should it detect when file timestamps change?
 595   (unless spam-blacklist-cache
 596     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 597   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 598
 599 (defun spam-parse-list (file)
 600   (when (file-readable-p file)
 601     (let (contents address)
 602       (with-temp-buffer
 603         (insert-file-contents file)
 604         (while (not (eobp))
 605           (setq address (buffer-substring (point) (spam-point-at-eol)))
 606           (forward-line 1)
 607           (unless (zerop (length address))
 608             (setq address (regexp-quote address))
 609             (while (string-match "\\\\\\*" address)
 610               (setq address (replace-match ".*" t t address)))
 611             (push address contents))))
 612       (nreverse contents))))
 613
 614 (defun spam-from-listed-p (cache)
 615   (let ((from (message-fetch-field "from"))
 616         found)
 617     (while cache
 618       (when (string-match (pop cache) from)
 619         (setq found t
 620               cache nil)))
 621     found))
 622
 623 (defun spam-blacklist-register-routine ()
 624   (spam-generic-register-routine
 625    ;; the spam function
 626    (lambda (article)
 627      (let ((from (spam-fetch-field-from-fast article)))
 628        (when (stringp from)
 629            (spam-enter-blacklist from))))
 630    ;; the ham function
 631    nil))
 632
 633 (defun spam-whitelist-register-routine ()
 634   (spam-generic-register-routine
 635    ;; the spam function
 636    nil
 637    ;; the ham function
 638    (lambda (article)
 639      (let ((from (spam-fetch-field-from-fast article)))
 640        (when (stringp from)
 641            (spam-enter-whitelist from))))))
 642
 643 \f
 644 ;;;; Bogofilter
 645
 646 ;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
 647
 648 ;;; This page is for those wanting to control spam with the help of
 649 ;;; Eric Raymond's speedy Bogofilter, see
 650 ;;; http://www.tuxedo.org/~esr/bogofilter.  This has been tested with
 651 ;;; a locally patched copy of version 0.4.
 652
 653 ;;; Make sure Bogofilter is installed.  Bogofilter internally uses
 654 ;;; Judy fast associative arrays, so you need to install Judy first,
 655 ;;; and Bogofilter next.  Fetch both distributions by visiting the
 656 ;;; following links and downloading the latest version of each:
 657 ;;;
 658 ;;;     http://sourceforge.net/projects/judy/
 659 ;;;     http://www.tuxedo.org/~esr/bogofilter/
 660 ;;;
 661 ;;; Unpack the Judy distribution and enter its main directory.  Then do:
 662 ;;;
 663 ;;;     ./configure
 664 ;;;     make
 665 ;;;     make install
 666 ;;;
 667 ;;; You will likely need to become super-user for the last step.
 668 ;;; Then, unpack the Bogofilter distribution and enter its main
 669 ;;; directory:
 670 ;;;
 671 ;;;     make
 672 ;;;     make install
 673 ;;;
 674 ;;; Here as well, you need to become super-user for the last step.
 675 ;;; Now, initialize your word lists by doing, under your own identity:
 676 ;;;
 677 ;;;     mkdir ~/.bogofilter
 678 ;;;     touch ~/.bogofilter/badlist
 679 ;;;     touch ~/.bogofilter/goodlist
 680 ;;;
 681 ;;; These two files are text files you may edit, but you normally don't!
 682
 683 ;;; The `M-d' command gets added to Gnus summary mode, marking current
 684 ;;; article as spam, showing it with the `H' mark.  Whenever you see a
 685 ;;; spam article, make sure to mark its summary line with `M-d' before
 686 ;;; leaving the group.  Some groups, as per variable
 687 ;;; `spam-junk-mailgroups' below, receive articles from Gnus splitting
 688 ;;; on clues added by spam recognisers, so for these groups, we tack
 689 ;;; an `H' mark at group entry for all summary lines which would
 690 ;;; otherwise have no other mark.  Make sure to _remove_ `H' marks for
 691 ;;; any article which is _not_ genuine spam, before leaving such
 692 ;;; groups: you may use `M-u' to "unread" the article, or `d' for
 693 ;;; declaring it read the non-spam way.  When you leave a group, all
 694 ;;; `H' marked articles, saved or unsaved, are sent to Bogofilter
 695 ;;; which will study them as spam samples.
 696
 697 ;;; Messages may also be deleted in various other ways, and unless
 698 ;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for
 699 ;;; default read or explicit delete, marks `X' and 'K' for automatic
 700 ;;; or explicit kills, as well as mark `Y' for low scores, are all
 701 ;;; considered to be associated with articles which are not spam.
 702 ;;; This assumption might be false, in particular if you use kill
 703 ;;; files or score files as means for detecting genuine spam, you
 704 ;;; should then adjust `spam-ham-marks-form'.  When you leave a group,
 705 ;;; all _unsaved_ articles bearing any the above marks are sent to
 706 ;;; Bogofilter which will study these as not-spam samples.  If you
 707 ;;; explicit kill a lot, you might sometimes end up with articles
 708 ;;; marked `K' which you never saw, and which might accidentally
 709 ;;; contain spam.  Best is to make sure that real spam is marked with
 710 ;;; `H', and nothing else.
 711
 712 ;;; All other marks do not contribute to Bogofilter pre-conditioning.
 713 ;;; In particular, ticked, dormant or souped articles are likely to
 714 ;;; contribute later, when they will get deleted for real, so there is
 715 ;;; no need to use them prematurely.  Explicitly expired articles do
 716 ;;; not contribute, command `E' is a way to get rid of an article
 717 ;;; without Bogofilter ever seeing it.
 718
 719 ;;; In a word, with a minimum of care for associating the `H' mark for
 720 ;;; spam articles only, Bogofilter training all gets fairly automatic.
 721 ;;; You should do this until you get a few hundreds of articles in
 722 ;;; each category, spam or not.  The shell command `head -1
 723 ;;; ~/.bogofilter/*' shows both article counts.  The command `S S' in
 724 ;;; summary mode, either for debugging or for curiosity, triggers
 725 ;;; Bogofilter into displaying in another buffer the "spamicity" score
 726 ;;; of the current article (between 0.0 and 1.0), together with the
 727 ;;; article words which most significantly contribute to the score.
 728
 729 ;;; The real way for using Bogofilter, however, is to have some use
 730 ;;; tool like `procmail' for invoking it on message reception, then
 731 ;;; adding some recognisable header in case of detected spam.  Gnus
 732 ;;; splitting rules might later trip on these added headers and react
 733 ;;; by sorting such articles into specific junk folders as per
 734 ;;; `spam-junk-mailgroups'.  Here is a possible `.procmailrc' contents
 735 ;;; (still untested -- please tell me how it goes):
 736 ;;;
 737 ;;; :0HBf:
 738 ;;; * ? bogofilter
 739 ;;; | formail -bfI "X-Spam-Status: Yes"
 740
 741 (defun spam-check-bogofilter ()
 742   ;; Dynamic spam check.  I do not know how to check the exit status,
 743   ;; so instead, read `bogofilter -v' output.
 744   (when (and spam-use-bogofilter spam-bogofilter-path)
 745     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 746     (when (save-excursion
 747             (set-buffer spam-bogofilter-output-buffer-name)
 748             (goto-char (point-min))
 749             (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
 750       spam-split-group)))
 751
 752 (defun spam-bogofilter-score ()
 753   "Use `bogofilter -v' on the current article.
 754 This yields the 15 most discriminant words for this article and the
 755 spamicity coefficient of each, and the overall article spamicity."
 756   (interactive)
 757   (when (and spam-use-bogofilter spam-bogofilter-path)
 758     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 759     (with-current-buffer spam-bogofilter-output-buffer-name
 760       (unless (zerop (buffer-size))
 761         (if (<= (count-lines (point-min) (point-max)) 1)
 762             (progn
 763               (goto-char (point-max))
 764               (when (bolp)
 765                 (backward-char 1))
 766               (message "%s" (buffer-substring (point-min) (point))))
 767           (goto-char (point-min))
 768           (display-buffer (current-buffer)))))))
 769
 770 (defun spam-bogofilter-register-routine ()
 771   (let ((articles gnus-newsgroup-articles)
 772         article mark ham-articles spam-articles spam-mark-values
 773         ham-mark-values)
 774
 775     ;; marks are stored as symbolic values, so we have to dereference
 776     ;; them for memq to work we wouldn't have to do this if
 777     ;; gnus-summary-article-mark returned a symbol.
 778     (dolist (mark spam-ham-marks)
 779       (push (symbol-value mark) ham-mark-values))
 780
 781     (dolist (mark spam-spam-marks)
 782       (push (symbol-value mark) spam-mark-values))
 783
 784     (while articles
 785       (setq article (pop articles)
 786             mark (gnus-summary-article-mark article))
 787       (cond ((memq mark spam-mark-values) (push article spam-articles))
 788             ((memq article gnus-newsgroup-saved))
 789             ((memq mark ham-mark-values) (push article ham-articles))))
 790     (when ham-articles
 791       (spam-bogofilter-articles "ham" "-n" ham-articles))
 792     (when spam-articles
 793       (spam-bogofilter-articles "SPAM" "-s" spam-articles))))
 794
 795 (defun spam-bogofilter-articles (type option articles)
 796   (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
 797         (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
 798         (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp
 799                                "\\|Xref:"))
 800         (counter 0)
 801         prefix process article)
 802     (when type
 803       (setq prefix (format "Studying %d articles as %s..." (length articles)
 804                            type))
 805       (message "%s" prefix))
 806     (save-excursion (set-buffer output-buffer) (erase-buffer))
 807     (setq process (start-process "bogofilter" output-buffer
 808                                  spam-bogofilter-path "-F" option))
 809     (process-kill-without-query process t)
 810     (unwind-protect
 811         (save-window-excursion
 812           (while articles
 813             (setq counter (1+ counter))
 814             (when prefix
 815               (message "%s %d" prefix counter))
 816             (setq article (pop articles))
 817             (gnus-summary-goto-subject article)
 818             (gnus-summary-show-article t)
 819             (gnus-eval-in-buffer-window article-copy
 820               (insert-buffer-substring gnus-original-article-buffer)
 821               ;; Remove spam classification redundant headers: they may induce
 822               ;; unwanted biases in later analysis.
 823               (message-remove-header remove-regexp t)
 824               ;; Bogofilter really wants From envelopes for counting articles.
 825               ;; Fake one at the beginning, make sure there will be no other.
 826               (goto-char (point-min))
 827               (if (looking-at "From ")
 828                   (forward-line 1)
 829                 (insert "From nobody " (current-time-string) "\n"))
 830               (let (case-fold-search)
 831                 (while (re-search-forward "^From " nil t)
 832                   (beginning-of-line)
 833                   (insert ">")))
 834               (process-send-region process (point-min) (point-max))
 835               (erase-buffer))))
 836       ;; Sending the EOF is unwind-protected.  This is to prevent lost copies
 837       ;; of `bogofilter', hung on reading their standard input, in case the
 838       ;; whole registering process gets interrupted by the user.
 839       (process-send-eof process))
 840     (kill-buffer article-copy)
 841     ;; Receive process output.  It sadly seems that we still have to protect
 842     ;; ourselves against hung `bogofilter' processes.
 843     (let ((status (process-status process))
 844           (timeout (* 1000 spam-bogofilter-initial-timeout))
 845           (quanta 200))                 ; also counted in milliseconds
 846       (while (and (not (eq status 'exit)) (> timeout 0))
 847         ;; `accept-process-output' timeout is counted in microseconds.
 848         (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
 849                           (* 1000 spam-bogofilter-subsequent-timeout)
 850                         (- timeout quanta))
 851               status (process-status process)))
 852       (if (eq status 'exit)
 853           (when prefix
 854             (message "%s done!" prefix))
 855         ;; Sigh!  The process did time out...  Become brutal!
 856         (interrupt-process process)
 857         (message "%s %d INTERRUPTED!  (Article %d, status %s)"
 858                  (or prefix "Bogofilter process...")
 859                  counter article status)
 860         ;; Give some time for user to read.  Sitting redisplays but gives up
 861         ;; if input is pending.  Sleeping does not give up, but it does not
 862         ;; redisplay either.  Mix both: let's redisplay and not give up.
 863         (sit-for 1)
 864         (sleep-for 3)))))
 865
 866 (provide 'spam)
 867
 868 ;;; spam.el ends here.