code.delx.au - gnu-emacs/blob - lisp/gnus/spam.el

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