git.chise.org Git - elisp/gnus.git-/blob - lisp/spam.el

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