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-move-spam-nonspam-groups-only t
  67   "Whether spam should be moved in non-spam groups only.
  68 When nil, only ham and unclassified groups will have their spam moved
  69 to the spam-process-destination.  When t, spam will also be moved from
  70 spam groups."
  71   :type 'boolean
  72   :group 'spam-ifile)
  73
  74 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
  75   "The location of the whitelist.
  76 The file format is one regular expression per line.
  77 The regular expression is matched against the address."
  78   :type 'file
  79   :group 'spam)
  80
  81 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
  82   "The location of the blacklist.
  83 The file format is one regular expression per line.
  84 The regular expression is matched against the address."
  85   :type 'file
  86   :group 'spam)
  87
  88 (defcustom spam-use-dig t
  89   "Whether query-dig should be used instead of query-dns."
  90   :type 'boolean
  91   :group 'spam)
  92
  93 (defcustom spam-use-blacklist nil
  94   "Whether the blacklist should be used by spam-split."
  95   :type 'boolean
  96   :group 'spam)
  97
  98 (defcustom spam-use-whitelist nil
  99   "Whether the whitelist should be used by spam-split."
 100   :type 'boolean
 101   :group 'spam)
 102
 103 (defcustom spam-use-blackholes nil
 104   "Whether blackholes should be used by spam-split."
 105   :type 'boolean
 106   :group 'spam)
 107
 108 (defcustom spam-use-regex-headers nil
 109   "Whether a header regular expression match should be used by spam-split.
 110 Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'."
 111   :type 'boolean
 112   :group 'spam)
 113
 114 (defcustom spam-use-bogofilter-headers nil
 115   "Whether bogofilter headers should be used by spam-split.
 116 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 117   :type 'boolean
 118   :group 'spam)
 119
 120 (defcustom spam-use-bogofilter nil
 121   "Whether bogofilter should be invoked by spam-split.
 122 Enable this if you want Gnus to invoke Bogofilter on new messages."
 123   :type 'boolean
 124   :group 'spam)
 125
 126 (defcustom spam-use-BBDB nil
 127   "Whether BBDB should be used by spam-split."
 128   :type 'boolean
 129   :group 'spam)
 130
 131 (defcustom spam-use-ifile nil
 132   "Whether ifile should be used by spam-split."
 133   :type 'boolean
 134   :group 'spam)
 135
 136 (defcustom spam-use-stat nil
 137   "Whether spam-stat should be used by spam-split."
 138   :type 'boolean
 139   :group 'spam)
 140
 141 (defcustom spam-split-group "spam"
 142   "Group name where incoming spam should be put by spam-split."
 143   :type 'string
 144   :group 'spam)
 145
 146 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
 147   "Mailgroups with spam contents.
 148 All unmarked article in such group receive the spam mark on group entry."
 149   :type '(repeat (string :tag "Group"))
 150   :group 'spam)
 151
 152 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 153                                     "dev.null.dk" "relays.visi.com")
 154   "List of blackhole servers."
 155   :type '(repeat (string :tag "Server"))
 156   :group 'spam)
 157
 158 (defcustom spam-blackhole-good-server-regex nil
 159   "String matching IP addresses that should not be checked in the blackholes"
 160   :type 'regexp
 161   :group 'spam)
 162
 163 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark
 164                                 'gnus-killed-mark 'gnus-kill-file-mark
 165                                 'gnus-low-score-mark)
 166   "Marks considered as being ham (positively not spam).
 167 Such articles will be processed as ham (non-spam) on group exit."
 168   :type '(set
 169           (variable-item gnus-del-mark)
 170           (variable-item gnus-read-mark)
 171           (variable-item gnus-killed-mark)
 172           (variable-item gnus-kill-file-mark)
 173           (variable-item gnus-low-score-mark))
 174   :group 'spam)
 175
 176 (defcustom spam-spam-marks (list 'gnus-spam-mark)
 177   "Marks considered as being spam (positively spam).
 178 Such articles will be transmitted to `bogofilter -s' on group exit."
 179   :type '(set
 180           (variable-item gnus-spam-mark)
 181           (variable-item gnus-killed-mark)
 182           (variable-item gnus-kill-file-mark)
 183           (variable-item gnus-low-score-mark))
 184   :group 'spam)
 185
 186 (defcustom spam-face 'gnus-splash-face
 187   "Face for spam-marked articles"
 188   :type 'face
 189   :group 'spam)
 190
 191 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 192   "Regular expression for positive header spam matches"
 193   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 194   :group 'spam)
 195
 196 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 197   "Regular expression for positive header ham matches"
 198   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 199   :group 'spam)
 200
 201 (defgroup spam-ifile nil
 202   "Spam ifile configuration."
 203   :group 'spam)
 204
 205 (defcustom spam-ifile-path (executable-find "ifile")
 206   "File path of the ifile executable program."
 207   :type '(choice (file :tag "Location of ifile")
 208                  (const :tag "ifile is not installed"))
 209   :group 'spam-ifile)
 210
 211 (defcustom spam-ifile-database-path nil
 212   "File path of the ifile database."
 213   :type '(choice (file :tag "Location of the ifile database")
 214                  (const :tag "Use the default"))
 215   :group 'spam-ifile)
 216
 217 (defcustom spam-ifile-spam-category "spam"
 218   "Name of the spam ifile category."
 219   :type 'string
 220   :group 'spam-ifile)
 221
 222 (defcustom spam-ifile-ham-category nil
 223   "Name of the ham ifile category.  If nil, the current group name will
 224 be used."
 225   :type '(choice (string :tag "Use a fixed category")
 226                 (const :tag "Use the current group name"))
 227   :group 'spam-ifile)
 228
 229 (defcustom spam-ifile-all-categories nil
 230   "Whether the ifile check will return all categories, or just spam.
 231 Set this to t if you want to use the spam-split invocation of ifile as
 232 your main source of newsgroup names."
 233   :type 'boolean
 234   :group 'spam-ifile)
 235
 236 (defgroup spam-bogofilter nil
 237   "Spam bogofilter configuration."
 238   :group 'spam)
 239
 240 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 241   "File path of the Bogofilter executable program."
 242   :type '(choice (file :tag "Location of bogofilter")
 243                  (const :tag "Bogofilter is not installed"))
 244   :group 'spam-bogofilter)
 245
 246 (defcustom spam-bogofilter-header "X-Bogosity"
 247   "The header that Bogofilter inserts in messages."
 248   :type 'string
 249   :group 'spam-bogofilter)
 250
 251 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 252   "The regex on `spam-bogofilter-header' for positive spam identification."
 253   :type 'regexp
 254   :group 'spam-bogofilter)
 255
 256 (defcustom spam-bogofilter-database-directory nil
 257   "Directory path of the Bogofilter databases."
 258   :type '(choice (directory :tag "Location of the Bogofilter database directory")
 259                  (const :tag "Use the default"))
 260   :group 'spam-ifile)
 261
 262 ;;; Key bindings for spam control.
 263
 264 (gnus-define-keys gnus-summary-mode-map
 265   "St" spam-bogofilter-score
 266   "Sx" gnus-summary-mark-as-spam
 267   "Mst" spam-bogofilter-score
 268   "Msx" gnus-summary-mark-as-spam
 269   "\M-d" gnus-summary-mark-as-spam)
 270
 271 ;;; How to highlight a spam summary line.
 272
 273 ;; TODO: How do we redo this every time spam-face is customized?
 274
 275 (push '((eq mark gnus-spam-mark) . spam-face)
 276       gnus-summary-highlight)
 277
 278 ;; convenience functions
 279 (defun spam-group-spam-contents-p (group)
 280   (if (stringp group)
 281       (or (member group spam-junk-mailgroups)
 282           (memq 'gnus-group-spam-classification-spam
 283                 (gnus-parameter-spam-contents group)))
 284     nil))
 285
 286 (defun spam-group-ham-contents-p (group)
 287   (if (stringp group)
 288       (memq 'gnus-group-spam-classification-ham
 289             (gnus-parameter-spam-contents group))
 290     nil))
 291
 292 (defun spam-group-processor-p (group processor)
 293   (if (and (stringp group)
 294            (symbolp processor))
 295       (member processor (car (gnus-parameter-spam-process group)))
 296     nil))
 297
 298 (defun spam-group-spam-processor-bogofilter-p (group)
 299   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 300
 301 (defun spam-group-spam-processor-blacklist-p (group)
 302   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 303
 304 (defun spam-group-spam-processor-ifile-p (group)
 305   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 306
 307 (defun spam-group-ham-processor-ifile-p (group)
 308   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 309
 310 (defun spam-group-ham-processor-bogofilter-p (group)
 311   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 312
 313 (defun spam-group-spam-processor-stat-p (group)
 314   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 315
 316 (defun spam-group-ham-processor-stat-p (group)
 317   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 318
 319 (defun spam-group-ham-processor-whitelist-p (group)
 320   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 321
 322 (defun spam-group-ham-processor-BBDB-p (group)
 323   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 324
 325 ;;; Summary entry and exit processing.
 326
 327 (defun spam-summary-prepare ()
 328   (spam-mark-junk-as-spam-routine))
 329
 330 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
 331
 332 (defun spam-summary-prepare-exit ()
 333   ;; The spam processors are invoked for any group, spam or ham or neither
 334   (gnus-message 6 "Exiting summary buffer and applying spam rules")
 335   (when (and spam-bogofilter-path
 336              (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
 337     (gnus-message 5 "Registering spam with bogofilter")
 338     (spam-bogofilter-register-spam-routine))
 339
 340   (when (and spam-ifile-path
 341              (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
 342     (gnus-message 5 "Registering spam with ifile")
 343     (spam-ifile-register-spam-routine))
 344
 345   (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
 346     (gnus-message 5 "Registering spam with spam-stat")
 347     (spam-stat-register-spam-routine))
 348
 349   (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
 350     (gnus-message 5 "Registering spam with the blacklist")
 351     (spam-blacklist-register-routine))
 352
 353   (if spam-move-spam-nonspam-groups-only
 354       (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
 355         (spam-mark-spam-as-expired-and-move-routine
 356          (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 357     (gnus-message 5 "Marking spam as expired and moving it")
 358     (spam-mark-spam-as-expired-and-move-routine
 359      (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 360
 361   ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 362   ;; expire spam, in case the above did not expire them
 363   (spam-mark-spam-as-expired-and-move-routine nil)
 364
 365   (when (spam-group-ham-contents-p gnus-newsgroup-name)
 366     (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
 367       (gnus-message 5 "Registering ham with the whitelist")
 368       (spam-whitelist-register-routine))
 369     (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
 370       (gnus-message 5 "Registering ham with ifile")
 371       (spam-ifile-register-ham-routine))
 372     (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
 373       (gnus-message 5 "Registering ham with Bogofilter")
 374       (spam-bogofilter-register-ham-routine))
 375     (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
 376       (gnus-message 5 "Registering ham with spam-stat")
 377       (spam-stat-register-ham-routine))
 378     (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
 379       (gnus-message 5 "Registering ham with the BBDB")
 380       (spam-BBDB-register-routine)))
 381
 382   ;; now move all ham articles out of spam groups
 383   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 384     (gnus-message 5 "Moving ham messages from spam group")
 385     (spam-ham-move-routine
 386      (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 387
 388 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
 389
 390 (defun spam-mark-junk-as-spam-routine ()
 391   ;; check the global list of group names spam-junk-mailgroups and the
 392   ;; group parameters
 393   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 394     (gnus-message 5 "Marking unread articles as spam")
 395     (let ((articles gnus-newsgroup-articles)
 396           article)
 397       (while articles
 398         (setq article (pop articles))
 399         (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
 400           (gnus-summary-mark-article article gnus-spam-mark))))))
 401
 402 (defun spam-mark-spam-as-expired-and-move-routine (&optional group)
 403   (let ((articles gnus-newsgroup-articles)
 404         article)
 405     (while articles
 406       (setq article (pop articles))
 407       (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 408         (gnus-summary-mark-article article gnus-expirable-mark)
 409         (when (stringp group)
 410           (let ((gnus-current-article article))
 411             (gnus-summary-move-article nil group)))))))
 412
 413 (defun spam-ham-move-routine (&optional group)
 414   (let ((articles gnus-newsgroup-articles)
 415         article ham-mark-values mark)
 416
 417     (dolist (mark spam-ham-marks)
 418       (push (symbol-value mark) ham-mark-values))
 419
 420     (dolist (article articles)
 421       (when (and (memq (gnus-summary-article-mark article) ham-mark-values)
 422                  (stringp group))
 423         (let ((gnus-current-article article))
 424           (gnus-summary-move-article nil group))))))
 425
 426 (defun spam-generic-register-routine (spam-func ham-func)
 427   (let ((articles gnus-newsgroup-articles)
 428         article mark ham-articles spam-articles spam-mark-values
 429         ham-mark-values)
 430
 431     ;; marks are stored as symbolic values, so we have to dereference
 432     ;; them for memq to work.  we wouldn't have to do this if
 433     ;; gnus-summary-article-mark returned a symbol.
 434     (dolist (mark spam-ham-marks)
 435       (push (symbol-value mark) ham-mark-values))
 436
 437     (dolist (mark spam-spam-marks)
 438       (push (symbol-value mark) spam-mark-values))
 439
 440     (while articles
 441       (setq article (pop articles)
 442             mark (gnus-summary-article-mark article))
 443       (cond ((memq mark spam-mark-values) (push article spam-articles))
 444             ((memq article gnus-newsgroup-saved))
 445             ((memq mark ham-mark-values) (push article ham-articles))))
 446     (when (and ham-articles ham-func)
 447       (mapc ham-func ham-articles))     ; we use mapc because unlike
 448                                         ; mapcar it discards the
 449                                         ; return values
 450     (when (and spam-articles spam-func)
 451       (mapc spam-func spam-articles)))) ; we use mapc because unlike
 452                                         ; mapcar it discards the
 453                                         ; return values
 454
 455 (eval-and-compile
 456   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 457                                    'point-at-eol
 458                                  'line-end-position)))
 459
 460 (defun spam-get-article-as-string (article)
 461   (let ((article-buffer (spam-get-article-as-buffer article))
 462                         article-string)
 463     (when article-buffer
 464       (save-window-excursion
 465         (set-buffer article-buffer)
 466         (setq article-string (buffer-string))))
 467   article-string))
 468
 469 (defun spam-get-article-as-buffer (article)
 470   (let ((article-buffer))
 471     (when (numberp article)
 472       (save-window-excursion
 473         (gnus-summary-goto-subject article)
 474         (gnus-summary-show-article t)
 475         (setq article-buffer (get-buffer gnus-article-buffer))))
 476     article-buffer))
 477
 478 (defun spam-get-article-as-filename (article)
 479   (let ((article-filename))
 480     (when (numberp article)
 481       (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name))
 482       (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory)))
 483     (if (file-exists-p article-filename)
 484         article-filename
 485       nil)))
 486
 487 (defun spam-fetch-field-from-fast (article)
 488   "Fetch the `from' field quickly, using the internal gnus-data-list function"
 489   (if (and (numberp article)
 490            (assoc article (gnus-data-list nil)))
 491       (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
 492     nil))
 493
 494 (defun spam-fetch-field-subject-fast (article)
 495   "Fetch the `subject' field quickly, using the internal gnus-data-list function"
 496   (if (and (numberp article)
 497            (assoc article (gnus-data-list nil)))
 498       (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
 499     nil))
 500
 501 \f
 502 ;;;; Spam determination.
 503
 504 (defvar spam-list-of-checks
 505   '((spam-use-blacklist                 .       spam-check-blacklist)
 506     (spam-use-regex-headers             .       spam-check-regex-headers)
 507     (spam-use-whitelist                 .       spam-check-whitelist)
 508     (spam-use-BBDB                      .       spam-check-BBDB)
 509     (spam-use-ifile                     .       spam-check-ifile)
 510     (spam-use-stat                      .       spam-check-stat)
 511     (spam-use-blackholes                .       spam-check-blackholes)
 512     (spam-use-bogofilter-headers        .       spam-check-bogofilter-headers)
 513     (spam-use-bogofilter                .       spam-check-bogofilter))
 514 "The spam-list-of-checks list contains pairs associating a parameter
 515 variable with a spam checking function.  If the parameter variable is
 516 true, then the checking function is called, and its value decides what
 517 happens.  Each individual check may return nil, t, or a mailgroup
 518 name.  The value nil means that the check does not yield a decision,
 519 and so, that further checks are needed.  The value t means that the
 520 message is definitely not spam, and that further spam checks should be
 521 inhibited.  Otherwise, a mailgroup name is returned where the mail
 522 should go, and further checks are also inhibited.  The usual mailgroup
 523 name is the value of `spam-split-group', meaning that the message is
 524 definitely a spam.")
 525
 526 (defun spam-split ()
 527   "Split this message into the `spam' group if it is spam.
 528 This function can be used as an entry in `nnmail-split-fancy', for
 529 example like this: (: spam-split)
 530
 531 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 532   (interactive)
 533
 534   ;; load the spam-stat tables if needed
 535   (when spam-use-stat (spam-stat-load))
 536
 537   (let ((list-of-checks spam-list-of-checks)
 538         decision)
 539     (while (and list-of-checks (not decision))
 540       (let ((pair (pop list-of-checks)))
 541         (when (symbol-value (car pair))
 542           (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair)))
 543           (setq decision (funcall (cdr pair))))))
 544     (if (eq decision t)
 545         nil
 546       decision)))
 547 \f
 548 ;;;; Regex headers
 549
 550 (defun spam-check-regex-headers ()
 551   (let (ret found)
 552     (dolist (h-regex spam-regex-headers-ham)
 553       (unless found
 554         (goto-char (point-min))
 555         (when (re-search-forward h-regex nil t)
 556           (message "Ham regex header search positive.")
 557           (setq found t))))
 558     (dolist (s-regex spam-regex-headers-spam)
 559       (unless found
 560         (goto-char (point-min))
 561         (when (re-search-forward s-regex nil t)
 562           (message "Spam regex header search positive." (match-string 1))
 563           (setq found t)
 564           (setq ret spam-split-group))))
 565     ret))
 566
 567 \f
 568 ;;;; Blackholes.
 569
 570 (defun spam-check-blackholes ()
 571   "Check the Received headers for blackholed relays."
 572   (let ((headers (message-fetch-field "received"))
 573         ips matches)
 574     (when headers
 575       (with-temp-buffer
 576         (insert headers)
 577         (goto-char (point-min))
 578         (gnus-message 5 "Checking headers for relay addresses")
 579         (while (re-search-forward
 580                 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
 581           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
 582           (push (mapconcat 'identity
 583                            (nreverse (split-string (match-string 1) "\\."))
 584                            ".")
 585                 ips)))
 586       (dolist (server spam-blackhole-servers)
 587         (dolist (ip ips)
 588           (unless (and spam-blackhole-good-server-regex
 589                        (string-match spam-blackhole-good-server-regex ip))
 590             (let ((query-string (concat ip "." server)))
 591               (if spam-use-dig
 592                   (let ((query-result (query-dig query-string)))
 593                     (when query-result
 594                       (gnus-message 5 "(DIG): positive blackhole check '%s'" query-result)
 595                       (push (list ip server query-result)
 596                             matches)))
 597                 ;; else, if not using dig.el
 598                 (when (query-dns query-string)
 599                   (gnus-message 5 "positive blackhole check")
 600                   (push (list ip server (query-dns query-string 'TXT))
 601                         matches))))))))
 602     (when matches
 603       spam-split-group)))
 604 \f
 605 ;;;; BBDB
 606
 607 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
 608 ;;; <sacha@giotto.sj.ru>
 609
 610 ;; all this is done inside a condition-case to trap errors
 611
 612 (condition-case nil
 613     (progn
 614       (require 'bbdb)
 615       (require 'bbdb-com)
 616
 617   (defun spam-enter-ham-BBDB (from)
 618     "Enter an address into the BBDB; implies ham (non-spam) sender"
 619     (when (stringp from)
 620       (let* ((parsed-address (gnus-extract-address-components from))
 621              (name (or (car parsed-address) "Ham Sender"))
 622              (net-address (car (cdr parsed-address))))
 623         (gnus-message 5 "Adding address %s to BBDB" from)
 624         (when (and net-address
 625                    (not (bbdb-search-simple nil net-address)))
 626           (bbdb-create-internal name nil net-address nil nil
 627                                 "ham sender added by spam.el")))))
 628
 629   (defun spam-BBDB-register-routine ()
 630     (spam-generic-register-routine
 631      ;; spam function
 632      nil
 633      ;; ham function
 634      (lambda (article)
 635        (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 636
 637   (defun spam-check-BBDB ()
 638     "Mail from people in the BBDB is never considered spam"
 639     (let ((who (message-fetch-field "from")))
 640       (when who
 641         (setq who (cadr (gnus-extract-address-components who)))
 642         (if (bbdb-search-simple nil who)
 643             nil spam-split-group)))))
 644
 645   (file-error (progn
 646                 (defalias 'bbdb-search-simple 'ignore)
 647                 (defalias 'spam-check-BBDB 'ignore)
 648                 (defalias 'spam-BBDB-register-routine 'ignore)
 649                 (defalias 'spam-enter-ham-BBDB 'ignore)
 650                 (defalias 'bbdb-create-internal 'ignore)
 651                 (defalias 'bbdb-records 'ignore))))
 652
 653 \f
 654 ;;;; ifile
 655
 656 ;;; check the ifile backend; return nil if the mail was NOT classified
 657 ;;; as spam
 658
 659 (defun spam-get-ifile-database-parameter ()
 660   "Get the command-line parameter for ifile's database from spam-ifile-database-path."
 661   (if spam-ifile-database-path
 662       (format "--db-file=%s" spam-ifile-database-path)
 663     nil))
 664
 665 (defun spam-check-ifile ()
 666   "Check the ifile backend for the classification of this message"
 667   (let ((article-buffer-name (buffer-name))
 668         category return)
 669     (with-temp-buffer
 670       (let ((temp-buffer-name (buffer-name))
 671             (db-param (spam-get-ifile-database-parameter)))
 672         (save-excursion
 673           (set-buffer article-buffer-name)
 674           (if db-param
 675               (call-process-region (point-min) (point-max) spam-ifile-path
 676                                    nil temp-buffer-name nil "-q" "-c" db-param)
 677             (call-process-region (point-min) (point-max) spam-ifile-path
 678                                  nil temp-buffer-name nil "-q" "-c")))
 679         (goto-char (point-min))
 680         (if (not (eobp))
 681             (setq category (buffer-substring (point) (spam-point-at-eol))))
 682         (when (not (zerop (length category))) ; we need a category here
 683           (if spam-ifile-all-categories
 684               (setq return category)
 685             ;; else, if spam-ifile-all-categories is not set...
 686             (when (string-equal spam-ifile-spam-category category)
 687               (setq return spam-split-group))))))
 688     return))
 689
 690 (defun spam-ifile-register-with-ifile (article-string category)
 691   "Register an article, given as a string, with a category.
 692 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 693   (when (stringp article-string)
 694     (let ((category (or category gnus-newsgroup-name))
 695           (db-param (spam-get-ifile-database-parameter)))
 696       (with-temp-buffer
 697         (insert-string article-string)
 698         (if db-param
 699             (call-process-region (point-min) (point-max) spam-ifile-path
 700                                  nil nil nil
 701                                  "-h" "-i" category db-param)
 702           (call-process-region (point-min) (point-max) spam-ifile-path
 703                                nil nil nil
 704                                "-h" "-i" category))))))
 705
 706 (defun spam-ifile-register-spam-routine ()
 707   (spam-generic-register-routine
 708    (lambda (article)
 709      (spam-ifile-register-with-ifile
 710       (spam-get-article-as-string article) spam-ifile-spam-category))
 711    nil))
 712
 713 (defun spam-ifile-register-ham-routine ()
 714   (spam-generic-register-routine
 715    nil
 716    (lambda (article)
 717      (spam-ifile-register-with-ifile
 718       (spam-get-article-as-string article) spam-ifile-ham-category))))
 719
 720 \f
 721 ;;;; spam-stat
 722
 723 (condition-case nil
 724     (progn
 725       (let ((spam-stat-install-hooks nil))
 726         (require 'spam-stat))
 727
 728       (defun spam-check-stat ()
 729         "Check the spam-stat backend for the classification of this message"
 730         (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
 731               (spam-stat-buffer (buffer-name)) ; stat the current buffer
 732               category return)
 733           (spam-stat-split-fancy)))
 734
 735       (defun spam-stat-register-spam-routine ()
 736         (spam-generic-register-routine
 737          (lambda (article)
 738            (let ((article-string (spam-get-article-as-string article)))
 739              (with-temp-buffer
 740                (insert-string article-string)
 741                (spam-stat-buffer-is-spam))))
 742          nil)
 743         (spam-stat-save))
 744
 745       (defun spam-stat-register-ham-routine ()
 746         (spam-generic-register-routine
 747          nil
 748          (lambda (article)
 749            (let ((article-string (spam-get-article-as-string article)))
 750              (with-temp-buffer
 751                (insert-string article-string)
 752                (spam-stat-buffer-is-non-spam)))))
 753         (spam-stat-save)))
 754
 755   (file-error (progn
 756                 (defalias 'spam-stat-register-ham-routine 'ignore)
 757                 (defalias 'spam-stat-register-spam-routine 'ignore)
 758                 (defalias 'spam-stat-buffer-is-spam 'ignore)
 759                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
 760                 (defalias 'spam-stat-split-fancy 'ignore)
 761                 (defalias 'spam-stat-load 'ignore)
 762                 (defalias 'spam-stat-save 'ignore)
 763                 (defalias 'spam-check-stat 'ignore))))
 764
 765 \f
 766
 767 ;;;; Blacklists and whitelists.
 768
 769 (defvar spam-whitelist-cache nil)
 770 (defvar spam-blacklist-cache nil)
 771
 772 (defun spam-enter-whitelist (address)
 773   "Enter ADDRESS into the whitelist."
 774   (interactive "sAddress: ")
 775   (spam-enter-list address spam-whitelist)
 776   (setq spam-whitelist-cache nil))
 777
 778 (defun spam-enter-blacklist (address)
 779   "Enter ADDRESS into the blacklist."
 780   (interactive "sAddress: ")
 781   (spam-enter-list address spam-blacklist)
 782   (setq spam-blacklist-cache nil))
 783
 784 (defun spam-enter-list (address file)
 785   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 786   (unless (file-exists-p (file-name-directory file))
 787     (make-directory (file-name-directory file) t))
 788   (save-excursion
 789     (set-buffer
 790      (find-file-noselect file))
 791     (goto-char (point-max))
 792     (unless (bobp)
 793       (insert "\n"))
 794     (insert address "\n")
 795     (save-buffer)))
 796
 797 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
 798 (defun spam-check-whitelist ()
 799   ;; FIXME!  Should it detect when file timestamps change?
 800   (unless spam-whitelist-cache
 801     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 802   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
 803
 804 (defun spam-check-blacklist ()
 805   ;; FIXME!  Should it detect when file timestamps change?
 806   (unless spam-blacklist-cache
 807     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 808   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 809
 810 (defun spam-parse-list (file)
 811   (when (file-readable-p file)
 812     (let (contents address)
 813       (with-temp-buffer
 814         (insert-file-contents file)
 815         (while (not (eobp))
 816           (setq address (buffer-substring (point) (spam-point-at-eol)))
 817           (forward-line 1)
 818           (unless (zerop (length address))
 819             (setq address (regexp-quote address))
 820             (while (string-match "\\\\\\*" address)
 821               (setq address (replace-match ".*" t t address)))
 822             (push address contents))))
 823       (nreverse contents))))
 824
 825 (defun spam-from-listed-p (cache)
 826   (let ((from (message-fetch-field "from"))
 827         found)
 828     (while cache
 829       (when (string-match (pop cache) from)
 830         (setq found t
 831               cache nil)))
 832     found))
 833
 834 (defun spam-blacklist-register-routine ()
 835   (spam-generic-register-routine
 836    ;; the spam function
 837    (lambda (article)
 838      (let ((from (spam-fetch-field-from-fast article)))
 839        (when (stringp from)
 840            (spam-enter-blacklist from))))
 841    ;; the ham function
 842    nil))
 843
 844 (defun spam-whitelist-register-routine ()
 845   (spam-generic-register-routine
 846    ;; the spam function
 847    nil
 848    ;; the ham function
 849    (lambda (article)
 850      (let ((from (spam-fetch-field-from-fast article)))
 851        (when (stringp from)
 852            (spam-enter-whitelist from))))))
 853
 854 \f
 855 ;;;; Bogofilter
 856
 857 (defun spam-check-bogofilter-headers (&optional score)
 858   (let ((header (message-fetch-field spam-bogofilter-header)))
 859       (when (and header
 860                  (string-match spam-bogofilter-bogosity-positive-spam-header
 861                                header))
 862           (if score
 863               (when (string-match "spamicity=\\([0-9.]+\\)" header)
 864                 (match-string 1 header))
 865             spam-split-group))))
 866
 867 ;; return something sensible if the score can't be determined
 868 (defun spam-bogofilter-score ()
 869   "Get the Bogofilter spamicity score"
 870   (interactive)
 871   (save-window-excursion
 872     (gnus-summary-show-article t)
 873     (set-buffer gnus-article-buffer)
 874     (let ((score (spam-check-bogofilter t)))
 875       (message "Spamicity score %s" score)
 876       (or score "0"))))
 877
 878 (defun spam-check-bogofilter (&optional score)
 879   "Check the Bogofilter backend for the classification of this message"
 880   (let ((article-buffer-name (buffer-name))
 881         return)
 882     (with-temp-buffer
 883       (let ((temp-buffer-name (buffer-name)))
 884         (save-excursion
 885           (set-buffer article-buffer-name)
 886           (if spam-bogofilter-database-directory
 887               (call-process-region (point-min) (point-max)
 888                                    spam-bogofilter-path
 889                                    nil temp-buffer-name nil "-v"
 890                                    "-d" spam-bogofilter-database-directory)
 891             (call-process-region (point-min) (point-max) spam-bogofilter-path
 892                                  nil temp-buffer-name nil "-v")))
 893         (setq return (spam-check-bogofilter-headers score))))
 894     return))
 895
 896 (defun spam-bogofilter-register-with-bogofilter (article-string spam)
 897   "Register an article, given as a string, as spam or non-spam."
 898   (when (stringp article-string)
 899     (let ((switch (if spam "-s" "-n")))
 900       (with-temp-buffer
 901         (insert-string article-string)
 902         (if spam-bogofilter-database-directory
 903             (call-process-region (point-min) (point-max)
 904                                  spam-bogofilter-path
 905                                  nil nil nil "-v" switch
 906                                  "-d" spam-bogofilter-database-directory)
 907           (call-process-region (point-min) (point-max) spam-bogofilter-path
 908                                nil nil nil "-v" switch))))))
 909
 910 (defun spam-bogofilter-register-spam-routine ()
 911   (spam-generic-register-routine
 912    (lambda (article)
 913      (spam-bogofilter-register-with-bogofilter
 914       (spam-get-article-as-string article) t))
 915    nil))
 916
 917 (defun spam-bogofilter-register-ham-routine ()
 918   (spam-generic-register-routine
 919    nil
 920    (lambda (article)
 921      (spam-bogofilter-register-with-bogofilter
 922       (spam-get-article-as-string article) nil))))
 923
 924 (provide 'spam)
 925
 926 ;;; spam.el ends here.