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