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