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

   1 ;;; spam.el --- Identifying spam
   2 ;; Copyright (C) 2002, 2003, 2004 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 ;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
  36 ;; remote processing, training through files
  37
  38 ;;; Code:
  39
  40 (eval-when-compile (require 'cl))
  41
  42 (require 'gnus-sum)
  43
  44 (require 'gnus-uu)                      ; because of key prefix issues
  45 ;;; for the definitions of group content classification and spam processors
  46 (require 'gnus)
  47 (require 'message)              ;for the message-fetch-field functions
  48
  49 ;; for nnimap-split-download-body-default
  50 (eval-when-compile (require 'nnimap))
  51
  52 ;; autoload executable-find
  53 (eval-and-compile
  54   ;; executable-find is not autoloaded in Emacs 20
  55   (autoload 'executable-find "executable"))
  56
  57 ;; autoload query-dig
  58 (eval-and-compile
  59   (autoload 'query-dig "dig"))
  60
  61 ;; autoload spam-report
  62 (eval-and-compile
  63   (autoload 'spam-report-gmane "spam-report"))
  64
  65 ;; autoload gnus-registry
  66 (eval-and-compile
  67   (autoload 'gnus-registry-group-count "gnus-registry")
  68   (autoload 'gnus-registry-add-group "gnus-registry")
  69   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
  70   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
  71
  72 ;; autoload query-dns
  73 (eval-and-compile
  74   (autoload 'query-dns "dns"))
  75
  76 ;;; Main parameters.
  77
  78 (defgroup spam nil
  79   "Spam configuration.")
  80
  81 (defcustom spam-directory "~/News/spam/"
  82   "Directory for spam whitelists and blacklists."
  83   :type 'directory
  84   :group 'spam)
  85
  86 (defcustom spam-move-spam-nonspam-groups-only t
  87   "Whether spam should be moved in non-spam groups only.
  88 When t, only ham and unclassified groups will have their spam moved
  89 to the spam-process-destination.  When nil, spam will also be moved from
  90 spam groups."
  91   :type 'boolean
  92   :group 'spam)
  93
  94 (defcustom spam-process-ham-in-nonham-groups nil
  95   "Whether ham should be processed in non-ham groups."
  96   :type 'boolean
  97   :group 'spam)
  98
  99 (defcustom spam-log-to-registry nil
 100   "Whether spam/ham processing should be logged in the registry."
 101   :type 'boolean
 102   :group 'spam)
 103
 104 (defcustom spam-split-symbolic-return nil
 105   "Whether `spam-split' should work with symbols or group names."
 106   :type 'boolean
 107   :group 'spam)
 108
 109 (defcustom spam-split-symbolic-return-positive nil
 110   "Whether `spam-split' should ALWAYS work with symbols or group names.
 111 Do not set this if you use `spam-split' in a fancy split
 112   method."
 113   :type 'boolean
 114   :group 'spam)
 115
 116 (defcustom spam-process-ham-in-spam-groups nil
 117   "Whether ham should be processed in spam groups."
 118   :type 'boolean
 119   :group 'spam)
 120
 121 (defcustom spam-mark-only-unseen-as-spam t
 122   "Whether only unseen articles should be marked as spam in spam groups.
 123 When nil, all unread articles in a spam group are marked as
 124 spam.  Set this if you want to leave an article unread in a spam group
 125 without losing it to the automatic spam-marking process."
 126   :type 'boolean
 127   :group 'spam)
 128
 129 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
 130   "Whether ham should be marked unread before it's moved.
 131 The article is moved out of a spam group according to ham-process-destination.
 132 This variable is an official entry in the international Longest Variable Name
 133 Competition."
 134   :type 'boolean
 135   :group 'spam)
 136
 137 (defcustom spam-disable-spam-split-during-ham-respool nil
 138   "Whether `spam-split' should be ignored while resplitting ham in a process
 139 destination.  This is useful to prevent ham from ending up in the same spam
 140 group after the resplit.  Don't set this to t if you have spam-split as the
 141 last rule in your split configuration."
 142   :type 'boolean
 143   :group 'spam)
 144
 145 (defcustom spam-autodetect-recheck-messages nil
 146   "Should spam.el recheck all meessages when autodetecting?
 147 Normally this is nil, so only unseen messages will be checked."
 148   :type 'boolean
 149   :group 'spam)
 150
 151 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
 152   "The location of the whitelist.
 153 The file format is one regular expression per line.
 154 The regular expression is matched against the address."
 155   :type 'file
 156   :group 'spam)
 157
 158 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
 159   "The location of the blacklist.
 160 The file format is one regular expression per line.
 161 The regular expression is matched against the address."
 162   :type 'file
 163   :group 'spam)
 164
 165 (defcustom spam-use-dig t
 166   "Whether `query-dig' should be used instead of `query-dns'."
 167   :type 'boolean
 168   :group 'spam)
 169
 170 (defcustom spam-use-blacklist nil
 171   "Whether the blacklist should be used by `spam-split'."
 172   :type 'boolean
 173   :group 'spam)
 174
 175 (defcustom spam-blacklist-ignored-regexes nil
 176   "Regular expressions that the blacklist should ignore."
 177   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
 178   :group 'spam)
 179
 180 (defcustom spam-use-whitelist nil
 181   "Whether the whitelist should be used by `spam-split'."
 182   :type 'boolean
 183   :group 'spam)
 184
 185 (defcustom spam-use-whitelist-exclusive nil
 186   "Whether whitelist-exclusive should be used by `spam-split'.
 187 Exclusive whitelisting means that all messages from senders not in the whitelist
 188 are considered spam."
 189   :type 'boolean
 190   :group 'spam)
 191
 192 (defcustom spam-use-blackholes nil
 193   "Whether blackholes should be used by `spam-split'."
 194   :type 'boolean
 195   :group 'spam)
 196
 197 (defcustom spam-use-hashcash nil
 198   "Whether hashcash payments should be detected by `spam-split'."
 199   :type 'boolean
 200   :group 'spam)
 201
 202 (defcustom spam-use-regex-headers nil
 203   "Whether a header regular expression match should be used by `spam-split'.
 204 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
 205   :type 'boolean
 206   :group 'spam)
 207
 208 (defcustom spam-use-regex-body nil
 209   "Whether a body regular expression match should be used by `spam-split'.
 210 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
 211   :type 'boolean
 212   :group 'spam)
 213
 214 (defcustom spam-use-bogofilter-headers nil
 215   "Whether bogofilter headers should be used by `spam-split'.
 216 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 217   :type 'boolean
 218   :group 'spam)
 219
 220 (defcustom spam-use-bogofilter nil
 221   "Whether bogofilter should be invoked by `spam-split'.
 222 Enable this if you want Gnus to invoke Bogofilter on new messages."
 223   :type 'boolean
 224   :group 'spam)
 225
 226 (defcustom spam-use-BBDB nil
 227   "Whether BBDB should be used by `spam-split'."
 228   :type 'boolean
 229   :group 'spam)
 230
 231 (defcustom spam-use-BBDB-exclusive nil
 232   "Whether BBDB-exclusive should be used by `spam-split'.
 233 Exclusive BBDB means that all messages from senders not in the BBDB are
 234 considered spam."
 235   :type 'boolean
 236   :group 'spam)
 237
 238 (defcustom spam-use-ifile nil
 239   "Whether ifile should be used by `spam-split'."
 240   :type 'boolean
 241   :group 'spam)
 242
 243 (defcustom spam-use-stat nil
 244   "Whether `spam-stat' should be used by `spam-split'."
 245   :type 'boolean
 246   :group 'spam)
 247
 248 (defcustom spam-use-spamoracle nil
 249   "Whether spamoracle should be used by `spam-split'."
 250   :type 'boolean
 251   :group 'spam)
 252
 253 (defcustom spam-install-hooks (or
 254                                spam-use-dig
 255                                spam-use-blacklist
 256                                spam-use-whitelist
 257                                spam-use-whitelist-exclusive
 258                                spam-use-blackholes
 259                                spam-use-hashcash
 260                                spam-use-regex-headers
 261                                spam-use-regex-body
 262                                spam-use-bogofilter-headers
 263                                spam-use-bogofilter
 264                                spam-use-BBDB
 265                                spam-use-BBDB-exclusive
 266                                spam-use-ifile
 267                                spam-use-stat
 268                                spam-use-spamoracle)
 269   "Whether the spam hooks should be installed.
 270 Default to t if one of the spam-use-* variables is set."
 271   :group 'spam
 272   :type 'boolean)
 273
 274 (defcustom spam-split-group "spam"
 275   "Group name where incoming spam should be put by `spam-split'."
 276   :type 'string
 277   :group 'spam)
 278
 279 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
 280 ;;; not regular expressions
 281 (defcustom spam-junk-mailgroups (cons
 282                                  spam-split-group
 283                                  '("mail.junk" "poste.pourriel"))
 284   "Mailgroups with spam contents.
 285 All unmarked article in such group receive the spam mark on group entry."
 286   :type '(repeat (string :tag "Group"))
 287   :group 'spam)
 288
 289 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 290                                     "dev.null.dk" "relays.visi.com")
 291   "List of blackhole servers."
 292   :type '(repeat (string :tag "Server"))
 293   :group 'spam)
 294
 295 (defcustom spam-blackhole-good-server-regex nil
 296   "String matching IP addresses that should not be checked in the blackholes."
 297   :type '(radio (const nil)
 298                 (regexp :format "%t: %v\n" :size 0))
 299   :group 'spam)
 300
 301 (defcustom spam-face 'gnus-splash-face
 302   "Face for spam-marked articles."
 303   :type 'face
 304   :group 'spam)
 305
 306 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 307   "Regular expression for positive header spam matches."
 308   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 309   :group 'spam)
 310
 311 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 312   "Regular expression for positive header ham matches."
 313   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 314   :group 'spam)
 315
 316 (defcustom spam-regex-body-spam '()
 317   "Regular expression for positive body spam matches."
 318   :type '(repeat (regexp :tag "Regular expression to match spam body"))
 319   :group 'spam)
 320
 321 (defcustom spam-regex-body-ham '()
 322   "Regular expression for positive body ham matches."
 323   :type '(repeat (regexp :tag "Regular expression to match ham body"))
 324   :group 'spam)
 325
 326 (defgroup spam-ifile nil
 327   "Spam ifile configuration."
 328   :group 'spam)
 329
 330 (defcustom spam-ifile-path (executable-find "ifile")
 331   "File path of the ifile executable program."
 332   :type '(choice (file :tag "Location of ifile")
 333                  (const :tag "ifile is not installed"))
 334   :group 'spam-ifile)
 335
 336 (defcustom spam-ifile-database-path nil
 337   "File path of the ifile database."
 338   :type '(choice (file :tag "Location of the ifile database")
 339                  (const :tag "Use the default"))
 340   :group 'spam-ifile)
 341
 342 (defcustom spam-ifile-spam-category "spam"
 343   "Name of the spam ifile category."
 344   :type 'string
 345   :group 'spam-ifile)
 346
 347 (defcustom spam-ifile-ham-category nil
 348   "Name of the ham ifile category.
 349 If nil, the current group name will be used."
 350   :type '(choice (string :tag "Use a fixed category")
 351                  (const :tag "Use the current group name"))
 352   :group 'spam-ifile)
 353
 354 (defcustom spam-ifile-all-categories nil
 355   "Whether the ifile check will return all categories, or just spam.
 356 Set this to t if you want to use the `spam-split' invocation of ifile as
 357 your main source of newsgroup names."
 358   :type 'boolean
 359   :group 'spam-ifile)
 360
 361 (defgroup spam-bogofilter nil
 362   "Spam bogofilter configuration."
 363   :group 'spam)
 364
 365 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 366   "File path of the Bogofilter executable program."
 367   :type '(choice (file :tag "Location of bogofilter")
 368                  (const :tag "Bogofilter is not installed"))
 369   :group 'spam-bogofilter)
 370
 371 (defcustom spam-bogofilter-header "X-Bogosity"
 372   "The header that Bogofilter inserts in messages."
 373   :type 'string
 374   :group 'spam-bogofilter)
 375
 376 (defcustom spam-bogofilter-spam-switch "-s"
 377   "The switch that Bogofilter uses to register spam messages."
 378   :type 'string
 379   :group 'spam-bogofilter)
 380
 381 (defcustom spam-bogofilter-ham-switch "-n"
 382   "The switch that Bogofilter uses to register ham messages."
 383   :type 'string
 384   :group 'spam-bogofilter)
 385
 386 (defcustom spam-bogofilter-spam-strong-switch "-S"
 387   "The switch that Bogofilter uses to unregister ham messages."
 388   :type 'string
 389   :group 'spam-bogofilter)
 390
 391 (defcustom spam-bogofilter-ham-strong-switch "-N"
 392   "The switch that Bogofilter uses to unregister spam messages."
 393   :type 'string
 394   :group 'spam-bogofilter)
 395
 396 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 397   "The regex on `spam-bogofilter-header' for positive spam identification."
 398   :type 'regexp
 399   :group 'spam-bogofilter)
 400
 401 (defcustom spam-bogofilter-database-directory nil
 402   "Directory path of the Bogofilter databases."
 403   :type '(choice (directory
 404                   :tag "Location of the Bogofilter database directory")
 405                  (const :tag "Use the default"))
 406   :group 'spam-bogofilter)
 407
 408 (defgroup spam-spamoracle nil
 409   "Spam spamoracle configuration."
 410   :group 'spam)
 411
 412 (defcustom spam-spamoracle-database nil
 413   "Location of spamoracle database file. When nil, use the default
 414 spamoracle database."
 415   :type '(choice (directory :tag "Location of spamoracle database file.")
 416                  (const :tag "Use the default"))
 417   :group 'spam-spamoracle)
 418
 419 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
 420   "Location of the spamoracle binary."
 421   :type '(choice (directory :tag "Location of the spamoracle binary")
 422                  (const :tag "Use the default"))
 423   :group 'spam-spamoracle)
 424
 425 ;;; Key bindings for spam control.
 426
 427 (gnus-define-keys gnus-summary-mode-map
 428   "St" spam-bogofilter-score
 429   "Sx" gnus-summary-mark-as-spam
 430   "Mst" spam-bogofilter-score
 431   "Msx" gnus-summary-mark-as-spam
 432   "\M-d" gnus-summary-mark-as-spam)
 433
 434 (defvar spam-old-ham-articles nil
 435   "List of old ham articles, generated when a group is entered.")
 436
 437 (defvar spam-old-spam-articles nil
 438   "List of old spam articles, generated when a group is entered.")
 439
 440 (defvar spam-split-disabled nil
 441   "If non-nil, `spam-split' is disabled, and always returns nil.")
 442
 443 (defvar spam-split-last-successful-check nil
 444   "`spam-split' will set this to nil or a spam-use-XYZ check if it
 445   finds ham or spam.")
 446
 447 ;; convenience functions
 448 (defun spam-xor (a b)
 449   "Logical exclusive `or'."
 450   (and (or a b) (not (and a b))))
 451
 452 (defun spam-group-ham-mark-p (group mark &optional spam)
 453   (when (stringp group)
 454     (let* ((marks (spam-group-ham-marks group spam))
 455            (marks (if (symbolp mark)
 456                       marks
 457                     (mapcar 'symbol-value marks))))
 458       (memq mark marks))))
 459
 460 (defun spam-group-spam-mark-p (group mark)
 461   (spam-group-ham-mark-p group mark t))
 462
 463 (defun spam-group-ham-marks (group &optional spam)
 464   (when (stringp group)
 465     (let* ((marks (if spam
 466                       (gnus-parameter-spam-marks group)
 467                     (gnus-parameter-ham-marks group)))
 468            (marks (car marks))
 469            (marks (if (listp (car marks)) (car marks) marks)))
 470       marks)))
 471
 472 (defun spam-group-spam-marks (group)
 473   (spam-group-ham-marks group t))
 474
 475 (defun spam-group-spam-contents-p (group)
 476   (if (stringp group)
 477       (or (member group spam-junk-mailgroups)
 478           (memq 'gnus-group-spam-classification-spam
 479                 (gnus-parameter-spam-contents group)))
 480     nil))
 481
 482 (defun spam-group-ham-contents-p (group)
 483   (if (stringp group)
 484       (memq 'gnus-group-spam-classification-ham
 485             (gnus-parameter-spam-contents group))
 486     nil))
 487
 488 (defvar spam-list-of-processors
 489   '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
 490     (gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
 491     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
 492     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
 493     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
 494     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
 495     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
 496     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
 497     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
 498     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
 499     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
 500     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
 501     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
 502   "The spam-list-of-processors list contains pairs associating a
 503 ham/spam exit processor variable with a classification and a
 504 spam-use-* variable.")
 505
 506 (defun spam-group-processor-p (group processor)
 507   (if (and (stringp group)
 508            (symbolp processor))
 509       (or (member processor (nth 0 (gnus-parameter-spam-process group)))
 510           (spam-group-processor-multiple-p
 511            group
 512            (cdr-safe (assoc processor spam-list-of-processors))))
 513     nil))
 514
 515 (defun spam-group-processor-multiple-p (group processor-info)
 516   (let* ((classification (nth 0 processor-info))
 517          (check (nth 1 processor-info))
 518          (parameters (nth 0 (gnus-parameter-spam-process group)))
 519          found)
 520     (dolist (parameter parameters)
 521       (when (and (null found)
 522                  (listp parameter)
 523                  (eq classification (nth 0 parameter))
 524                  (eq check (nth 1 parameter)))
 525         (setq found t)))
 526     found))
 527
 528 (defun spam-group-spam-processor-report-gmane-p (group)
 529   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
 530
 531 (defun spam-group-spam-processor-bogofilter-p (group)
 532   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 533
 534 (defun spam-group-spam-processor-blacklist-p (group)
 535   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 536
 537 (defun spam-group-spam-processor-ifile-p (group)
 538   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 539
 540 (defun spam-group-ham-processor-ifile-p (group)
 541   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 542
 543 (defun spam-group-spam-processor-spamoracle-p (group)
 544   (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
 545
 546 (defun spam-group-ham-processor-bogofilter-p (group)
 547   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 548
 549 (defun spam-group-spam-processor-stat-p (group)
 550   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 551
 552 (defun spam-group-ham-processor-stat-p (group)
 553   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 554
 555 (defun spam-group-ham-processor-whitelist-p (group)
 556   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 557
 558 (defun spam-group-ham-processor-BBDB-p (group)
 559   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 560
 561 (defun spam-group-ham-processor-copy-p (group)
 562   (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
 563
 564 (defun spam-group-ham-processor-spamoracle-p (group)
 565   (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
 566
 567 ;;; Summary entry and exit processing.
 568
 569 (defun spam-summary-prepare ()
 570   (setq spam-old-ham-articles
 571         (spam-list-articles gnus-newsgroup-articles 'ham))
 572   (setq spam-old-spam-articles
 573         (spam-list-articles gnus-newsgroup-articles 'spam))
 574   (spam-mark-junk-as-spam-routine))
 575
 576 ;; The spam processors are invoked for any group, spam or ham or neither
 577 (defun spam-summary-prepare-exit ()
 578   (unless gnus-group-is-exiting-without-update-p
 579     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 580
 581     ;; first of all, unregister any articles that are no longer ham or spam
 582     ;; we have to iterate over the processors, or else we'll be too slow
 583     (dolist (classification '(spam ham))
 584       (let* ((old-articles (if (eq classification 'spam)
 585                                spam-old-spam-articles
 586                              spam-old-ham-articles))
 587              (new-articles (spam-list-articles
 588                             gnus-newsgroup-articles
 589                             classification))
 590              (changed-articles (gnus-set-difference old-articles new-articles)))
 591         ;; now that we have the changed articles, we go through the processors
 592         (dolist (processor-param spam-list-of-processors)
 593           (let ((processor (nth 0 processor-param))
 594                 (processor-classification (nth 1 processor-param))
 595                 (check (nth 2 processor-param))
 596                 unregister-list)
 597             (dolist (article changed-articles)
 598               (let ((id (spam-fetch-field-message-id-fast article)))
 599                 (when (spam-log-unregistration-needed-p
 600                        id 'process classification check)
 601                   (push article unregister-list))))
 602             ;; call spam-register-routine with specific articles to unregister,
 603             ;; when there are articles to unregister and the check is enabled
 604             (when (and unregister-list (symbol-value check))
 605               (spam-register-routine classification check t unregister-list))))))
 606
 607     ;; find all the spam processors applicable to this group
 608     (dolist (processor-param spam-list-of-processors)
 609       (let ((processor (nth 0 processor-param))
 610             (classification (nth 1 processor-param))
 611             (check (nth 2 processor-param)))
 612         (when (and (eq 'spam classification)
 613                    (spam-group-processor-p gnus-newsgroup-name processor))
 614           (spam-register-routine classification check))))
 615
 616     (if spam-move-spam-nonspam-groups-only
 617         (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
 618           (spam-mark-spam-as-expired-and-move-routine
 619            (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 620       (gnus-message 5 "Marking spam as expired and moving it to %s"
 621                     gnus-newsgroup-name)
 622       (spam-mark-spam-as-expired-and-move-routine
 623        (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 624
 625     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 626     ;; expire spam, in case the above did not expire them
 627     (gnus-message 5 "Marking spam as expired without moving it")
 628     (spam-mark-spam-as-expired-and-move-routine nil)
 629
 630     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 631               (and (spam-group-spam-contents-p gnus-newsgroup-name)
 632                    spam-process-ham-in-spam-groups)
 633               spam-process-ham-in-nonham-groups)
 634       ;; find all the ham processors applicable to this group
 635       (dolist (processor-param spam-list-of-processors)
 636         (let ((processor (nth 0 processor-param))
 637               (classification (nth 1 processor-param))
 638               (check (nth 2 processor-param)))
 639           (when (and (eq 'ham classification)
 640                      (spam-group-processor-p gnus-newsgroup-name processor))
 641             (spam-register-routine classification check)))))
 642
 643     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
 644       (gnus-message 5 "Copying ham")
 645       (spam-ham-copy-routine
 646        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
 647
 648     ;; now move all ham articles out of spam groups
 649     (when (spam-group-spam-contents-p gnus-newsgroup-name)
 650       (gnus-message 5 "Moving ham messages from spam group")
 651       (spam-ham-move-routine
 652        (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 653
 654   (setq spam-old-ham-articles nil)
 655   (setq spam-old-spam-articles nil))
 656
 657 (defun spam-mark-junk-as-spam-routine ()
 658   ;; check the global list of group names spam-junk-mailgroups and the
 659   ;; group parameters
 660   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 661     (gnus-message 5 "Marking %s articles as spam"
 662                   (if spam-mark-only-unseen-as-spam
 663                       "unseen"
 664                     "unread"))
 665     (let ((articles (if spam-mark-only-unseen-as-spam
 666                         gnus-newsgroup-unseen
 667                       gnus-newsgroup-unreads)))
 668       (dolist (article articles)
 669         (gnus-summary-mark-article article gnus-spam-mark)))))
 670
 671 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
 672   (if (and (car-safe groups) (listp (car-safe groups)))
 673       (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
 674     (gnus-summary-kill-process-mark)
 675     (let ((articles gnus-newsgroup-articles)
 676           (backend-supports-deletions
 677            (gnus-check-backend-function
 678             'request-move-article gnus-newsgroup-name))
 679           article tomove deletep)
 680       (dolist (article articles)
 681         (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 682           (gnus-summary-mark-article article gnus-expirable-mark)
 683           (push article tomove)))
 684
 685       ;; now do the actual copies
 686       (dolist (group groups)
 687         (when (and tomove
 688                    (stringp group))
 689           (dolist (article tomove)
 690             (gnus-summary-set-process-mark article))
 691           (when tomove
 692             (if (or (not backend-supports-deletions)
 693                     (> (length groups) 1))
 694                 (progn
 695                   (gnus-summary-copy-article nil group)
 696                   (setq deletep t))
 697               (gnus-summary-move-article nil group)))))
 698
 699       ;; now delete the articles, if there was a copy done, and the
 700       ;; backend allows it
 701       (when (and deletep backend-supports-deletions)
 702         (dolist (article tomove)
 703           (gnus-summary-set-process-mark article))
 704         (when tomove
 705           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 706             (gnus-summary-delete-article nil))))
 707
 708       (gnus-summary-yank-process-mark))))
 709
 710 (defun spam-ham-copy-or-move-routine (copy groups)
 711   (gnus-summary-kill-process-mark)
 712   (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
 713         (backend-supports-deletions
 714          (gnus-check-backend-function
 715           'request-move-article gnus-newsgroup-name))
 716         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
 717         article mark todo deletep respool)
 718
 719     (when (member 'respool groups)
 720       (setq respool t)                  ; boolean for later
 721       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
 722
 723     ;; now do the actual move
 724     (dolist (group groups)
 725       (when (and todo (stringp group))
 726         (dolist (article todo)
 727           (when spam-mark-ham-unread-before-move-from-spam-group
 728             (gnus-summary-mark-article article gnus-unread-mark))
 729           (gnus-summary-set-process-mark article))
 730
 731         (if respool                        ; respooling is with a "fake" group
 732             (let ((spam-split-disabled
 733                    (or spam-split-disabled
 734                        spam-disable-spam-split-during-ham-respool)))
 735               (gnus-summary-respool-article nil respool-method))
 736           (if (or (not backend-supports-deletions) ; else, we are not respooling
 737                   (> (length groups) 1))
 738               (progn                ; if copying, copy and set deletep
 739                 (gnus-summary-copy-article nil group)
 740                 (setq deletep t))
 741             (gnus-summary-move-article nil group))))) ; else move articles
 742
 743     ;; now delete the articles, unless a) copy is t, and there was a copy done
 744     ;;                                 b) a move was done to a single group
 745     ;;                                 c) backend-supports-deletions is nil
 746     (unless copy
 747       (when (and deletep backend-supports-deletions)
 748         (dolist (article todo)
 749           (gnus-summary-set-process-mark article))
 750         (when todo
 751           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 752             (gnus-summary-delete-article nil))))))
 753
 754   (gnus-summary-yank-process-mark))
 755
 756 (defun spam-ham-copy-routine (&rest groups)
 757   (if (and (car-safe groups) (listp (car-safe groups)))
 758       (apply 'spam-ham-copy-routine (car groups))
 759     (spam-ham-copy-or-move-routine t groups)))
 760
 761 (defun spam-ham-move-routine (&rest groups)
 762   (if (and (car-safe groups) (listp (car-safe groups)))
 763       (apply 'spam-ham-move-routine (car groups))
 764     (spam-ham-copy-or-move-routine nil groups)))
 765
 766 (eval-and-compile
 767   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 768                                    'point-at-eol
 769                                  'line-end-position)))
 770
 771 (defun spam-get-article-as-string (article)
 772   (let ((article-buffer (spam-get-article-as-buffer article))
 773         article-string)
 774     (when article-buffer
 775       (save-window-excursion
 776         (set-buffer article-buffer)
 777         (setq article-string (buffer-string))))
 778     article-string))
 779
 780 (defun spam-get-article-as-buffer (article)
 781   (let ((article-buffer))
 782     (when (numberp article)
 783       (save-window-excursion
 784         (gnus-summary-goto-subject article)
 785         (gnus-summary-show-article t)
 786         (setq article-buffer (get-buffer gnus-article-buffer))))
 787     article-buffer))
 788
 789 ;; disabled for now
 790 ;; (defun spam-get-article-as-filename (article)
 791 ;;   (let ((article-filename))
 792 ;;     (when (numberp article)
 793 ;;       (nnml-possibly-change-directory
 794 ;;        (gnus-group-real-name gnus-newsgroup-name))
 795 ;;       (setq article-filename (expand-file-name
 796 ;;                              (int-to-string article) nnml-current-directory)))
 797 ;;     (if (file-exists-p article-filename)
 798 ;;      article-filename
 799 ;;       nil)))
 800
 801 (defun spam-fetch-field-from-fast (article)
 802   "Fetch the `from' field quickly, using the internal gnus-data-list function"
 803   (if (and (numberp article)
 804            (assoc article (gnus-data-list nil)))
 805       (mail-header-from
 806        (gnus-data-header (assoc article (gnus-data-list nil))))
 807     nil))
 808
 809 (defun spam-fetch-field-subject-fast (article)
 810   "Fetch the `subject' field quickly, using the internal
 811   gnus-data-list function"
 812   (if (and (numberp article)
 813            (assoc article (gnus-data-list nil)))
 814       (mail-header-subject
 815        (gnus-data-header (assoc article (gnus-data-list nil))))
 816     nil))
 817
 818 (defun spam-fetch-field-message-id-fast (article)
 819   "Fetch the `Message-ID' field quickly, using the internal
 820   gnus-data-list function"
 821   (if (and (numberp article)
 822            (assoc article (gnus-data-list nil)))
 823       (mail-header-message-id
 824        (gnus-data-header (assoc article (gnus-data-list nil))))
 825     nil))
 826
 827 \f
 828 ;;;; Spam determination.
 829
 830 (defvar spam-list-of-checks
 831   '((spam-use-blacklist          . spam-check-blacklist)
 832     (spam-use-regex-headers      . spam-check-regex-headers)
 833     (spam-use-regex-body         . spam-check-regex-body)
 834     (spam-use-whitelist          . spam-check-whitelist)
 835     (spam-use-BBDB               . spam-check-BBDB)
 836     (spam-use-ifile              . spam-check-ifile)
 837     (spam-use-spamoracle         . spam-check-spamoracle)
 838     (spam-use-stat               . spam-check-stat)
 839     (spam-use-blackholes         . spam-check-blackholes)
 840     (spam-use-hashcash           . spam-check-hashcash)
 841     (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
 842     (spam-use-bogofilter         . spam-check-bogofilter))
 843   "The spam-list-of-checks list contains pairs associating a
 844 parameter variable with a spam checking function.  If the
 845 parameter variable is true, then the checking function is called,
 846 and its value decides what happens.  Each individual check may
 847 return nil, t, or a mailgroup name.  The value nil means that the
 848 check does not yield a decision, and so, that further checks are
 849 needed.  The value t means that the message is definitely not
 850 spam, and that further spam checks should be inhibited.
 851 Otherwise, a mailgroup name or the symbol 'spam (depending on
 852 spam-split-symbolic-return) is returned where the mail should go,
 853 and further checks are also inhibited.  The usual mailgroup name
 854 is the value of `spam-split-group', meaning that the message is
 855 definitely a spam.")
 856
 857 (defvar spam-list-of-statistical-checks
 858   '(spam-use-ifile
 859     spam-use-regex-body
 860     spam-use-stat
 861     spam-use-bogofilter
 862     spam-use-spamoracle)
 863   "The spam-list-of-statistical-checks list contains all the mail
 864 splitters that need to have the full message body available.")
 865
 866 ;;;TODO: modify to invoke self with each check if invoked without specifics
 867 (defun spam-split (&rest specific-checks)
 868   "Split this message into the `spam' group if it is spam.
 869 This function can be used as an entry in the variable `nnmail-split-fancy',
 870 for example like this: (: spam-split).  It can take checks as
 871 parameters.  A string as a parameter will set the
 872 spam-split-group to that string.
 873
 874 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 875   (interactive)
 876   (setq spam-split-last-successful-check nil)
 877   (unless spam-split-disabled
 878     (let ((spam-split-group-choice spam-split-group))
 879       (dolist (check specific-checks)
 880         (when (stringp check)
 881           (setq spam-split-group-choice check)
 882           (setq specific-checks (delq check specific-checks))))
 883
 884       (let ((spam-split-group spam-split-group-choice))
 885         (save-excursion
 886           (save-restriction
 887             (dolist (check spam-list-of-statistical-checks)
 888               (when (and (symbolp check) (symbol-value check))
 889                 (widen)
 890                 (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
 891                               (symbol-name check))
 892                 (return)))
 893             ;;   (progn (widen) (debug (buffer-string)))
 894             (let ((list-of-checks spam-list-of-checks)
 895                   decision)
 896               (while (and list-of-checks (not decision))
 897                 (let ((pair (pop list-of-checks)))
 898                   (when (and (symbol-value (car pair))
 899                              (or (null specific-checks)
 900                                  (memq (car pair) specific-checks)))
 901                     (gnus-message 5 "spam-split: calling the %s function"
 902                                   (symbol-name (cdr pair)))
 903                     (setq decision (funcall (cdr pair)))
 904                     ;; if we got a decision at all, save the current check
 905                     (when decision
 906                       (setq spam-split-last-successful-check (car pair)))
 907
 908                     (when (eq decision 'spam)
 909                       (if spam-split-symbolic-return
 910                           (setq decision spam-split-group)
 911                         (gnus-error
 912                          5
 913                          (format "spam-split got %s but %s is nil"
 914                                  (symbol-name decision)
 915                                  (symbol-name spam-split-symbolic-return))))))))
 916               (if (eq decision t)
 917                   (if spam-split-symbolic-return-positive 'ham nil)
 918                 decision))))))))
 919
 920 (defun spam-find-spam ()
 921   "This function will detect spam in the current newsgroup using spam-split."
 922   (interactive)
 923
 924   (let* ((group gnus-newsgroup-name)
 925          (autodetect (gnus-parameter-spam-autodetect group))
 926          (methods (gnus-parameter-spam-autodetect-methods group))
 927          (first-method (nth 0 methods)))
 928   (when (and autodetect
 929              (not (equal first-method 'none)))
 930     (mapcar
 931      (lambda (article)
 932        (let ((id (spam-fetch-field-message-id-fast article))
 933              (subject (spam-fetch-field-subject-fast article))
 934              (sender (spam-fetch-field-from-fast article)))
 935          (unless (and spam-log-to-registry
 936                       (spam-log-registered-p id 'incoming))
 937            (let* ((spam-split-symbolic-return t)
 938                   (spam-split-symbolic-return-positive t)
 939                   (split-return
 940                    (with-temp-buffer
 941                      (gnus-request-article-this-buffer
 942                       article
 943                       group)
 944                      (if (or (null first-method)
 945                              (equal first-method 'default))
 946                          (spam-split)
 947                        (apply 'spam-split methods)))))
 948              (if (equal split-return 'spam)
 949                  (gnus-summary-mark-article article gnus-spam-mark))
 950
 951              (when (and split-return spam-log-to-registry)
 952                (when (zerop (gnus-registry-group-count id))
 953                  (gnus-registry-add-group
 954                   id group subject sender))
 955
 956                (spam-log-processing-to-registry
 957                 id
 958                 'incoming
 959                 split-return
 960                 spam-split-last-successful-check
 961                 group))))))
 962      (if spam-autodetect-recheck-messages
 963          gnus-newsgroup-articles
 964        gnus-newsgroup-unseen)))))
 965
 966 (defvar spam-registration-functions
 967   ;; first the ham register, second the spam register function
 968   ;; third the ham unregister, fourth the spam unregister function
 969   '((spam-use-blacklist  nil
 970                          spam-blacklist-register-routine
 971                          nil
 972                          spam-blacklist-unregister-routine)
 973     (spam-use-whitelist  spam-whitelist-register-routine
 974                          nil
 975                          spam-whitelist-unregister-routine
 976                          nil)
 977     (spam-use-BBDB       spam-BBDB-register-routine
 978                          nil
 979                          spam-BBDB-unregister-routine
 980                          nil)
 981     (spam-use-ifile      spam-ifile-register-ham-routine
 982                          spam-ifile-register-spam-routine
 983                          spam-ifile-unregister-ham-routine
 984                          spam-ifile-unregister-spam-routine)
 985     (spam-use-spamoracle spam-spamoracle-learn-ham
 986                          spam-spamoracle-learn-spam
 987                          spam-spamoracle-unlearn-ham
 988                          spam-spamoracle-unlearn-spam)
 989     (spam-use-stat       spam-stat-register-ham-routine
 990                          spam-stat-register-spam-routine
 991                          spam-stat-unregister-ham-routine
 992                          spam-stat-unregister-spam-routine)
 993     ;; note that spam-use-gmane is not a legitimate check
 994     (spam-use-gmane      nil
 995                          spam-report-gmane-register-routine
 996                          ;; does Gmane support unregistration?
 997                          nil
 998                          nil)
 999     (spam-use-bogofilter spam-bogofilter-register-ham-routine
1000                          spam-bogofilter-register-spam-routine
1001                          spam-bogofilter-unregister-ham-routine
1002                          spam-bogofilter-unregister-spam-routine))
1003   "The spam-registration-functions list contains pairs
1004 associating a parameter variable with the ham and spam
1005 registration functions, and the ham and spam unregistration
1006 functions")
1007
1008 (defun spam-classification-valid-p (classification)
1009   (or  (eq classification 'spam)
1010        (eq classification 'ham)))
1011
1012 (defun spam-process-type-valid-p (process-type)
1013   (or  (eq process-type 'incoming)
1014        (eq process-type 'process)))
1015
1016 (defun spam-registration-check-valid-p (check)
1017   (assoc check spam-registration-functions))
1018
1019 (defun spam-unregistration-check-valid-p (check)
1020   (assoc check spam-registration-functions))
1021
1022 (defun spam-registration-function (classification check)
1023   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1024     (if (eq classification 'spam)
1025         (nth 1 flist)
1026       (nth 0 flist))))
1027
1028 (defun spam-unregistration-function (classification check)
1029   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1030     (if (eq classification 'spam)
1031         (nth 3 flist)
1032       (nth 2 flist))))
1033
1034 (defun spam-list-articles (articles classification)
1035   (let ((mark-check (if (eq classification 'spam)
1036                         'spam-group-spam-mark-p
1037                       'spam-group-ham-mark-p))
1038         list mark-cache-yes mark-cache-no)
1039     (dolist (article articles)
1040       (let ((mark (gnus-summary-article-mark article)))
1041         (unless (memq mark mark-cache-no)
1042           (if (memq mark mark-cache-yes)
1043               (push article list)
1044             ;; else, we have to actually check the mark
1045             (if (funcall mark-check
1046                          gnus-newsgroup-name
1047                          mark)
1048                 (progn
1049                   (push article list)
1050                   (push mark mark-cache-yes))
1051               (push mark mark-cache-no))))))
1052     list))
1053
1054 (defun spam-register-routine (classification
1055                               check
1056                               &optional unregister
1057                               specific-articles)
1058   (when (and (spam-classification-valid-p classification)
1059              (spam-registration-check-valid-p check))
1060     (let* ((register-function
1061             (spam-registration-function classification check))
1062            (unregister-function
1063             (spam-unregistration-function classification check))
1064            (run-function (if unregister
1065                              unregister-function
1066                            register-function))
1067            (log-function (if unregister
1068                              'spam-log-undo-registration
1069                            'spam-log-processing-to-registry))
1070            article articles)
1071
1072       (when run-function
1073         ;; make list of articles, using specific-articles if given
1074         (setq articles (or specific-articles
1075                            (spam-list-articles
1076                             gnus-newsgroup-articles
1077                             classification)))
1078         ;; process them
1079         (gnus-message 5 "%s %d %s articles with classification %s, check %s"
1080                       (if unregister "Unregistering" "Registering")
1081                       (length articles)
1082                       (if specific-articles "specific" "")
1083                       (symbol-name classification)
1084                       (symbol-name check))
1085         (funcall run-function articles)
1086         ;; now log all the registrations (or undo them, depending on unregister)
1087         (dolist (article articles)
1088           (funcall log-function
1089                    (spam-fetch-field-message-id-fast article)
1090                    'process
1091                    classification
1092                    check
1093                    gnus-newsgroup-name))))))
1094
1095 ;;; log a ham- or spam-processor invocation to the registry
1096 (defun spam-log-processing-to-registry (id type classification check group)
1097   (when spam-log-to-registry
1098     (if (and (stringp id)
1099              (stringp group)
1100              (spam-process-type-valid-p type)
1101              (spam-classification-valid-p classification)
1102              (spam-registration-check-valid-p check))
1103         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1104               (cell (list classification check group)))
1105           (push cell cell-list)
1106           (gnus-registry-store-extra-entry
1107            id
1108            type
1109            cell-list))
1110
1111       (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group"
1112                               "spam-log-processing-to-registry")))))
1113
1114 ;;; check if a ham- or spam-processor registration has been done
1115 (defun spam-log-registered-p (id type)
1116   (when spam-log-to-registry
1117     (if (and (stringp id)
1118              (spam-process-type-valid-p type))
1119         (cdr-safe (gnus-registry-fetch-extra id type))
1120       (progn
1121         (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
1122                                 "spam-log-registered-p"))
1123         nil))))
1124
1125 ;;; check if a ham- or spam-processor registration needs to be undone
1126 (defun spam-log-unregistration-needed-p (id type classification check)
1127   (when spam-log-to-registry
1128     (if (and (stringp id)
1129              (spam-process-type-valid-p type)
1130              (spam-classification-valid-p classification)
1131              (spam-registration-check-valid-p check))
1132         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1133               found)
1134           (dolist (cell cell-list)
1135             (unless found
1136               (when (and (eq classification (nth 0 cell))
1137                          (eq check (nth 1 cell)))
1138                 (setq found t))))
1139           found)
1140       (progn
1141         (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
1142                                 "spam-log-unregistration-needed-p"))
1143         nil))))
1144
1145
1146 ;;; undo a ham- or spam-processor registration (the group is not used)
1147 (defun spam-log-undo-registration (id type classification check &optional group)
1148   (when (and spam-log-to-registry
1149              (spam-log-unregistration-needed-p id type classification check))
1150     (if (and (stringp id)
1151              (spam-process-type-valid-p type)
1152              (spam-classification-valid-p classification)
1153              (spam-registration-check-valid-p check))
1154         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1155               new-cell-list found)
1156           (dolist (cell cell-list)
1157             (unless (and (eq classification (nth 0 cell))
1158                          (eq check (nth 1 cell)))
1159               (push cell new-cell-list)))
1160           (gnus-registry-store-extra-entry
1161            id
1162            type
1163            new-cell-list))
1164       (progn
1165         (gnus-message 5 (format "%s called with bad ID, type, check, or group"
1166                                 "spam-log-undo-registration"))
1167         nil))))
1168
1169 ;;; set up IMAP widening if it's necessary
1170 (defun spam-setup-widening ()
1171   (dolist (check spam-list-of-statistical-checks)
1172     (when (symbol-value check)
1173       (setq nnimap-split-download-body-default t))))
1174
1175 \f
1176 ;;;; Regex body
1177
1178 (defun spam-check-regex-body ()
1179   (let ((spam-regex-headers-ham spam-regex-body-ham)
1180         (spam-regex-headers-spam spam-regex-body-spam))
1181     (spam-check-regex-headers t)))
1182
1183 \f
1184 ;;;; Regex headers
1185
1186 (defun spam-check-regex-headers (&optional body)
1187   (let ((type (if body "body" "header"))
1188         (spam-split-group (if spam-split-symbolic-return
1189                               'spam
1190                             spam-split-group))
1191         ret found)
1192     (dolist (h-regex spam-regex-headers-ham)
1193       (unless found
1194         (goto-char (point-min))
1195         (when (re-search-forward h-regex nil t)
1196           (message "Ham regex %s search positive." type)
1197           (setq found t))))
1198     (dolist (s-regex spam-regex-headers-spam)
1199       (unless found
1200         (goto-char (point-min))
1201         (when (re-search-forward s-regex nil t)
1202           (message "Spam regex %s search positive." type)
1203           (setq found t)
1204           (setq ret spam-split-group))))
1205     ret))
1206
1207 \f
1208 ;;;; Blackholes.
1209
1210 (defun spam-reverse-ip-string (ip)
1211   (when (stringp ip)
1212     (mapconcat 'identity
1213                (nreverse (split-string ip "\\."))
1214                ".")))
1215
1216 (defun spam-check-blackholes ()
1217   "Check the Received headers for blackholed relays."
1218   (let ((headers (nnmail-fetch-field "received"))
1219         (spam-split-group (if spam-split-symbolic-return
1220                               'spam
1221                             spam-split-group))
1222         ips matches)
1223     (when headers
1224       (with-temp-buffer
1225         (insert headers)
1226         (goto-char (point-min))
1227         (gnus-message 5 "Checking headers for relay addresses")
1228         (while (re-search-forward
1229                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1230           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1231           (push (spam-reverse-ip-string (match-string 1))
1232                 ips)))
1233       (dolist (server spam-blackhole-servers)
1234         (dolist (ip ips)
1235           (unless (and spam-blackhole-good-server-regex
1236                        ;; match the good-server-regex against the reversed (again) IP string
1237                        (string-match
1238                         spam-blackhole-good-server-regex
1239                         (spam-reverse-ip-string ip)))
1240             (unless matches
1241               (let ((query-string (concat ip "." server)))
1242                 (if spam-use-dig
1243                     (let ((query-result (query-dig query-string)))
1244                       (when query-result
1245                         (gnus-message 5 "(DIG): positive blackhole check '%s'"
1246                                       query-result)
1247                         (push (list ip server query-result)
1248                               matches)))
1249                   ;; else, if not using dig.el
1250                   (when (query-dns query-string)
1251                     (gnus-message 5 "positive blackhole check")
1252                     (push (list ip server (query-dns query-string 'TXT))
1253                           matches)))))))))
1254     (when matches
1255       spam-split-group)))
1256 \f
1257 ;;;; Hashcash.
1258
1259 (condition-case nil
1260     (progn
1261       (require 'hashcash)
1262
1263       (defun spam-check-hashcash ()
1264         "Check the headers for hashcash payments."
1265         (mail-check-payment)))   ;mail-check-payment returns a boolean
1266
1267   (file-error (progn
1268                 (defalias 'mail-check-payment 'ignore)
1269                 (defalias 'spam-check-hashcash 'ignore))))
1270 \f
1271 ;;;; BBDB
1272
1273 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
1274 ;;; <sacha@giotto.sj.ru>
1275
1276 ;; all this is done inside a condition-case to trap errors
1277
1278 (condition-case nil
1279     (progn
1280       (require 'bbdb)
1281       (require 'bbdb-com)
1282
1283       (defun spam-enter-ham-BBDB (addresses &optional remove)
1284         "Enter an address into the BBDB; implies ham (non-spam) sender"
1285         (dolist (from addresses)
1286           (when (stringp from)
1287             (let* ((parsed-address (gnus-extract-address-components from))
1288                    (name (or (nth 0 parsed-address) "Ham Sender"))
1289                    (remove-function (if remove
1290                                         'bbdb-delete-record-internal
1291                                       'ignore))
1292                    (net-address (nth 1 parsed-address))
1293                    (record (and net-address
1294                                 (bbdb-search-simple nil net-address))))
1295               (when net-address
1296                 (gnus-message 5 "%s address %s %s BBDB"
1297                               (if remove "Deleting" "Adding")
1298                               from
1299                               (if remove "from" "to"))
1300                 (if record
1301                     (funcall remove-function record)
1302                   (bbdb-create-internal name nil net-address nil nil
1303                                         "ham sender added by spam.el")))))))
1304
1305       (defun spam-BBDB-register-routine (articles &optional unregister)
1306         (let (addresses)
1307           (dolist (article articles)
1308             (when (stringp (spam-fetch-field-from-fast article))
1309               (push (spam-fetch-field-from-fast article) addresses)))
1310           ;; now do the register/unregister action
1311           (spam-enter-ham-BBDB addresses unregister)))
1312
1313       (defun spam-BBDB-unregister-routine (articles)
1314         (spam-BBDB-register-routine articles t))
1315
1316       (defun spam-check-BBDB ()
1317         "Mail from people in the BBDB is classified as ham or non-spam"
1318         (let ((who (nnmail-fetch-field "from"))
1319               (spam-split-group (if spam-split-symbolic-return
1320                                     'spam
1321                                   spam-split-group)))
1322           (when who
1323             (setq who (nth 1 (gnus-extract-address-components who)))
1324             (if (bbdb-search-simple nil who)
1325                 t
1326               (if spam-use-BBDB-exclusive
1327                   spam-split-group
1328                 nil))))))
1329
1330   (file-error (progn
1331                 (defalias 'bbdb-search-simple 'ignore)
1332                 (defalias 'spam-check-BBDB 'ignore)
1333                 (defalias 'spam-BBDB-register-routine 'ignore)
1334                 (defalias 'spam-enter-ham-BBDB 'ignore)
1335                 (defalias 'bbdb-create-internal 'ignore)
1336                 (defalias 'bbdb-delete-record-internal 'ignore)
1337                 (defalias 'bbdb-records 'ignore))))
1338
1339 \f
1340 ;;;; ifile
1341
1342 ;;; check the ifile backend; return nil if the mail was NOT classified
1343 ;;; as spam
1344
1345 (defun spam-get-ifile-database-parameter ()
1346   "Get the command-line parameter for ifile's database from
1347   spam-ifile-database-path."
1348   (if spam-ifile-database-path
1349       (format "--db-file=%s" spam-ifile-database-path)
1350     nil))
1351
1352 (defun spam-check-ifile ()
1353   "Check the ifile backend for the classification of this message."
1354   (let ((article-buffer-name (buffer-name))
1355         (spam-split-group (if spam-split-symbolic-return
1356                               'spam
1357                             spam-split-group))
1358         category return)
1359     (with-temp-buffer
1360       (let ((temp-buffer-name (buffer-name))
1361             (db-param (spam-get-ifile-database-parameter)))
1362         (save-excursion
1363           (set-buffer article-buffer-name)
1364           (apply 'call-process-region
1365                  (point-min) (point-max) spam-ifile-path
1366                  nil temp-buffer-name nil "-c"
1367                  (if db-param `(,db-param "-q") `("-q"))))
1368         ;; check the return now (we're back in the temp buffer)
1369         (goto-char (point-min))
1370         (if (not (eobp))
1371             (setq category (buffer-substring (point) (spam-point-at-eol))))
1372         (when (not (zerop (length category))) ; we need a category here
1373           (if spam-ifile-all-categories
1374               (setq return category)
1375             ;; else, if spam-ifile-all-categories is not set...
1376             (when (string-equal spam-ifile-spam-category category)
1377               (setq return spam-split-group)))))) ; note return is nil otherwise
1378     return))
1379
1380 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
1381   "Register an article, given as a string, with a category.
1382 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1383   (let ((category (or category gnus-newsgroup-name))
1384         (add-or-delete-option (if unregister "-d" "-i"))
1385         (db (spam-get-ifile-database-parameter))
1386         parameters)
1387     (with-temp-buffer
1388       (dolist (article articles)
1389         (let ((article-string (spam-get-article-as-string article)))
1390           (when (stringp article-string)
1391             (insert article-string))))
1392       (apply 'call-process-region
1393              (point-min) (point-max) spam-ifile-path
1394              nil nil nil
1395              add-or-delete-option category
1396              (if db `(,db "-h") `("-h"))))))
1397
1398 (defun spam-ifile-register-spam-routine (articles &optional unregister)
1399   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
1400
1401 (defun spam-ifile-unregister-spam-routine (articles)
1402   (spam-ifile-register-spam-routine articles t))
1403
1404 (defun spam-ifile-register-ham-routine (articles &optional unregister)
1405   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
1406
1407 (defun spam-ifile-unregister-ham-routine (articles)
1408   (spam-ifile-register-ham-routine articles t))
1409
1410 \f
1411 ;;;; spam-stat
1412
1413 (condition-case nil
1414     (progn
1415       (let ((spam-stat-install-hooks nil))
1416         (require 'spam-stat))
1417
1418       (defun spam-check-stat ()
1419         "Check the spam-stat backend for the classification of this message"
1420         (let ((spam-split-group (if spam-split-symbolic-return
1421                                     'spam
1422                                   spam-split-group))
1423               (spam-stat-split-fancy-spam-group spam-split-group) ; override
1424               (spam-stat-buffer (buffer-name)) ; stat the current buffer
1425               category return)
1426           (spam-stat-split-fancy)))
1427
1428       (defun spam-stat-register-spam-routine (articles &optional unregister)
1429         (dolist (article articles)
1430           (let ((article-string (spam-get-article-as-string article)))
1431             (with-temp-buffer
1432               (insert article-string)
1433               (if unregister
1434                   (spam-stat-buffer-change-to-non-spam)
1435               (spam-stat-buffer-is-spam))))))
1436
1437       (defun spam-stat-unregister-spam-routine (articles)
1438         (spam-stat-register-spam-routine articles t))
1439
1440       (defun spam-stat-register-ham-routine (articles &optional unregister)
1441         (dolist (article articles)
1442           (let ((article-string (spam-get-article-as-string article)))
1443             (with-temp-buffer
1444               (insert article-string)
1445               (if unregister
1446                   (spam-stat-buffer-change-to-spam)
1447               (spam-stat-buffer-is-non-spam))))))
1448
1449       (defun spam-stat-unregister-ham-routine (articles)
1450         (spam-stat-register-ham-routine articles t))
1451
1452       (defun spam-maybe-spam-stat-load ()
1453         (when spam-use-stat (spam-stat-load)))
1454
1455       (defun spam-maybe-spam-stat-save ()
1456         (when spam-use-stat (spam-stat-save))))
1457
1458   (file-error (progn
1459                 (defalias 'spam-stat-load 'ignore)
1460                 (defalias 'spam-stat-save 'ignore)
1461                 (defalias 'spam-maybe-spam-stat-load 'ignore)
1462                 (defalias 'spam-maybe-spam-stat-save 'ignore)
1463                 (defalias 'spam-stat-register-ham-routine 'ignore)
1464                 (defalias 'spam-stat-unregister-ham-routine 'ignore)
1465                 (defalias 'spam-stat-register-spam-routine 'ignore)
1466                 (defalias 'spam-stat-unregister-spam-routine 'ignore)
1467                 (defalias 'spam-stat-buffer-is-spam 'ignore)
1468                 (defalias 'spam-stat-buffer-change-to-spam 'ignore)
1469                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
1470                 (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
1471                 (defalias 'spam-stat-split-fancy 'ignore)
1472                 (defalias 'spam-check-stat 'ignore))))
1473
1474 \f
1475
1476 ;;;; Blacklists and whitelists.
1477
1478 (defvar spam-whitelist-cache nil)
1479 (defvar spam-blacklist-cache nil)
1480
1481 (defun spam-kill-whole-line ()
1482   (beginning-of-line)
1483   (let ((kill-whole-line t))
1484     (kill-line)))
1485
1486 ;;; address can be a list, too
1487 (defun spam-enter-whitelist (address &optional remove)
1488   "Enter ADDRESS (list or single) into the whitelist.
1489 With a non-nil REMOVE, remove them."
1490   (interactive "sAddress: ")
1491   (spam-enter-list address spam-whitelist remove)
1492   (setq spam-whitelist-cache nil))
1493
1494 ;;; address can be a list, too
1495 (defun spam-enter-blacklist (address &optional remove)
1496   "Enter ADDRESS (list or single) into the blacklist.
1497 With a non-nil REMOVE, remove them."
1498   (interactive "sAddress: ")
1499   (spam-enter-list address spam-blacklist remove)
1500   (setq spam-blacklist-cache nil))
1501
1502 (defun spam-enter-list (addresses file &optional remove)
1503   "Enter ADDRESSES into the given FILE.
1504 Either the whitelist or the blacklist files can be used.  With
1505 REMOVE not nil, remove the ADDRESSES."
1506   (if (stringp addresses)
1507       (spam-enter-list (list addresses) file remove)
1508     ;; else, we have a list of addresses here
1509     (unless (file-exists-p (file-name-directory file))
1510       (make-directory (file-name-directory file) t))
1511     (save-excursion
1512       (set-buffer
1513        (find-file-noselect file))
1514       (dolist (a addresses)
1515         (when (stringp a)
1516           (goto-char (point-min))
1517           (if (re-search-forward (regexp-quote a) nil t)
1518               ;; found the address
1519               (when remove
1520                 (spam-kill-whole-line))
1521             ;; else, the address was not found
1522             (unless remove
1523               (goto-char (point-max))
1524               (unless (bobp)
1525                 (insert "\n"))
1526               (insert a "\n")))))
1527       (save-buffer))))
1528
1529 ;;; returns t if the sender is in the whitelist, nil or
1530 ;;; spam-split-group otherwise
1531 (defun spam-check-whitelist ()
1532   ;; FIXME!  Should it detect when file timestamps change?
1533   (let ((spam-split-group (if spam-split-symbolic-return
1534                               'spam
1535                             spam-split-group)))
1536     (unless spam-whitelist-cache
1537       (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
1538     (if (spam-from-listed-p spam-whitelist-cache)
1539         t
1540       (if spam-use-whitelist-exclusive
1541           spam-split-group
1542         nil))))
1543
1544 (defun spam-check-blacklist ()
1545   ;; FIXME!  Should it detect when file timestamps change?
1546   (let ((spam-split-group (if spam-split-symbolic-return
1547                               'spam
1548                             spam-split-group)))
1549     (unless spam-blacklist-cache
1550       (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1551     (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)))
1552
1553 (defun spam-parse-list (file)
1554   (when (file-readable-p file)
1555     (let (contents address)
1556       (with-temp-buffer
1557         (insert-file-contents file)
1558         (while (not (eobp))
1559           (setq address (buffer-substring (point) (spam-point-at-eol)))
1560           (forward-line 1)
1561           ;; insert the e-mail address if detected, otherwise the raw data
1562           (unless (zerop (length address))
1563             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
1564               (push (or pure-address address) contents)))))
1565       (nreverse contents))))
1566
1567 (defun spam-from-listed-p (cache)
1568   (let ((from (nnmail-fetch-field "from"))
1569         found)
1570     (while cache
1571       (let ((address (pop cache)))
1572         (unless (zerop (length address)) ; 0 for a nil address too
1573           (setq address (regexp-quote address))
1574           ;; fix regexp-quote's treatment of user-intended regexes
1575           (while (string-match "\\\\\\*" address)
1576             (setq address (replace-match ".*" t t address))))
1577         (when (and address (string-match address from))
1578           (setq found t
1579                 cache nil))))
1580     found))
1581
1582 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
1583   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
1584         (declassification (if blacklist 'ham 'spam))
1585         (enter-function
1586          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
1587         (remove-function
1588          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
1589         from addresses unregister-list)
1590     (dolist (article articles)
1591       (let ((from (spam-fetch-field-from-fast article))
1592             (id (spam-fetch-field-message-id-fast article))
1593             sender-ignored)
1594         (when (stringp from)
1595           (dolist (ignore-regex spam-blacklist-ignored-regexes)
1596             (when (and (not sender-ignored)
1597                        (stringp ignore-regex)
1598                        (string-match ignore-regex from))
1599               (setq sender-ignored t)))
1600           ;; remember the messages we need to unregister, unless remove is set
1601           (when (and
1602                  (null unregister)
1603                  (spam-log-unregistration-needed-p
1604                   id 'process declassification de-symbol))
1605             (push from unregister-list))
1606           (unless sender-ignored
1607             (push from addresses)))))
1608
1609     (if unregister
1610         (funcall enter-function addresses t) ; unregister all these addresses
1611       ;; else, register normally and unregister what we need to
1612       (funcall remove-function unregister-list t)
1613       (dolist (article unregister-list)
1614         (spam-log-undo-registration
1615          (spam-fetch-field-message-id-fast article)
1616          'process
1617          declassification
1618          de-symbol))
1619       (funcall enter-function addresses nil))))
1620
1621 (defun spam-blacklist-unregister-routine (articles)
1622   (spam-blacklist-register-routine articles t))
1623
1624 (defun spam-blacklist-register-routine (articles &optional unregister)
1625   (spam-filelist-register-routine articles t unregister))
1626
1627 (defun spam-whitelist-unregister-routine (articles)
1628   (spam-whitelist-register-routine articles t))
1629
1630 (defun spam-whitelist-register-routine (articles &optional unregister)
1631   (spam-filelist-register-routine articles nil unregister))
1632
1633 \f
1634 ;;;; Spam-report glue
1635 (defun spam-report-gmane-register-routine (articles)
1636   (when articles
1637     (apply 'spam-report-gmane articles)))
1638
1639 \f
1640 ;;;; Bogofilter
1641 (defun spam-check-bogofilter-headers (&optional score)
1642   (let ((header (nnmail-fetch-field spam-bogofilter-header))
1643         (spam-split-group (if spam-split-symbolic-return
1644                               'spam
1645                             spam-split-group)))
1646     (when header                        ; return nil when no header
1647       (if score                         ; scoring mode
1648           (if (string-match "spamicity=\\([0-9.]+\\)" header)
1649               (match-string 1 header)
1650             "0")
1651         ;; spam detection mode
1652         (when (string-match spam-bogofilter-bogosity-positive-spam-header
1653                             header)
1654           spam-split-group)))))
1655
1656 ;; return something sensible if the score can't be determined
1657 (defun spam-bogofilter-score ()
1658   "Get the Bogofilter spamicity score"
1659   (interactive)
1660   (save-window-excursion
1661     (gnus-summary-show-article t)
1662     (set-buffer gnus-article-buffer)
1663     (let ((score (or (spam-check-bogofilter-headers t)
1664                      (spam-check-bogofilter t))))
1665       (message "Spamicity score %s" score)
1666       (or score "0"))
1667     (gnus-summary-show-article)))
1668
1669 (defun spam-check-bogofilter (&optional score)
1670   "Check the Bogofilter backend for the classification of this message"
1671   (let ((article-buffer-name (buffer-name))
1672         (db spam-bogofilter-database-directory)
1673         return)
1674     (with-temp-buffer
1675       (let ((temp-buffer-name (buffer-name)))
1676         (save-excursion
1677           (set-buffer article-buffer-name)
1678           (apply 'call-process-region
1679                  (point-min) (point-max)
1680                  spam-bogofilter-path
1681                  nil temp-buffer-name nil
1682                  (if db `("-d" ,db "-v") `("-v"))))
1683         (setq return (spam-check-bogofilter-headers score))))
1684     return))
1685
1686 (defun spam-bogofilter-register-with-bogofilter (articles
1687                                                  spam
1688                                                  &optional unregister)
1689   "Register an article, given as a string, as spam or non-spam."
1690   (dolist (article articles)
1691     (let ((article-string (spam-get-article-as-string article))
1692           (db spam-bogofilter-database-directory)
1693           (switch (if unregister
1694                       (if spam
1695                           spam-bogofilter-spam-strong-switch
1696                         spam-bogofilter-ham-strong-switch)
1697                     (if spam
1698                         spam-bogofilter-spam-switch
1699                       spam-bogofilter-ham-switch))))
1700       (when (stringp article-string)
1701         (with-temp-buffer
1702           (insert article-string)
1703
1704           (apply 'call-process-region
1705                  (point-min) (point-max)
1706                  spam-bogofilter-path
1707                  nil nil nil switch
1708                  (if db `("-d" ,db "-v") `("-v"))))))))
1709
1710 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
1711   (spam-bogofilter-register-with-bogofilter articles t unregister))
1712
1713 (defun spam-bogofilter-unregister-spam-routine (articles)
1714   (spam-bogofilter-register-spam-routine articles t))
1715
1716 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
1717   (spam-bogofilter-register-with-bogofilter articles nil unregister))
1718
1719 (defun spam-bogofilter-unregister-ham-routine (articles)
1720   (spam-bogofilter-register-ham-routine articles t))
1721
1722
1723 \f
1724 ;;;; spamoracle
1725 (defun spam-check-spamoracle ()
1726   "Run spamoracle on an article to determine whether it's spam."
1727   (let ((article-buffer-name (buffer-name))
1728         (spam-split-group (if spam-split-symbolic-return
1729                               'spam
1730                             spam-split-group)))
1731     (with-temp-buffer
1732       (let ((temp-buffer-name (buffer-name)))
1733         (save-excursion
1734           (set-buffer article-buffer-name)
1735           (let ((status
1736                  (apply 'call-process-region
1737                         (point-min) (point-max)
1738                         spam-spamoracle-binary
1739                         nil temp-buffer-name nil
1740                         (if spam-spamoracle-database
1741                             `("-f" ,spam-spamoracle-database "mark")
1742                           '("mark")))))
1743             (if (eq 0 status)
1744                 (progn
1745                   (set-buffer temp-buffer-name)
1746                   (goto-char (point-min))
1747                   (when (re-search-forward "^X-Spam: yes;" nil t)
1748                     spam-split-group))
1749               (error "Error running spamoracle" status))))))))
1750
1751 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
1752   "Run spamoracle in training mode."
1753   (with-temp-buffer
1754     (let ((temp-buffer-name (buffer-name)))
1755       (save-excursion
1756         (goto-char (point-min))
1757         (dolist (article articles)
1758           (insert (spam-get-article-as-string article)))
1759         (let* ((arg (if (spam-xor unregister article-is-spam-p)
1760                         "-spam"
1761                       "-good"))
1762                (status
1763                 (apply 'call-process-region
1764                        (point-min) (point-max)
1765                        spam-spamoracle-binary
1766                        nil temp-buffer-name nil
1767                        (if spam-spamoracle-database
1768                            `("-f" ,spam-spamoracle-database
1769                              "add" ,arg)
1770                          `("add" ,arg)))))
1771           (when (not (eq 0 status))
1772             (error "Error running spamoracle" status)))))))
1773
1774 (defun spam-spamoracle-learn-ham (articles &optional unregister)
1775   (spam-spamoracle-learn articles nil unregister))
1776
1777 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
1778   (spam-spamoracle-learn-ham articles t))
1779
1780 (defun spam-spamoracle-learn-spam (articles &optional unregister)
1781   (spam-spamoracle-learn articles t unregister))
1782
1783 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
1784   (spam-spamoracle-learn-spam articles t))
1785
1786 \f
1787 ;;;; Hooks
1788
1789 ;;;###autoload
1790 (defun spam-initialize ()
1791   "Install the spam.el hooks and do other initialization"
1792   (interactive)
1793   (setq spam-install-hooks t)
1794   ;; TODO: How do we redo this every time spam-face is customized?
1795   (push '((eq mark gnus-spam-mark) . spam-face)
1796         gnus-summary-highlight)
1797   ;; Add hooks for loading and saving the spam stats
1798   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1799   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1800   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
1801   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1802   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1803   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
1804   (add-hook 'gnus-summary-prepare-hook 'spam-find-spam))
1805
1806 (defun spam-unload-hook ()
1807   "Uninstall the spam.el hooks"
1808   (interactive)
1809   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1810   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1811   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
1812   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1813   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1814   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
1815   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
1816
1817 (when spam-install-hooks
1818   (spam-initialize))
1819
1820 (provide 'spam)
1821
1822 ;;; spam.el ends here.
1823
1824 (provide 'spam)
1825
1826 ;;; spam.el ends here