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