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