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