cgit.sxemacs.org Git - gnus/blob - lisp/spam.el

   1 ;;; spam.el --- Identifying spam
   2 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: network
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; This module addresses a few aspects of spam control under Gnus.  Page
  27 ;;; breaks are used for grouping declarations and documentation relating to
  28 ;;; each particular aspect.
  29
  30 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
  31 ;;; comments, below, for supplementary explanations or discussions.
  32
  33 ;;; Several TODO items are marked as such
  34
  35 ;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
  36 ;; remote processing, training through files
  37
  38 ;;; Code:
  39
  40 (eval-when-compile (require 'cl))
  41
  42 (require 'gnus-sum)
  43
  44 (require 'gnus-uu)                      ; because of key prefix issues
  45 ;;; for the definitions of group content classification and spam processors
  46 (require 'gnus)
  47 (require 'message)              ;for the message-fetch-field functions
  48
  49 ;; for nnimap-split-download-body-default
  50 (eval-when-compile (require 'nnimap))
  51
  52 ;; autoload query-dig
  53 (eval-and-compile
  54   (autoload 'query-dig "dig"))
  55
  56 ;; autoload spam-report
  57 (eval-and-compile
  58   (autoload 'spam-report-gmane "spam-report"))
  59
  60 ;; autoload gnus-registry
  61 (eval-and-compile
  62   (autoload 'gnus-registry-group-count "gnus-registry")
  63   (autoload 'gnus-registry-add-group "gnus-registry")
  64   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
  65   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
  66
  67 ;; autoload query-dns
  68 (eval-and-compile
  69   (autoload 'query-dns "dns"))
  70
  71 ;;; Main parameters.
  72
  73 (defgroup spam nil
  74   "Spam configuration.")
  75
  76 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
  77   "Directory for spam whitelists and blacklists."
  78   :type 'directory
  79   :group 'spam)
  80
  81 (defcustom spam-move-spam-nonspam-groups-only t
  82   "Whether spam should be moved in non-spam groups only.
  83 When t, only ham and unclassified groups will have their spam moved
  84 to the spam-process-destination.  When nil, spam will also be moved from
  85 spam groups."
  86   :type 'boolean
  87   :group 'spam)
  88
  89 (defcustom spam-process-ham-in-nonham-groups nil
  90   "Whether ham should be processed in non-ham groups."
  91   :type 'boolean
  92   :group 'spam)
  93
  94 (defcustom spam-log-to-registry nil
  95   "Whether spam/ham processing should be logged in the registry."
  96   :type 'boolean
  97   :group 'spam)
  98
  99 (defcustom spam-split-symbolic-return nil
 100   "Whether `spam-split' should work with symbols or group names."
 101   :type 'boolean
 102   :group 'spam)
 103
 104 (defcustom spam-split-symbolic-return-positive nil
 105   "Whether `spam-split' should ALWAYS work with symbols or group names.
 106 Do not set this if you use `spam-split' in a fancy split
 107   method."
 108   :type 'boolean
 109   :group 'spam)
 110
 111 (defcustom spam-process-ham-in-spam-groups nil
 112   "Whether ham should be processed in spam groups."
 113   :type 'boolean
 114   :group 'spam)
 115
 116 (defcustom spam-mark-only-unseen-as-spam t
 117   "Whether only unseen articles should be marked as spam in spam groups.
 118 When nil, all unread articles in a spam group are marked as
 119 spam.  Set this if you want to leave an article unread in a spam group
 120 without losing it to the automatic spam-marking process."
 121   :type 'boolean
 122   :group 'spam)
 123
 124 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
 125   "Whether ham should be marked unread before it's moved.
 126 The article is moved out of a spam group according to ham-process-destination.
 127 This variable is an official entry in the international Longest Variable Name
 128 Competition."
 129   :type 'boolean
 130   :group 'spam)
 131
 132 (defcustom spam-disable-spam-split-during-ham-respool nil
 133   "Whether `spam-split' should be ignored while resplitting ham.
 134 This is useful to prevent ham from ending up in the same spam
 135 group after the resplit.  Don't set this to t if you have `spam-split' as the
 136 last rule in your split configuration."
 137   :type 'boolean
 138   :group 'spam)
 139
 140 (defcustom spam-autodetect-recheck-messages nil
 141   "Should spam.el recheck all meessages when autodetecting?
 142 Normally this is nil, so only unseen messages will be checked."
 143   :type 'boolean
 144   :group 'spam)
 145
 146 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
 147   "The location of the whitelist.
 148 The file format is one regular expression per line.
 149 The regular expression is matched against the address."
 150   :type 'file
 151   :group 'spam)
 152
 153 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
 154   "The location of the blacklist.
 155 The file format is one regular expression per line.
 156 The regular expression is matched against the address."
 157   :type 'file
 158   :group 'spam)
 159
 160 (defcustom spam-use-dig t
 161   "Whether `query-dig' should be used instead of `query-dns'."
 162   :type 'boolean
 163   :group 'spam)
 164
 165 (defcustom spam-use-gmane-xref nil
 166   "Whether the Gmane spam xref should be used by `spam-split'."
 167   :type 'boolean
 168   :group 'spam)
 169
 170 (defcustom spam-use-blacklist nil
 171   "Whether the blacklist should be used by `spam-split'."
 172   :type 'boolean
 173   :group 'spam)
 174
 175 (defcustom spam-blacklist-ignored-regexes nil
 176   "Regular expressions that the blacklist should ignore."
 177   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
 178   :group 'spam)
 179
 180 (defcustom spam-use-whitelist nil
 181   "Whether the whitelist should be used by `spam-split'."
 182   :type 'boolean
 183   :group 'spam)
 184
 185 (defcustom spam-use-whitelist-exclusive nil
 186   "Whether whitelist-exclusive should be used by `spam-split'.
 187 Exclusive whitelisting means that all messages from senders not in the whitelist
 188 are considered spam."
 189   :type 'boolean
 190   :group 'spam)
 191
 192 (defcustom spam-use-blackholes nil
 193   "Whether blackholes should be used by `spam-split'."
 194   :type 'boolean
 195   :group 'spam)
 196
 197 (defcustom spam-use-hashcash nil
 198   "Whether hashcash payments should be detected by `spam-split'."
 199   :type 'boolean
 200   :group 'spam)
 201
 202 (defcustom spam-use-regex-headers nil
 203   "Whether a header regular expression match should be used by `spam-split'.
 204 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
 205   :type 'boolean
 206   :group 'spam)
 207
 208 (defcustom spam-use-regex-body nil
 209   "Whether a body regular expression match should be used by `spam-split'.
 210 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
 211   :type 'boolean
 212   :group 'spam)
 213
 214 (defcustom spam-use-bogofilter-headers nil
 215   "Whether bogofilter headers should be used by `spam-split'.
 216 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 217   :type 'boolean
 218   :group 'spam)
 219
 220 (defcustom spam-use-bogofilter nil
 221   "Whether bogofilter should be invoked by `spam-split'.
 222 Enable this if you want Gnus to invoke Bogofilter on new messages."
 223   :type 'boolean
 224   :group 'spam)
 225
 226 (defcustom spam-use-bsfilter-headers nil
 227   "Whether bsfilter headers should be used by `spam-split'.
 228 Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
 229   :type 'boolean
 230   :group 'spam)
 231
 232 (defcustom spam-use-bsfilter nil
 233   "Whether bsfilter should be invoked by `spam-split'.
 234 Enable this if you want Gnus to invoke Bsfilter on new messages."
 235   :type 'boolean
 236   :group 'spam)
 237
 238 (defcustom spam-use-BBDB nil
 239   "Whether BBDB should be used by `spam-split'."
 240   :type 'boolean
 241   :group 'spam)
 242
 243 (defcustom spam-use-BBDB-exclusive nil
 244   "Whether BBDB-exclusive should be used by `spam-split'.
 245 Exclusive BBDB means that all messages from senders not in the BBDB are
 246 considered spam."
 247   :type 'boolean
 248   :group 'spam)
 249
 250 (defcustom spam-use-ifile nil
 251   "Whether ifile should be used by `spam-split'."
 252   :type 'boolean
 253   :group 'spam)
 254
 255 (defcustom spam-use-stat nil
 256   "Whether `spam-stat' should be used by `spam-split'."
 257   :type 'boolean
 258   :group 'spam)
 259
 260 (defcustom spam-use-spamoracle nil
 261   "Whether spamoracle should be used by `spam-split'."
 262   :type 'boolean
 263   :group 'spam)
 264
 265 (defcustom spam-use-spamassassin nil
 266   "Whether spamassassin should be invoked by `spam-split'.
 267 Enable this if you want Gnus to invoke SpamAssassin on new messages."
 268   :type 'boolean
 269   :group 'spam)
 270
 271 (defcustom spam-use-spamassassin-headers nil
 272   "Whether spamassassin headers should be checked by `spam-split'.
 273 Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
 274 them."
 275   :type 'boolean
 276   :group 'spam)
 277
 278 (defcustom spam-install-hooks (or
 279                                spam-use-dig
 280                                spam-use-gmane-xref
 281                                spam-use-blacklist
 282                                spam-use-whitelist
 283                                spam-use-whitelist-exclusive
 284                                spam-use-blackholes
 285                                spam-use-hashcash
 286                                spam-use-regex-headers
 287                                spam-use-regex-body
 288                                spam-use-bogofilter
 289                                spam-use-bogofilter-headers
 290                                spam-use-spamassassin
 291                                spam-use-spamassassin-headers
 292                                spam-use-bsfilter
 293                                spam-use-bsfilter-headers
 294                                spam-use-BBDB
 295                                spam-use-BBDB-exclusive
 296                                spam-use-ifile
 297                                spam-use-stat
 298                                spam-use-spamoracle)
 299   "Whether the spam hooks should be installed.
 300 Default to t if one of the spam-use-* variables is set."
 301   :group 'spam
 302   :type 'boolean)
 303
 304 (defcustom spam-split-group "spam"
 305   "Group name where incoming spam should be put by `spam-split'."
 306   :type 'string
 307   :group 'spam)
 308
 309 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
 310 ;;; not regular expressions
 311 (defcustom spam-junk-mailgroups (cons
 312                                  spam-split-group
 313                                  '("mail.junk" "poste.pourriel"))
 314   "Mailgroups with spam contents.
 315 All unmarked article in such group receive the spam mark on group entry."
 316   :type '(repeat (string :tag "Group"))
 317   :group 'spam)
 318
 319
 320 (defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
 321   "The group where spam xrefs can be found on Gmane.
 322 Only meaningful if you enable `spam-use-gmane-xref'."
 323   :type 'string
 324   :group 'spam)
 325
 326 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 327                                     "dev.null.dk" "relays.visi.com")
 328   "List of blackhole servers.
 329 Only meaningful if you enable `spam-use-blackholes'."
 330   :type '(repeat (string :tag "Server"))
 331   :group 'spam)
 332
 333 (defcustom spam-blackhole-good-server-regex nil
 334   "String matching IP addresses that should not be checked in the blackholes.
 335 Only meaningful if you enable `spam-use-blackholes'."
 336   :type '(radio (const nil)
 337                 (regexp :format "%t: %v\n" :size 0))
 338   :group 'spam)
 339
 340 (defcustom spam-face 'gnus-splash-face
 341   "Face for spam-marked articles."
 342   :type 'face
 343   :group 'spam)
 344
 345 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 346   "Regular expression for positive header spam matches.
 347 Only meaningful if you enable `spam-use-regex-headers'."
 348   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 349   :group 'spam)
 350
 351 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 352   "Regular expression for positive header ham matches.
 353 Only meaningful if you enable `spam-use-regex-headers'."
 354   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 355   :group 'spam)
 356
 357 (defcustom spam-regex-body-spam '()
 358   "Regular expression for positive body spam matches.
 359 Only meaningful if you enable `spam-use-regex-body'."
 360   :type '(repeat (regexp :tag "Regular expression to match spam body"))
 361   :group 'spam)
 362
 363 (defcustom spam-regex-body-ham '()
 364   "Regular expression for positive body ham matches.
 365 Only meaningful if you enable `spam-use-regex-body'."
 366   :type '(repeat (regexp :tag "Regular expression to match ham body"))
 367   :group 'spam)
 368
 369 (defgroup spam-ifile nil
 370   "Spam ifile configuration."
 371   :group 'spam)
 372
 373 (defcustom spam-ifile-path (executable-find "ifile")
 374   "File path of the ifile executable program."
 375   :type '(choice (file :tag "Location of ifile")
 376                  (const :tag "ifile is not installed"))
 377   :group 'spam-ifile)
 378
 379 (defcustom spam-ifile-database-path nil
 380   "File path of the ifile database."
 381   :type '(choice (file :tag "Location of the ifile database")
 382                  (const :tag "Use the default"))
 383   :group 'spam-ifile)
 384
 385 (defcustom spam-ifile-spam-category "spam"
 386   "Name of the spam ifile category."
 387   :type 'string
 388   :group 'spam-ifile)
 389
 390 (defcustom spam-ifile-ham-category nil
 391   "Name of the ham ifile category.
 392 If nil, the current group name will be used."
 393   :type '(choice (string :tag "Use a fixed category")
 394                  (const :tag "Use the current group name"))
 395   :group 'spam-ifile)
 396
 397 (defcustom spam-ifile-all-categories nil
 398   "Whether the ifile check will return all categories, or just spam.
 399 Set this to t if you want to use the `spam-split' invocation of ifile as
 400 your main source of newsgroup names."
 401   :type 'boolean
 402   :group 'spam-ifile)
 403
 404 (defgroup spam-bogofilter nil
 405   "Spam bogofilter configuration."
 406   :group 'spam)
 407
 408 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 409   "File path of the Bogofilter executable program."
 410   :type '(choice (file :tag "Location of bogofilter")
 411                  (const :tag "Bogofilter is not installed"))
 412   :group 'spam-bogofilter)
 413
 414 (defcustom spam-bogofilter-header "X-Bogosity"
 415   "The header that Bogofilter inserts in messages."
 416   :type 'string
 417   :group 'spam-bogofilter)
 418
 419 (defcustom spam-bogofilter-spam-switch "-s"
 420   "The switch that Bogofilter uses to register spam messages."
 421   :type 'string
 422   :group 'spam-bogofilter)
 423
 424 (defcustom spam-bogofilter-ham-switch "-n"
 425   "The switch that Bogofilter uses to register ham messages."
 426   :type 'string
 427   :group 'spam-bogofilter)
 428
 429 (defcustom spam-bogofilter-spam-strong-switch "-S"
 430   "The switch that Bogofilter uses to unregister ham messages."
 431   :type 'string
 432   :group 'spam-bogofilter)
 433
 434 (defcustom spam-bogofilter-ham-strong-switch "-N"
 435   "The switch that Bogofilter uses to unregister spam messages."
 436   :type 'string
 437   :group 'spam-bogofilter)
 438
 439 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 440   "The regex on `spam-bogofilter-header' for positive spam identification."
 441   :type 'regexp
 442   :group 'spam-bogofilter)
 443
 444 (defcustom spam-bogofilter-database-directory nil
 445   "Directory path of the Bogofilter databases."
 446   :type '(choice (directory
 447                   :tag "Location of the Bogofilter database directory")
 448                  (const :tag "Use the default"))
 449   :group 'spam-bogofilter)
 450
 451 (defgroup spam-bsfilter nil
 452   "Spam bsfilter configuration."
 453   :group 'spam)
 454
 455 (defcustom spam-bsfilter-path (executable-find "bsfilter")
 456   "File path of the Bsfilter executable program."
 457   :type '(choice (file :tag "Location of bsfilter")
 458                  (const :tag "Bsfilter is not installed"))
 459   :group 'spam-bsfilter)
 460
 461 (defcustom spam-bsfilter-header "X-Spam-Flag"
 462   "The header inserted by Bsfilter to flag spam."
 463   :type 'string
 464   :group 'spam-bsfilter)
 465
 466 (defcustom spam-bsfilter-probability-header "X-Spam-Probability"
 467   "The header that Bsfilter inserts in messages."
 468   :type 'string
 469   :group 'spam-bsfilter)
 470
 471 (defcustom spam-bsfilter-spam-switch "--add-spam"
 472   "The switch that Bsfilter uses to register spam messages."
 473   :type 'string
 474   :group 'spam-bsfilter)
 475
 476 (defcustom spam-bsfilter-ham-switch "--add-ham"
 477   "The switch that Bsfilter uses to register ham messages."
 478   :type 'string
 479   :group 'spam-bsfilter)
 480
 481 (defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
 482   "The switch that Bsfilter uses to unregister ham messages."
 483   :type 'string
 484   :group 'spam-bsfilter)
 485
 486 (defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
 487   "The switch that Bsfilter uses to unregister spam messages."
 488   :type 'string
 489   :group 'spam-bsfilter)
 490
 491 (defcustom spam-bsfilter-database-directory nil
 492   "Directory path of the Bsfilter databases."
 493   :type '(choice (directory
 494                   :tag "Location of the Bsfilter database directory")
 495                  (const :tag "Use the default"))
 496   :group 'spam-bsfilter)
 497
 498 (defgroup spam-spamoracle nil
 499   "Spam spamoracle configuration."
 500   :group 'spam)
 501
 502 (defcustom spam-spamoracle-database nil
 503   "Location of spamoracle database file.
 504 When nil, use the default spamoracle database."
 505   :type '(choice (directory :tag "Location of spamoracle database file.")
 506                  (const :tag "Use the default"))
 507   :group 'spam-spamoracle)
 508
 509 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
 510   "Location of the spamoracle binary."
 511   :type '(choice (directory :tag "Location of the spamoracle binary")
 512                  (const :tag "Use the default"))
 513   :group 'spam-spamoracle)
 514
 515 (defgroup spam-spamassassin nil
 516   "Spam SpamAssassin configuration."
 517   :group 'spam)
 518
 519 (defcustom spam-spamassassin-path (executable-find "spamassassin")
 520   "File path of the spamassassin executable program.
 521 Hint: set this to \"spamc\" if you have spamd running.  See the spamc and
 522 spamd man pages for more information on these programs."
 523   :type '(choice (file :tag "Location of spamc")
 524                  (const :tag "spamassassin is not installed"))
 525   :group 'spam-spamassassin)
 526
 527 (defcustom spam-spamassassin-arguments ()
 528   "Arguments to pass to the spamassassin executable.
 529 This must be a list.  For example, `(\"-C\" \"configfile\")'."
 530   :type '(restricted-sexp :match-alternatives (listp))
 531   :group 'spam-spamassassin)
 532
 533 (defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
 534   "The header inserted by SpamAssassin to flag spam."
 535   :type 'string
 536   :group 'spam-spamassassin)
 537
 538 (defcustom spam-spamassassin-positive-spam-flag-header "YES"
 539   "The regex on `spam-spamassassin-spam-flag-header' for positive spam
 540 identification"
 541   :type 'string
 542   :group 'spam-spamassassin)
 543
 544 (defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
 545   "The header inserted by SpamAssassin, giving extended scoring information"
 546   :type 'string
 547   :group 'spam-spamassassin)
 548
 549 (defcustom spam-sa-learn-path (executable-find "sa-learn")
 550   "File path of the sa-learn executable program."
 551   :type '(choice (file :tag "Location of spamassassin")
 552                  (const :tag "spamassassin is not installed"))
 553   :group 'spam-spamassassin)
 554
 555 (defcustom spam-sa-learn-rebuild t
 556   "Whether sa-learn should rebuild the database every time it is called
 557 Enable this if you want sa-learn to rebuild the database automatically.  Doing
 558 this will slightly increase the running time of the spam registration process.
 559 If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
 560 order for SpamAssassin to recognize the new registered spam."
 561   :type 'boolean
 562   :group 'spam-spamassassin)
 563
 564 (defcustom spam-sa-learn-spam-switch "--spam"
 565   "The switch that sa-learn uses to register spam messages"
 566   :type 'string
 567   :group 'spam-spamassassin)
 568
 569 (defcustom spam-sa-learn-ham-switch "--ham"
 570   "The switch that sa-learn uses to register ham messages"
 571   :type 'string
 572   :group 'spam-spamassassin)
 573
 574 (defcustom spam-sa-learn-unregister-switch "--forget"
 575   "The switch that sa-learn uses to unregister messages messages"
 576   :type 'string
 577   :group 'spam-spamassassin)
 578
 579 ;;; Key bindings for spam control.
 580
 581 (gnus-define-keys gnus-summary-mode-map
 582   "St" spam-generic-score
 583   "Sx" gnus-summary-mark-as-spam
 584   "Mst" spam-generic-score
 585   "Msx" gnus-summary-mark-as-spam
 586   "\M-d" gnus-summary-mark-as-spam)
 587
 588 (defvar spam-cache-lookups t
 589   "Whether spam.el will try to cache lookups using `spam-caches'.")
 590
 591 (defvar spam-caches (make-hash-table
 592                      :size 10
 593                      :test 'equal)
 594   "Cache of spam detection entries.")
 595
 596 (defvar spam-old-ham-articles nil
 597   "List of old ham articles, generated when a group is entered.")
 598
 599 (defvar spam-old-spam-articles nil
 600   "List of old spam articles, generated when a group is entered.")
 601
 602 (defvar spam-split-disabled nil
 603   "If non-nil, `spam-split' is disabled, and always returns nil.")
 604
 605 (defvar spam-split-last-successful-check nil
 606   "Internal variable.
 607 `spam-split' will set this to nil or a spam-use-XYZ check if it
 608 finds ham or spam.")
 609
 610 ;; convenience functions
 611 (defun spam-clear-cache (symbol)
 612   "Clear the spam-caches entry for a check."
 613   (remhash symbol spam-caches))
 614
 615 (defun spam-xor (a b)
 616   "Logical A xor B."
 617   (and (or a b) (not (and a b))))
 618
 619 (defun spam-group-ham-mark-p (group mark &optional spam)
 620   "Checks if MARK is considered a ham mark in GROUP."
 621   (when (stringp group)
 622     (let* ((marks (spam-group-ham-marks group spam))
 623            (marks (if (symbolp mark)
 624                       marks
 625                     (mapcar 'symbol-value marks))))
 626       (memq mark marks))))
 627
 628 (defun spam-group-spam-mark-p (group mark)
 629   "Checks if MARK is considered a spam mark in GROUP."
 630   (spam-group-ham-mark-p group mark t))
 631
 632 (defun spam-group-ham-marks (group &optional spam)
 633   "In GROUP, get all the ham marks."
 634   (when (stringp group)
 635     (let* ((marks (if spam
 636                       (gnus-parameter-spam-marks group)
 637                     (gnus-parameter-ham-marks group)))
 638            (marks (car marks))
 639            (marks (if (listp (car marks)) (car marks) marks)))
 640       marks)))
 641
 642 (defun spam-group-spam-marks (group)
 643   "In GROUP, get all the spam marks."
 644   (spam-group-ham-marks group t))
 645
 646 (defun spam-group-spam-contents-p (group)
 647   "Is GROUP a spam group?"
 648   (if (stringp group)
 649       (or (member group spam-junk-mailgroups)
 650           (memq 'gnus-group-spam-classification-spam
 651                 (gnus-parameter-spam-contents group)))
 652     nil))
 653
 654 (defun spam-group-ham-contents-p (group)
 655   "Is GROUP a ham group?"
 656   (if (stringp group)
 657       (memq 'gnus-group-spam-classification-ham
 658             (gnus-parameter-spam-contents group))
 659     nil))
 660
 661 (defvar spam-list-of-processors
 662   '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
 663     (gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
 664     (gnus-group-spam-exit-processor-bsfilter     spam spam-use-bsfilter)
 665     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
 666     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
 667     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
 668     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
 669     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
 670     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
 671     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
 672     (gnus-group-ham-exit-processor-bsfilter      ham spam-use-bsfilter)
 673     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
 674     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
 675     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
 676     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
 677     (gnus-group-ham-exit-processor-spamassassin  ham spam-use-spamassassin)
 678     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
 679   "The `spam-list-of-processors' list.
 680 This list contains pairs associating a ham/spam exit processor
 681 variable with a classification and a spam-use-* variable.")
 682
 683 (defun spam-group-processor-p (group processor)
 684   (if (and (stringp group)
 685            (symbolp processor))
 686       (or (member processor (nth 0 (gnus-parameter-spam-process group)))
 687           (spam-group-processor-multiple-p
 688            group
 689            (cdr-safe (assoc processor spam-list-of-processors))))
 690     nil))
 691
 692 (defun spam-group-processor-multiple-p (group processor-info)
 693   (let* ((classification (nth 0 processor-info))
 694          (check (nth 1 processor-info))
 695          (parameters (nth 0 (gnus-parameter-spam-process group)))
 696          found)
 697     (dolist (parameter parameters)
 698       (when (and (null found)
 699                  (listp parameter)
 700                  (eq classification (nth 0 parameter))
 701                  (eq check (nth 1 parameter)))
 702         (setq found t)))
 703     found))
 704
 705 (defun spam-group-spam-processor-report-gmane-p (group)
 706   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
 707
 708 (defun spam-group-spam-processor-bogofilter-p (group)
 709   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 710
 711 (defun spam-group-spam-processor-blacklist-p (group)
 712   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 713
 714 (defun spam-group-spam-processor-ifile-p (group)
 715   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 716
 717 (defun spam-group-ham-processor-ifile-p (group)
 718   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 719
 720 (defun spam-group-spam-processor-spamoracle-p (group)
 721   (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
 722
 723 (defun spam-group-ham-processor-bogofilter-p (group)
 724   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 725
 726 (defun spam-group-spam-processor-stat-p (group)
 727   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 728
 729 (defun spam-group-ham-processor-stat-p (group)
 730   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 731
 732 (defun spam-group-ham-processor-whitelist-p (group)
 733   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 734
 735 (defun spam-group-ham-processor-BBDB-p (group)
 736   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 737
 738 (defun spam-group-ham-processor-copy-p (group)
 739   (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
 740
 741 (defun spam-group-ham-processor-spamoracle-p (group)
 742   (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
 743
 744 (defun spam-report-articles-gmane (n)
 745   "Report the current message as spam.
 746 Respects the process/prefix convention."
 747   (interactive "P")
 748   (dolist (article (gnus-summary-work-articles n))
 749     (gnus-summary-remove-process-mark article)
 750     (spam-report-gmane article)))
 751
 752 (defun spam-necessary-extra-headers ()
 753   "Return the extra headers spam.el thinks are necessary."
 754   (let (list)
 755     (when (or spam-use-spamassassin
 756               spam-use-spamassassin-headers
 757               spam-use-regex-headers)
 758       (push 'X-Spam-Status list))
 759     list))
 760
 761 (defun spam-user-format-function-S (headers)
 762   (when headers
 763     (spam-summary-score headers)))
 764
 765 (defun spam-article-sort-by-spam-status (h1 h2)
 766   "Sort articles by score."
 767   (let (result)
 768     (dolist (header (spam-necessary-extra-headers))
 769       (let ((s1 (spam-summary-score h1 header))
 770             (s2 (spam-summary-score h2 header)))
 771       (unless (= s1 s2)
 772         (setq result (< s1 s2))
 773         (return))))
 774     result))
 775
 776 (defun spam-extra-header-to-number (header headers)
 777   "Transform an extra header to a number."
 778   (if (gnus-extra-header header headers)
 779       (cond
 780        ((eq header 'X-Spam-Status)
 781         (string-to-number (gnus-replace-in-string
 782                            (gnus-extra-header header headers)
 783                            ".*hits=" "")))
 784        (t nil))
 785     nil))
 786
 787 (defun spam-summary-score (headers &optional specific-header)
 788   "Score an article for the summary buffer, as fast as possible.
 789 With SPECIFIC-HEADER, returns only that header's score.
 790 Will not return a nil score."
 791   (let (score)
 792     (dolist (header
 793              (if specific-header
 794                  (list specific-header)
 795                (spam-necessary-extra-headers)))
 796       (setq score
 797             (spam-extra-header-to-number header headers))
 798       (when score
 799         (return)))
 800     (or score 0)))
 801
 802 (defun spam-generic-score (&optional recheck)
 803   "Invoke whatever scoring method we can."
 804   (interactive "P")
 805   (cond
 806    ((or spam-use-spamassassin spam-use-spamassassin-headers)
 807     (spam-spamassassin-score recheck))
 808    ((or spam-use-bsfilter spam-use-bsfilter-headers)
 809     (spam-bsfilter-score recheck))
 810    (t (spam-bogofilter-score recheck))))
 811
 812 ;;; Summary entry and exit processing.
 813
 814 (defun spam-summary-prepare ()
 815   (setq spam-old-ham-articles
 816         (spam-list-articles gnus-newsgroup-articles 'ham))
 817   (setq spam-old-spam-articles
 818         (spam-list-articles gnus-newsgroup-articles 'spam))
 819   (spam-mark-junk-as-spam-routine))
 820
 821 ;; The spam processors are invoked for any group, spam or ham or neither
 822 (defun spam-summary-prepare-exit ()
 823   (unless gnus-group-is-exiting-without-update-p
 824     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 825
 826     ;; first of all, unregister any articles that are no longer ham or spam
 827     ;; we have to iterate over the processors, or else we'll be too slow
 828     (dolist (classification '(spam ham))
 829       (let* ((old-articles (if (eq classification 'spam)
 830                                spam-old-spam-articles
 831                              spam-old-ham-articles))
 832              (new-articles (spam-list-articles
 833                             gnus-newsgroup-articles
 834                             classification))
 835              (changed-articles (spam-set-difference new-articles old-articles)))
 836         ;; now that we have the changed articles, we go through the processors
 837         (dolist (processor-param spam-list-of-processors)
 838           (let ((processor (nth 0 processor-param))
 839                 (processor-classification (nth 1 processor-param))
 840                 (check (nth 2 processor-param))
 841                 unregister-list)
 842             (dolist (article changed-articles)
 843               (let ((id (spam-fetch-field-message-id-fast article)))
 844                 (when (spam-log-unregistration-needed-p
 845                        id 'process classification check)
 846                   (push article unregister-list))))
 847             ;; call spam-register-routine with specific articles to unregister,
 848             ;; when there are articles to unregister and the check is enabled
 849             (when (and unregister-list (symbol-value check))
 850               (spam-register-routine
 851                classification check t unregister-list))))))
 852
 853     ;; find all the spam processors applicable to this group
 854     (dolist (processor-param spam-list-of-processors)
 855       (let ((processor (nth 0 processor-param))
 856             (classification (nth 1 processor-param))
 857             (check (nth 2 processor-param)))
 858         (when (and (eq 'spam classification)
 859                    (spam-group-processor-p gnus-newsgroup-name processor))
 860           (spam-register-routine classification check))))
 861
 862     (unless (and spam-move-spam-nonspam-groups-only
 863                  (spam-group-spam-contents-p gnus-newsgroup-name))
 864       (gnus-message 6 "Marking spam as expired and moving it to %s"
 865                     (gnus-parameter-spam-process-destination
 866                      gnus-newsgroup-name))
 867       (spam-mark-spam-as-expired-and-move-routine
 868        (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 869
 870     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 871     ;; expire spam, in case the above did not expire them
 872     (when (< 0 (spam-list-articles
 873                 gnus-newsgroup-articles
 874                 'spam))
 875       (gnus-message 6 "Marking spam as expired without moving it")
 876       (spam-mark-spam-as-expired-and-move-routine nil))
 877
 878     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 879               (and (spam-group-spam-contents-p gnus-newsgroup-name)
 880                    spam-process-ham-in-spam-groups)
 881               spam-process-ham-in-nonham-groups)
 882       ;; find all the ham processors applicable to this group
 883       (dolist (processor-param spam-list-of-processors)
 884         (let ((processor (nth 0 processor-param))
 885               (classification (nth 1 processor-param))
 886               (check (nth 2 processor-param)))
 887           (when (and (eq 'ham classification)
 888                      (spam-group-processor-p gnus-newsgroup-name processor))
 889             (spam-register-routine classification check)))))
 890
 891     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
 892       (gnus-message 6 "Copying ham")
 893       (spam-ham-copy-routine
 894        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
 895
 896     ;; now move all ham articles out of spam groups
 897     (when (spam-group-spam-contents-p gnus-newsgroup-name)
 898       (gnus-message 6 "Moving ham messages from spam group")
 899       (spam-ham-move-routine
 900        (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 901
 902   (setq spam-old-ham-articles nil)
 903   (setq spam-old-spam-articles nil))
 904
 905 (defun spam-set-difference (list1 list2)
 906   "Return a set difference of LIST1 and LIST2.
 907 When either list is nil, the other is returned."
 908   (if (and list1 list2)
 909       ;; we have two non-nil lists
 910       (progn
 911         (dolist (item (append list1 list2))
 912           (when (and (memq item list1) (memq item list2))
 913             (setq list1 (delq item list1))
 914             (setq list2 (delq item list2))))
 915         (append list1 list2))
 916     ;; if either of the lists was nil, return the other one
 917     (if list1 list1 list2)))
 918
 919 (defun spam-mark-junk-as-spam-routine ()
 920   ;; check the global list of group names spam-junk-mailgroups and the
 921   ;; group parameters
 922   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 923     (gnus-message 6 "Marking %s articles as spam"
 924                   (if spam-mark-only-unseen-as-spam
 925                       "unseen"
 926                     "unread"))
 927     (let ((articles (if spam-mark-only-unseen-as-spam
 928                         gnus-newsgroup-unseen
 929                       gnus-newsgroup-unreads)))
 930       (dolist (article articles)
 931         (gnus-summary-mark-article article gnus-spam-mark)))))
 932
 933 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
 934   (if (and (car-safe groups) (listp (car-safe groups)))
 935       (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
 936     (gnus-summary-kill-process-mark)
 937     (let ((articles gnus-newsgroup-articles)
 938           (backend-supports-deletions
 939            (gnus-check-backend-function
 940             'request-move-article gnus-newsgroup-name))
 941           article tomove deletep)
 942       (dolist (article articles)
 943         (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 944           (gnus-summary-mark-article article gnus-expirable-mark)
 945           (push article tomove)))
 946
 947       ;; now do the actual copies
 948       (dolist (group groups)
 949         (when (and tomove
 950                    (stringp group))
 951           (dolist (article tomove)
 952             (gnus-summary-set-process-mark article))
 953           (when tomove
 954             (if (or (not backend-supports-deletions)
 955                     (> (length groups) 1))
 956                 (progn
 957                   (gnus-summary-copy-article nil group)
 958                   (setq deletep t))
 959               (gnus-summary-move-article nil group)))))
 960
 961       ;; now delete the articles, if there was a copy done, and the
 962       ;; backend allows it
 963       (when (and deletep backend-supports-deletions)
 964         (dolist (article tomove)
 965           (gnus-summary-set-process-mark article))
 966         (when tomove
 967           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 968             (gnus-summary-delete-article nil))))
 969
 970       (gnus-summary-yank-process-mark))))
 971
 972 (defun spam-ham-copy-or-move-routine (copy groups)
 973   (gnus-summary-kill-process-mark)
 974   (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
 975         (backend-supports-deletions
 976          (gnus-check-backend-function
 977           'request-move-article gnus-newsgroup-name))
 978         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
 979         article mark todo deletep respool)
 980
 981     (when (member 'respool groups)
 982       (setq respool t)                  ; boolean for later
 983       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
 984
 985     ;; now do the actual move
 986     (dolist (group groups)
 987       (when (and todo (stringp group))
 988         (dolist (article todo)
 989           (when spam-mark-ham-unread-before-move-from-spam-group
 990             (gnus-summary-mark-article article gnus-unread-mark))
 991           (gnus-summary-set-process-mark article))
 992
 993         (if respool                        ; respooling is with a "fake" group
 994             (let ((spam-split-disabled
 995                    (or spam-split-disabled
 996                        spam-disable-spam-split-during-ham-respool)))
 997               (gnus-summary-respool-article nil respool-method))
 998           (if (or (not backend-supports-deletions) ; else, we are not respooling
 999                   (> (length groups) 1))
1000               (progn                ; if copying, copy and set deletep
1001                 (gnus-summary-copy-article nil group)
1002                 (setq deletep t))
1003             (gnus-summary-move-article nil group))))) ; else move articles
1004
1005     ;; now delete the articles, unless a) copy is t, and there was a copy done
1006     ;;                                 b) a move was done to a single group
1007     ;;                                 c) backend-supports-deletions is nil
1008     (unless copy
1009       (when (and deletep backend-supports-deletions)
1010         (dolist (article todo)
1011           (gnus-summary-set-process-mark article))
1012         (when todo
1013           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1014             (gnus-summary-delete-article nil))))))
1015
1016   (gnus-summary-yank-process-mark))
1017
1018 (defun spam-ham-copy-routine (&rest groups)
1019   (if (and (car-safe groups) (listp (car-safe groups)))
1020       (apply 'spam-ham-copy-routine (car groups))
1021     (spam-ham-copy-or-move-routine t groups)))
1022
1023 (defun spam-ham-move-routine (&rest groups)
1024   (if (and (car-safe groups) (listp (car-safe groups)))
1025       (apply 'spam-ham-move-routine (car groups))
1026     (spam-ham-copy-or-move-routine nil groups)))
1027
1028 (defun spam-get-article-as-string (article)
1029   (when (numberp article)
1030     (with-temp-buffer
1031       (gnus-request-article-this-buffer
1032        article
1033        gnus-newsgroup-name)
1034       (buffer-string))))
1035
1036 ;; disabled for now
1037 ;; (defun spam-get-article-as-filename (article)
1038 ;;   (let ((article-filename))
1039 ;;     (when (numberp article)
1040 ;;       (nnml-possibly-change-directory
1041 ;;        (gnus-group-real-name gnus-newsgroup-name))
1042 ;;       (setq article-filename (expand-file-name
1043 ;;                              (int-to-string article) nnml-current-directory)))
1044 ;;     (if (file-exists-p article-filename)
1045 ;;      article-filename
1046 ;;       nil)))
1047
1048 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
1049   "Fetch a field quickly, using the internal gnus-data-list function"
1050   (when (numberp article)
1051     (let* ((data-header (or prepared-data-header
1052                             (spam-fetch-article-header article))))
1053       (if (arrayp data-header)
1054         (cond
1055          ((equal field 'from)
1056           (mail-header-from data-header))
1057          ((equal field 'message-id)
1058           (mail-header-message-id data-header))
1059          ((equal field 'subject)
1060           (mail-header-subject data-header))
1061          ((equal field 'references)
1062           (mail-header-references data-header))
1063          ((equal field 'date)
1064           (mail-header-date data-header))
1065          ((equal field 'xref)
1066           (mail-header-xref data-header))
1067          ((equal field 'extra)
1068           (mail-header-extra data-header))
1069          (t
1070           nil))
1071         (gnus-message 6 "Article %d has a nil data header" article)))))
1072
1073 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1074   (spam-fetch-field-fast article 'from prepared-data-header))
1075
1076 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1077   (spam-fetch-field-fast article 'subject prepared-data-header))
1078
1079 (defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1080   (spam-fetch-field-fast article 'message-id prepared-data-header))
1081
1082 (defun spam-generate-fake-headers (article)
1083   (let ((dh (spam-fetch-article-header article)))
1084     (if dh
1085         (concat
1086          (format
1087           (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1088                   "Date: %s\nReferences: %s\nXref: %s\n")
1089           (spam-fetch-field-fast article 'from dh)
1090           (spam-fetch-field-fast article 'subject dh)
1091           (spam-fetch-field-fast article 'message-id dh)
1092           (spam-fetch-field-fast article 'date dh)
1093           (spam-fetch-field-fast article 'references dh)
1094           (spam-fetch-field-fast article 'xref dh))
1095          (when (spam-fetch-field-fast article 'extra dh)
1096            (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1097       (gnus-message
1098        5
1099        "spam-generate-fake-headers: article %d didn't have a valid header"
1100        article))))
1101
1102 (defun spam-fetch-article-header (article)
1103   (save-excursion
1104     (set-buffer gnus-summary-buffer)
1105     (gnus-read-header article)
1106     (nth 3 (assq article gnus-newsgroup-data))))
1107
1108 \f
1109 ;;;; Spam determination.
1110
1111 (defvar spam-list-of-checks
1112   '((spam-use-blacklist                 .       spam-check-blacklist)
1113     (spam-use-regex-headers             .       spam-check-regex-headers)
1114     (spam-use-gmane-xref                .       spam-check-gmane-xref)
1115     (spam-use-regex-body                .       spam-check-regex-body)
1116     (spam-use-whitelist                 .       spam-check-whitelist)
1117     (spam-use-BBDB                      .       spam-check-BBDB)
1118     (spam-use-BBDB-exclusive            .       spam-check-BBDB)
1119     (spam-use-ifile                     .       spam-check-ifile)
1120     (spam-use-spamoracle                .       spam-check-spamoracle)
1121     (spam-use-stat                      .       spam-check-stat)
1122     (spam-use-blackholes                .       spam-check-blackholes)
1123     (spam-use-hashcash                  .       spam-check-hashcash)
1124     (spam-use-spamassassin-headers      .       spam-check-spamassassin-headers)
1125     (spam-use-spamassassin              .       spam-check-spamassassin)
1126     (spam-use-bogofilter-headers        .       spam-check-bogofilter-headers)
1127     (spam-use-bogofilter                .       spam-check-bogofilter)
1128     (spam-use-bsfilter-headers          .       spam-check-bsfilter-headers)
1129     (spam-use-bsfilter                  .       spam-check-bsfilter))
1130   "The spam-list-of-checks list contains pairs associating a
1131 parameter variable with a spam checking function.  If the
1132 parameter variable is true, then the checking function is called,
1133 and its value decides what happens.  Each individual check may
1134 return nil, t, or a mailgroup name.  The value nil means that the
1135 check does not yield a decision, and so, that further checks are
1136 needed.  The value t means that the message is definitely not
1137 spam, and that further spam checks should be inhibited.
1138 Otherwise, a mailgroup name or the symbol 'spam (depending on
1139 spam-split-symbolic-return) is returned where the mail should go,
1140 and further checks are also inhibited.  The usual mailgroup name
1141 is the value of `spam-split-group', meaning that the message is
1142 definitely a spam.")
1143
1144 (defvar spam-list-of-statistical-checks
1145   '(spam-use-ifile
1146     spam-use-regex-body
1147     spam-use-stat
1148     spam-use-bogofilter
1149     spam-use-bsfilter
1150     spam-use-blackholes
1151     spam-use-spamassassin
1152     spam-use-spamoracle)
1153   "The spam-list-of-statistical-checks list contains all the mail
1154 splitters that need to have the full message body available.
1155 Note that you should fetch extra headers if you don't like this,
1156 e.g. fetch the 'Received' header for spam-use-blackholes.")
1157
1158 (defun spam-split (&rest specific-checks)
1159   "Split this message into the `spam' group if it is spam.
1160 This function can be used as an entry in the variable `nnmail-split-fancy',
1161 for example like this: (: spam-split).  It can take checks as
1162 parameters.  A string as a parameter will set the
1163 spam-split-group to that string.
1164
1165 See the Info node `(gnus)Fancy Mail Splitting' for more details."
1166   (interactive)
1167   (setq spam-split-last-successful-check nil)
1168   (unless spam-split-disabled
1169     (let ((spam-split-group-choice spam-split-group))
1170       (dolist (check specific-checks)
1171         (when (stringp check)
1172           (setq spam-split-group-choice check)
1173           (setq specific-checks (delq check specific-checks))))
1174
1175       (let ((spam-split-group spam-split-group-choice))
1176         (save-excursion
1177           (save-restriction
1178             (dolist (check spam-list-of-statistical-checks)
1179               (when (and (symbolp check)
1180                          (or (symbol-value check)
1181                              (memq check specific-checks)))
1182                 (widen)
1183                 (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
1184                               (symbol-name check))
1185                 (return)))
1186             ;;   (progn (widen) (debug (buffer-string)))
1187             (let ((list-of-checks spam-list-of-checks)
1188                   decision)
1189               (while (and list-of-checks (not decision))
1190                 (let ((pair (pop list-of-checks)))
1191                   (when (or
1192                          ;; either, given specific checks, this is one of them
1193                          (and specific-checks (memq (car pair) specific-checks))
1194                          ;; or, given no specific checks, spam-use-CHECK is set
1195                          (and (null specific-checks) (symbol-value (car pair))))
1196                     (gnus-message 6 "spam-split: calling the %s function"
1197                                   (symbol-name (cdr pair)))
1198                     (setq decision (funcall (cdr pair)))
1199                     ;; if we got a decision at all, save the current check
1200                     (when decision
1201                       (setq spam-split-last-successful-check (car pair)))
1202
1203                     (when (eq decision 'spam)
1204                       (unless spam-split-symbolic-return
1205                         (gnus-error
1206                          5
1207                          (format "spam-split got %s but %s is nil"
1208                                  (symbol-name decision)
1209                                  (symbol-name spam-split-symbolic-return))))))))
1210               (if (eq decision t)
1211                   (if spam-split-symbolic-return-positive 'ham nil)
1212                 decision))))))))
1213
1214 (defun spam-find-spam ()
1215   "This function will detect spam in the current newsgroup using spam-split."
1216   (interactive)
1217
1218   (let* ((group gnus-newsgroup-name)
1219          (autodetect (gnus-parameter-spam-autodetect group))
1220          (methods (gnus-parameter-spam-autodetect-methods group))
1221          (first-method (nth 0 methods))
1222          (articles (if spam-autodetect-recheck-messages
1223                        gnus-newsgroup-articles
1224                      gnus-newsgroup-unseen))
1225          article-cannot-be-faked)
1226
1227     (dolist (check spam-list-of-statistical-checks)
1228       (when (and (symbolp check)
1229                  (memq check methods))
1230         (setq article-cannot-be-faked t)
1231         (return)))
1232
1233     (when (memq 'default methods)
1234       (setq article-cannot-be-faked t))
1235
1236     (when (and autodetect
1237                (not (equal first-method 'none)))
1238     (mapcar
1239      (lambda (article)
1240        (let ((id (spam-fetch-field-message-id-fast article))
1241              (subject (spam-fetch-field-subject-fast article))
1242              (sender (spam-fetch-field-from-fast article))
1243              registry-lookup)
1244
1245          (unless id
1246            (gnus-message 6 "Article %d has no message ID!" article))
1247
1248          (when (and id spam-log-to-registry)
1249            (setq registry-lookup (spam-log-registration-type id 'incoming))
1250            (when registry-lookup
1251              (gnus-message
1252               9
1253               "spam-find-spam: message %s was already registered incoming"
1254               id)))
1255
1256          (let* ((spam-split-symbolic-return t)
1257                 (spam-split-symbolic-return-positive t)
1258                 (fake-headers (spam-generate-fake-headers article))
1259                 (split-return
1260                  (or registry-lookup
1261                      (with-temp-buffer
1262                        (if article-cannot-be-faked
1263                            (gnus-request-article-this-buffer
1264                             article
1265                             group)
1266                          ;; else, we fake the article
1267                          (when fake-headers (insert fake-headers)))
1268                        (if (or (null first-method)
1269                                (equal first-method 'default))
1270                            (spam-split)
1271                          (apply 'spam-split methods))))))
1272            (if (equal split-return 'spam)
1273                (gnus-summary-mark-article article gnus-spam-mark))
1274
1275            (when (and id split-return spam-log-to-registry)
1276              (when (zerop (gnus-registry-group-count id))
1277                (gnus-registry-add-group
1278                 id group subject sender))
1279
1280              (unless registry-lookup
1281                (spam-log-processing-to-registry
1282                 id
1283                 'incoming
1284                 split-return
1285                 spam-split-last-successful-check
1286                 group))))))
1287     articles))))
1288
1289 (defvar spam-registration-functions
1290   ;; first the ham register, second the spam register function
1291   ;; third the ham unregister, fourth the spam unregister function
1292   '((spam-use-blacklist  nil
1293                          spam-blacklist-register-routine
1294                          nil
1295                          spam-blacklist-unregister-routine)
1296     (spam-use-whitelist  spam-whitelist-register-routine
1297                          nil
1298                          spam-whitelist-unregister-routine
1299                          nil)
1300     (spam-use-ham-copy   nil
1301                          nil
1302                          nil
1303                          nil)
1304     (spam-use-BBDB       spam-BBDB-register-routine
1305                          nil
1306                          spam-BBDB-unregister-routine
1307                          nil)
1308     (spam-use-ifile      spam-ifile-register-ham-routine
1309                          spam-ifile-register-spam-routine
1310                          spam-ifile-unregister-ham-routine
1311                          spam-ifile-unregister-spam-routine)
1312     (spam-use-spamoracle spam-spamoracle-learn-ham
1313                          spam-spamoracle-learn-spam
1314                          spam-spamoracle-unlearn-ham
1315                          spam-spamoracle-unlearn-spam)
1316     (spam-use-stat       spam-stat-register-ham-routine
1317                          spam-stat-register-spam-routine
1318                          spam-stat-unregister-ham-routine
1319                          spam-stat-unregister-spam-routine)
1320     ;; note that spam-use-gmane is not a legitimate check
1321     (spam-use-gmane      nil
1322                          spam-report-gmane-register-routine
1323                          ;; does Gmane support unregistration?
1324                          nil
1325                          nil)
1326     (spam-use-spamassassin spam-spamassassin-register-ham-routine
1327                            spam-spamassassin-register-spam-routine
1328                            spam-spamassassin-unregister-ham-routine
1329                            spam-spamassassin-unregister-spam-routine)
1330     (spam-use-bogofilter spam-bogofilter-register-ham-routine
1331                          spam-bogofilter-register-spam-routine
1332                          spam-bogofilter-unregister-ham-routine
1333                          spam-bogofilter-unregister-spam-routine)
1334     (spam-use-bsfilter   spam-bsfilter-register-ham-routine
1335                          spam-bsfilter-register-spam-routine
1336                          spam-bsfilter-unregister-ham-routine
1337                          spam-bsfilter-unregister-spam-routine))
1338   "The spam-registration-functions list contains pairs
1339 associating a parameter variable with the ham and spam
1340 registration functions, and the ham and spam unregistration
1341 functions")
1342
1343 (defun spam-classification-valid-p (classification)
1344   (or  (eq classification 'spam)
1345        (eq classification 'ham)))
1346
1347 (defun spam-process-type-valid-p (process-type)
1348   (or  (eq process-type 'incoming)
1349        (eq process-type 'process)))
1350
1351 (defun spam-registration-check-valid-p (check)
1352   (assoc check spam-registration-functions))
1353
1354 (defun spam-unregistration-check-valid-p (check)
1355   (assoc check spam-registration-functions))
1356
1357 (defun spam-registration-function (classification check)
1358   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1359     (if (eq classification 'spam)
1360         (nth 1 flist)
1361       (nth 0 flist))))
1362
1363 (defun spam-unregistration-function (classification check)
1364   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1365     (if (eq classification 'spam)
1366         (nth 3 flist)
1367       (nth 2 flist))))
1368
1369 (defun spam-list-articles (articles classification)
1370   (let ((mark-check (if (eq classification 'spam)
1371                         'spam-group-spam-mark-p
1372                       'spam-group-ham-mark-p))
1373         alist mark-cache-yes mark-cache-no)
1374     (dolist (article articles)
1375       (let ((mark (gnus-summary-article-mark article)))
1376         (unless (or (memq mark mark-cache-yes)
1377                     (memq mark mark-cache-no))
1378           (if (funcall mark-check
1379                        gnus-newsgroup-name
1380                        mark)
1381               (push mark mark-cache-yes)
1382             (push mark mark-cache-no)))
1383         (when (memq mark mark-cache-yes)
1384           (push article alist))))
1385     alist))
1386
1387 (defun spam-register-routine (classification
1388                               check
1389                               &optional unregister
1390                               specific-articles)
1391   (when (and (spam-classification-valid-p classification)
1392              (spam-registration-check-valid-p check))
1393     (let* ((register-function
1394             (spam-registration-function classification check))
1395            (unregister-function
1396             (spam-unregistration-function classification check))
1397            (run-function (if unregister
1398                              unregister-function
1399                            register-function))
1400            (log-function (if unregister
1401                              'spam-log-undo-registration
1402                            'spam-log-processing-to-registry))
1403            article articles)
1404
1405       (when run-function
1406         ;; make list of articles, using specific-articles if given
1407         (setq articles (or specific-articles
1408                            (spam-list-articles
1409                             gnus-newsgroup-articles
1410                             classification)))
1411         ;; process them
1412         (gnus-message 5 "%s %d %s articles as %s using backend %s"
1413                       (if unregister "Unregistering" "Registering")
1414                       (length articles)
1415                       (if specific-articles "specific" "")
1416                       (symbol-name classification)
1417                       (symbol-name check))
1418         (funcall run-function articles)
1419         ;; now log all the registrations (or undo them, depending on unregister)
1420         (dolist (article articles)
1421           (funcall log-function
1422                    (spam-fetch-field-message-id-fast article)
1423                    'process
1424                    classification
1425                    check
1426                    gnus-newsgroup-name))))))
1427
1428 ;;; log a ham- or spam-processor invocation to the registry
1429 (defun spam-log-processing-to-registry (id type classification check group)
1430   (when spam-log-to-registry
1431     (if (and (stringp id)
1432              (stringp group)
1433              (spam-process-type-valid-p type)
1434              (spam-classification-valid-p classification)
1435              (spam-registration-check-valid-p check))
1436         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1437               (cell (list classification check group)))
1438           (push cell cell-list)
1439           (gnus-registry-store-extra-entry
1440            id
1441            type
1442            cell-list))
1443
1444       (gnus-message
1445        5
1446        (format "%s call with bad ID, type, classification, spam-check, or group"
1447                "spam-log-processing-to-registry")))))
1448
1449 ;;; check if a ham- or spam-processor registration has been done
1450 (defun spam-log-registered-p (id type)
1451   (when spam-log-to-registry
1452     (if (and (stringp id)
1453              (spam-process-type-valid-p type))
1454         (cdr-safe (gnus-registry-fetch-extra id type))
1455       (progn
1456         (gnus-message
1457          5
1458          (format "%s called with bad ID, type, classification, or spam-check"
1459                  "spam-log-registered-p"))
1460         nil))))
1461
1462 ;;; check what a ham- or spam-processor registration says
1463 ;;; returns nil if conflicting registrations are found
1464 (defun spam-log-registration-type (id type)
1465   (let ((count 0)
1466         decision)
1467     (dolist (reg (spam-log-registered-p id type))
1468       (let ((classification (nth 0 reg)))
1469         (when (spam-classification-valid-p classification)
1470           (when (and decision
1471                      (not (eq classification decision)))
1472             (setq count (+ 1 count)))
1473           (setq decision classification))))
1474     (if (< 0 count)
1475         nil
1476       decision)))
1477
1478
1479 ;;; check if a ham- or spam-processor registration needs to be undone
1480 (defun spam-log-unregistration-needed-p (id type classification check)
1481   (when spam-log-to-registry
1482     (if (and (stringp id)
1483              (spam-process-type-valid-p type)
1484              (spam-classification-valid-p classification)
1485              (spam-registration-check-valid-p check))
1486         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1487               found)
1488           (dolist (cell cell-list)
1489             (unless found
1490               (when (and (eq classification (nth 0 cell))
1491                          (eq check (nth 1 cell)))
1492                 (setq found t))))
1493           found)
1494       (progn
1495         (gnus-message
1496          5
1497          (format "%s called with bad ID, type, classification, or spam-check"
1498                  "spam-log-unregistration-needed-p"))
1499         nil))))
1500
1501
1502 ;;; undo a ham- or spam-processor registration (the group is not used)
1503 (defun spam-log-undo-registration (id type classification check &optional group)
1504   (when (and spam-log-to-registry
1505              (spam-log-unregistration-needed-p id type classification check))
1506     (if (and (stringp id)
1507              (spam-process-type-valid-p type)
1508              (spam-classification-valid-p classification)
1509              (spam-registration-check-valid-p check))
1510         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1511               new-cell-list found)
1512           (dolist (cell cell-list)
1513             (unless (and (eq classification (nth 0 cell))
1514                          (eq check (nth 1 cell)))
1515               (push cell new-cell-list)))
1516           (gnus-registry-store-extra-entry
1517            id
1518            type
1519            new-cell-list))
1520       (progn
1521         (gnus-message 6 (format "%s call with bad ID, type, spam-check, or group"
1522                                 "spam-log-undo-registration"))
1523         nil))))
1524
1525 ;;; set up IMAP widening if it's necessary
1526 (defun spam-setup-widening ()
1527   (dolist (check spam-list-of-statistical-checks)
1528     (when (symbol-value check)
1529       (setq nnimap-split-download-body-default t))))
1530
1531 \f
1532 ;;;; Gmane xrefs
1533 (defun spam-check-gmane-xref ()
1534   (let ((header (or
1535                  (message-fetch-field "Xref")
1536                  (message-fetch-field "Newsgroups")))
1537         (spam-split-group (if spam-split-symbolic-return
1538                               'spam
1539                             spam-split-group)))
1540     (when header                        ; return nil when no header
1541       (when (string-match spam-gmane-xref-spam-group
1542                           header)
1543           spam-split-group))))
1544
1545 \f
1546 ;;;; Regex body
1547
1548 (defun spam-check-regex-body ()
1549   (let ((spam-regex-headers-ham spam-regex-body-ham)
1550         (spam-regex-headers-spam spam-regex-body-spam))
1551     (spam-check-regex-headers t)))
1552
1553 \f
1554 ;;;; Regex headers
1555
1556 (defun spam-check-regex-headers (&optional body)
1557   (let ((type (if body "body" "header"))
1558         (spam-split-group (if spam-split-symbolic-return
1559                               'spam
1560                             spam-split-group))
1561         ret found)
1562     (dolist (h-regex spam-regex-headers-ham)
1563       (unless found
1564         (goto-char (point-min))
1565         (when (re-search-forward h-regex nil t)
1566           (message "Ham regex %s search positive." type)
1567           (setq found t))))
1568     (dolist (s-regex spam-regex-headers-spam)
1569       (unless found
1570         (goto-char (point-min))
1571         (when (re-search-forward s-regex nil t)
1572           (message "Spam regex %s search positive." type)
1573           (setq found t)
1574           (setq ret spam-split-group))))
1575     ret))
1576
1577 \f
1578 ;;;; Blackholes.
1579
1580 (defun spam-reverse-ip-string (ip)
1581   (when (stringp ip)
1582     (mapconcat 'identity
1583                (nreverse (split-string ip "\\."))
1584                ".")))
1585
1586 (defun spam-check-blackholes ()
1587   "Check the Received headers for blackholed relays."
1588   (let ((headers (message-fetch-field "received"))
1589         (spam-split-group (if spam-split-symbolic-return
1590                               'spam
1591                             spam-split-group))
1592         ips matches)
1593     (when headers
1594       (with-temp-buffer
1595         (insert headers)
1596         (goto-char (point-min))
1597         (gnus-message 6 "Checking headers for relay addresses")
1598         (while (re-search-forward
1599                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1600           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1601           (push (spam-reverse-ip-string (match-string 1))
1602                 ips)))
1603       (dolist (server spam-blackhole-servers)
1604         (dolist (ip ips)
1605           (unless (and spam-blackhole-good-server-regex
1606                        ;; match the good-server-regex against the reversed (again) IP string
1607                        (string-match
1608                         spam-blackhole-good-server-regex
1609                         (spam-reverse-ip-string ip)))
1610             (unless matches
1611               (let ((query-string (concat ip "." server)))
1612                 (if spam-use-dig
1613                     (let ((query-result (query-dig query-string)))
1614                       (when query-result
1615                         (gnus-message 6 "(DIG): positive blackhole check '%s'"
1616                                       query-result)
1617                         (push (list ip server query-result)
1618                               matches)))
1619                   ;; else, if not using dig.el
1620                   (when (query-dns query-string)
1621                     (gnus-message 6 "positive blackhole check")
1622                     (push (list ip server (query-dns query-string 'TXT))
1623                           matches)))))))))
1624     (when matches
1625       spam-split-group)))
1626 \f
1627 ;;;; Hashcash.
1628
1629 (condition-case nil
1630     (progn
1631       (require 'hashcash)
1632
1633       (defun spam-check-hashcash ()
1634         "Check the headers for hashcash payments."
1635         (mail-check-payment)))   ;mail-check-payment returns a boolean
1636
1637   (file-error (progn
1638                 (defalias 'mail-check-payment 'ignore)
1639                 (defalias 'spam-check-hashcash 'ignore))))
1640 \f
1641 ;;;; BBDB
1642
1643 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
1644 ;;; <sacha@giotto.sj.ru>
1645
1646 ;; all this is done inside a condition-case to trap errors
1647
1648 (condition-case nil
1649     (progn
1650       (require 'bbdb)
1651       (require 'bbdb-com)
1652
1653       ;; when the BBDB changes, we want to clear out our cache
1654       (defun spam-clear-cache-BBDB (&rest immaterial)
1655         (spam-clear-cache 'spam-use-BBDB))
1656
1657       (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
1658
1659       (defun spam-enter-ham-BBDB (addresses &optional remove)
1660         "Enter an address into the BBDB; implies ham (non-spam) sender"
1661         (dolist (from addresses)
1662           (when (stringp from)
1663             (let* ((parsed-address (gnus-extract-address-components from))
1664                    (name (or (nth 0 parsed-address) "Ham Sender"))
1665                    (remove-function (if remove
1666                                         'bbdb-delete-record-internal
1667                                       'ignore))
1668                    (net-address (nth 1 parsed-address))
1669                    (record (and net-address
1670                                 (bbdb-search-simple nil net-address))))
1671               (when net-address
1672                 (gnus-message 6 "%s address %s %s BBDB"
1673                               (if remove "Deleting" "Adding")
1674                               from
1675                               (if remove "from" "to"))
1676                 (if record
1677                     (funcall remove-function record)
1678                   (bbdb-create-internal name nil net-address nil nil
1679                                         "ham sender added by spam.el")))))))
1680
1681       (defun spam-BBDB-register-routine (articles &optional unregister)
1682         (let (addresses)
1683           (dolist (article articles)
1684             (when (stringp (spam-fetch-field-from-fast article))
1685               (push (spam-fetch-field-from-fast article) addresses)))
1686           ;; now do the register/unregister action
1687           (spam-enter-ham-BBDB addresses unregister)))
1688
1689       (defun spam-BBDB-unregister-routine (articles)
1690         (spam-BBDB-register-routine articles t))
1691
1692       (defun spam-check-BBDB ()
1693         "Mail from people in the BBDB is classified as ham or non-spam"
1694         (let ((who (message-fetch-field "from"))
1695               (spam-split-group (if spam-split-symbolic-return
1696                                     'spam
1697                                   spam-split-group))
1698               bbdb-cache bbdb-hashtable)
1699           (when spam-cache-lookups
1700             (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
1701             (unless bbdb-cache
1702               (setq bbdb-cache
1703                     ;; this is the expanded (bbdb-hashtable) macro
1704                     ;; without the debugging support
1705                     (with-current-buffer (bbdb-buffer)
1706                       (save-excursion
1707                         (save-window-excursion
1708                           (bbdb-records nil t)
1709                           bbdb-hashtable))))
1710               (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
1711           (when who
1712             (setq who (nth 1 (gnus-extract-address-components who)))
1713             (if
1714                 (if spam-cache-lookups
1715                     (symbol-value
1716                      (intern-soft who bbdb-cache))
1717                   (bbdb-search-simple nil who))
1718                 t
1719               (if spam-use-BBDB-exclusive
1720                   spam-split-group
1721                 nil))))))
1722
1723   (file-error (progn
1724                 (defalias 'bbdb-search-simple 'ignore)
1725                 (defalias 'bbdb-records 'ignore)
1726                 (defalias 'bbdb-buffer 'ignore)
1727                 (defalias 'spam-check-BBDB 'ignore)
1728                 (defalias 'spam-BBDB-register-routine 'ignore)
1729                 (defalias 'spam-enter-ham-BBDB 'ignore)
1730                 (defalias 'bbdb-create-internal 'ignore)
1731                 (defalias 'bbdb-delete-record-internal 'ignore)
1732                 (defalias 'bbdb-records 'ignore))))
1733
1734 \f
1735 ;;;; ifile
1736
1737 ;;; check the ifile backend; return nil if the mail was NOT classified
1738 ;;; as spam
1739
1740 (defun spam-get-ifile-database-parameter ()
1741   "Get the command-line parameter for ifile's database from
1742   spam-ifile-database-path."
1743   (if spam-ifile-database-path
1744       (format "--db-file=%s" spam-ifile-database-path)
1745     nil))
1746
1747 (defun spam-check-ifile ()
1748   "Check the ifile backend for the classification of this message."
1749   (let ((article-buffer-name (buffer-name))
1750         (spam-split-group (if spam-split-symbolic-return
1751                               'spam
1752                             spam-split-group))
1753         category return)
1754     (with-temp-buffer
1755       (let ((temp-buffer-name (buffer-name))
1756             (db-param (spam-get-ifile-database-parameter)))
1757         (save-excursion
1758           (set-buffer article-buffer-name)
1759           (apply 'call-process-region
1760                  (point-min) (point-max) spam-ifile-path
1761                  nil temp-buffer-name nil "-c"
1762                  (if db-param `(,db-param "-q") `("-q"))))
1763         ;; check the return now (we're back in the temp buffer)
1764         (goto-char (point-min))
1765         (if (not (eobp))
1766             (setq category (buffer-substring (point) (point-at-eol))))
1767         (when (not (zerop (length category))) ; we need a category here
1768           (if spam-ifile-all-categories
1769               (setq return category)
1770             ;; else, if spam-ifile-all-categories is not set...
1771             (when (string-equal spam-ifile-spam-category category)
1772               (setq return spam-split-group)))))) ; note return is nil otherwise
1773     return))
1774
1775 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
1776   "Register an article, given as a string, with a category.
1777 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1778   (let ((category (or category gnus-newsgroup-name))
1779         (add-or-delete-option (if unregister "-d" "-i"))
1780         (db (spam-get-ifile-database-parameter))
1781         parameters)
1782     (with-temp-buffer
1783       (dolist (article articles)
1784         (let ((article-string (spam-get-article-as-string article)))
1785           (when (stringp article-string)
1786             (insert article-string))))
1787       (apply 'call-process-region
1788              (point-min) (point-max) spam-ifile-path
1789              nil nil nil
1790              add-or-delete-option category
1791              (if db `(,db "-h") `("-h"))))))
1792
1793 (defun spam-ifile-register-spam-routine (articles &optional unregister)
1794   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
1795
1796 (defun spam-ifile-unregister-spam-routine (articles)
1797   (spam-ifile-register-spam-routine articles t))
1798
1799 (defun spam-ifile-register-ham-routine (articles &optional unregister)
1800   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
1801
1802 (defun spam-ifile-unregister-ham-routine (articles)
1803   (spam-ifile-register-ham-routine articles t))
1804
1805 \f
1806 ;;;; spam-stat
1807
1808 (condition-case nil
1809     (progn
1810       (let ((spam-stat-install-hooks nil))
1811         (require 'spam-stat))
1812
1813       (defun spam-check-stat ()
1814         "Check the spam-stat backend for the classification of this message"
1815         (let ((spam-split-group (if spam-split-symbolic-return
1816                                     'spam
1817                                   spam-split-group))
1818               (spam-stat-split-fancy-spam-group spam-split-group) ; override
1819               (spam-stat-buffer (buffer-name)) ; stat the current buffer
1820               category return)
1821           (spam-stat-split-fancy)))
1822
1823       (defun spam-stat-register-spam-routine (articles &optional unregister)
1824         (dolist (article articles)
1825           (let ((article-string (spam-get-article-as-string article)))
1826             (with-temp-buffer
1827               (insert article-string)
1828               (if unregister
1829                   (spam-stat-buffer-change-to-non-spam)
1830               (spam-stat-buffer-is-spam))))))
1831
1832       (defun spam-stat-unregister-spam-routine (articles)
1833         (spam-stat-register-spam-routine articles t))
1834
1835       (defun spam-stat-register-ham-routine (articles &optional unregister)
1836         (dolist (article articles)
1837           (let ((article-string (spam-get-article-as-string article)))
1838             (with-temp-buffer
1839               (insert article-string)
1840               (if unregister
1841                   (spam-stat-buffer-change-to-spam)
1842               (spam-stat-buffer-is-non-spam))))))
1843
1844       (defun spam-stat-unregister-ham-routine (articles)
1845         (spam-stat-register-ham-routine articles t))
1846
1847       (defun spam-maybe-spam-stat-load ()
1848         (when spam-use-stat (spam-stat-load)))
1849
1850       (defun spam-maybe-spam-stat-save ()
1851         (when spam-use-stat (spam-stat-save))))
1852
1853   (file-error (progn
1854                 (defalias 'spam-stat-load 'ignore)
1855                 (defalias 'spam-stat-save 'ignore)
1856                 (defalias 'spam-maybe-spam-stat-load 'ignore)
1857                 (defalias 'spam-maybe-spam-stat-save 'ignore)
1858                 (defalias 'spam-stat-register-ham-routine 'ignore)
1859                 (defalias 'spam-stat-unregister-ham-routine 'ignore)
1860                 (defalias 'spam-stat-register-spam-routine 'ignore)
1861                 (defalias 'spam-stat-unregister-spam-routine 'ignore)
1862                 (defalias 'spam-stat-buffer-is-spam 'ignore)
1863                 (defalias 'spam-stat-buffer-change-to-spam 'ignore)
1864                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
1865                 (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
1866                 (defalias 'spam-stat-split-fancy 'ignore)
1867                 (defalias 'spam-check-stat 'ignore))))
1868
1869 \f
1870
1871 ;;;; Blacklists and whitelists.
1872
1873 (defvar spam-whitelist-cache nil)
1874 (defvar spam-blacklist-cache nil)
1875
1876 (defun spam-kill-whole-line ()
1877   (beginning-of-line)
1878   (let ((kill-whole-line t))
1879     (kill-line)))
1880
1881 ;;; address can be a list, too
1882 (defun spam-enter-whitelist (address &optional remove)
1883   "Enter ADDRESS (list or single) into the whitelist.
1884 With a non-nil REMOVE, remove them."
1885   (interactive "sAddress: ")
1886   (spam-enter-list address spam-whitelist remove)
1887   (setq spam-whitelist-cache nil)
1888   (spam-clear-cache 'spam-use-whitelist))
1889
1890 ;;; address can be a list, too
1891 (defun spam-enter-blacklist (address &optional remove)
1892   "Enter ADDRESS (list or single) into the blacklist.
1893 With a non-nil REMOVE, remove them."
1894   (interactive "sAddress: ")
1895   (spam-enter-list address spam-blacklist remove)
1896   (setq spam-blacklist-cache nil)
1897   (spam-clear-cache 'spam-use-whitelist))
1898
1899 (defun spam-enter-list (addresses file &optional remove)
1900   "Enter ADDRESSES into the given FILE.
1901 Either the whitelist or the blacklist files can be used.  With
1902 REMOVE not nil, remove the ADDRESSES."
1903   (if (stringp addresses)
1904       (spam-enter-list (list addresses) file remove)
1905     ;; else, we have a list of addresses here
1906     (unless (file-exists-p (file-name-directory file))
1907       (make-directory (file-name-directory file) t))
1908     (save-excursion
1909       (set-buffer
1910        (find-file-noselect file))
1911       (dolist (a addresses)
1912         (when (stringp a)
1913           (goto-char (point-min))
1914           (if (re-search-forward (regexp-quote a) nil t)
1915               ;; found the address
1916               (when remove
1917                 (spam-kill-whole-line))
1918             ;; else, the address was not found
1919             (unless remove
1920               (goto-char (point-max))
1921               (unless (bobp)
1922                 (insert "\n"))
1923               (insert a "\n")))))
1924       (save-buffer))))
1925
1926 (defun spam-filelist-build-cache (type)
1927   (let ((cache (if (eq type 'spam-use-blacklist)
1928                    spam-blacklist-cache
1929                  spam-whitelist-cache))
1930         parsed-cache)
1931     (unless (gethash type spam-caches)
1932       (while cache
1933         (let ((address (pop cache)))
1934           (unless (zerop (length address)) ; 0 for a nil address too
1935             (setq address (regexp-quote address))
1936             ;; fix regexp-quote's treatment of user-intended regexes
1937             (while (string-match "\\\\\\*" address)
1938               (setq address (replace-match ".*" t t address))))
1939           (push address parsed-cache)))
1940       (puthash type parsed-cache spam-caches))))
1941
1942 (defun spam-filelist-check-cache (type from)
1943   (when (stringp from)
1944     (spam-filelist-build-cache type)
1945     (let (found)
1946       (dolist (address (gethash type spam-caches))
1947         (when (and address (string-match address from))
1948           (setq found t)
1949           (return)))
1950       found)))
1951
1952 ;;; returns t if the sender is in the whitelist, nil or
1953 ;;; spam-split-group otherwise
1954 (defun spam-check-whitelist ()
1955   ;; FIXME!  Should it detect when file timestamps change?
1956   (let ((spam-split-group (if spam-split-symbolic-return
1957                               'spam
1958                             spam-split-group)))
1959     (unless spam-whitelist-cache
1960       (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
1961     (if (spam-from-listed-p 'spam-use-whitelist)
1962         t
1963       (if spam-use-whitelist-exclusive
1964           spam-split-group
1965         nil))))
1966
1967 (defun spam-check-blacklist ()
1968   ;; FIXME!  Should it detect when file timestamps change?
1969   (let ((spam-split-group (if spam-split-symbolic-return
1970                               'spam
1971                             spam-split-group)))
1972     (unless spam-blacklist-cache
1973       (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1974     (and (spam-from-listed-p 'spam-use-blacklist) spam-split-group)))
1975
1976 (defun spam-parse-list (file)
1977   (when (file-readable-p file)
1978     (let (contents address)
1979       (with-temp-buffer
1980         (insert-file-contents file)
1981         (while (not (eobp))
1982           (setq address (buffer-substring (point) (point-at-eol)))
1983           (forward-line 1)
1984           ;; insert the e-mail address if detected, otherwise the raw data
1985           (unless (zerop (length address))
1986             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
1987               (push (or pure-address address) contents)))))
1988       (nreverse contents))))
1989
1990 (defun spam-from-listed-p (type)
1991   (let ((from (message-fetch-field "from"))
1992         found)
1993     (spam-filelist-check-cache type from)))
1994
1995 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
1996   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
1997         (declassification (if blacklist 'ham 'spam))
1998         (enter-function
1999          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2000         (remove-function
2001          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2002         from addresses unregister-list article-unregister-list)
2003     (dolist (article articles)
2004       (let ((from (spam-fetch-field-from-fast article))
2005             (id (spam-fetch-field-message-id-fast article))
2006             sender-ignored)
2007         (when (stringp from)
2008           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2009             (when (and (not sender-ignored)
2010                        (stringp ignore-regex)
2011                        (string-match ignore-regex from))
2012               (setq sender-ignored t)))
2013           ;; remember the messages we need to unregister, unless remove is set
2014           (when (and
2015                  (null unregister)
2016                  (spam-log-unregistration-needed-p
2017                   id 'process declassification de-symbol))
2018             (push article article-unregister-list)
2019             (push from unregister-list))
2020           (unless sender-ignored
2021             (push from addresses)))))
2022
2023     (if unregister
2024         (funcall enter-function addresses t) ; unregister all these addresses
2025       ;; else, register normally and unregister what we need to
2026       (funcall remove-function unregister-list t)
2027       (dolist (article article-unregister-list)
2028         (spam-log-undo-registration
2029          (spam-fetch-field-message-id-fast article)
2030          'process
2031          declassification
2032          de-symbol))
2033       (funcall enter-function addresses nil))))
2034
2035 (defun spam-blacklist-unregister-routine (articles)
2036   (spam-blacklist-register-routine articles t))
2037
2038 (defun spam-blacklist-register-routine (articles &optional unregister)
2039   (spam-filelist-register-routine articles t unregister))
2040
2041 (defun spam-whitelist-unregister-routine (articles)
2042   (spam-whitelist-register-routine articles t))
2043
2044 (defun spam-whitelist-register-routine (articles &optional unregister)
2045   (spam-filelist-register-routine articles nil unregister))
2046
2047 \f
2048 ;;;; Spam-report glue
2049 (defun spam-report-gmane-register-routine (articles)
2050   (when articles
2051     (apply 'spam-report-gmane articles)))
2052
2053 \f
2054 ;;;; Bogofilter
2055 (defun spam-check-bogofilter-headers (&optional score)
2056   (let ((header (message-fetch-field spam-bogofilter-header))
2057         (spam-split-group (if spam-split-symbolic-return
2058                               'spam
2059                             spam-split-group)))
2060     (when header                        ; return nil when no header
2061       (if score                         ; scoring mode
2062           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2063               (match-string 1 header)
2064             "0")
2065         ;; spam detection mode
2066         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2067                             header)
2068           spam-split-group)))))
2069
2070 ;; return something sensible if the score can't be determined
2071 (defun spam-bogofilter-score (&optional recheck)
2072   "Get the Bogofilter spamicity score"
2073   (interactive "P")
2074   (save-window-excursion
2075     (gnus-summary-show-article t)
2076     (set-buffer gnus-article-buffer)
2077     (let ((score (or (unless recheck
2078                        (spam-check-bogofilter-headers t))
2079                      (spam-check-bogofilter t))))
2080       (gnus-summary-show-article)
2081       (message "Spamicity score %s" score)
2082       (or score "0"))))
2083
2084 (defun spam-check-bogofilter (&optional score)
2085   "Check the Bogofilter backend for the classification of this message"
2086   (let ((article-buffer-name (buffer-name))
2087         (db spam-bogofilter-database-directory)
2088         return)
2089     (with-temp-buffer
2090       (let ((temp-buffer-name (buffer-name)))
2091         (save-excursion
2092           (set-buffer article-buffer-name)
2093           (apply 'call-process-region
2094                  (point-min) (point-max)
2095                  spam-bogofilter-path
2096                  nil temp-buffer-name nil
2097                  (if db `("-d" ,db "-v") `("-v"))))
2098         (setq return (spam-check-bogofilter-headers score))))
2099     return))
2100
2101 (defun spam-bogofilter-register-with-bogofilter (articles
2102                                                  spam
2103                                                  &optional unregister)
2104   "Register an article, given as a string, as spam or non-spam."
2105   (dolist (article articles)
2106     (let ((article-string (spam-get-article-as-string article))
2107           (db spam-bogofilter-database-directory)
2108           (switch (if unregister
2109                       (if spam
2110                           spam-bogofilter-spam-strong-switch
2111                         spam-bogofilter-ham-strong-switch)
2112                     (if spam
2113                         spam-bogofilter-spam-switch
2114                       spam-bogofilter-ham-switch))))
2115       (when (stringp article-string)
2116         (with-temp-buffer
2117           (insert article-string)
2118
2119           (apply 'call-process-region
2120                  (point-min) (point-max)
2121                  spam-bogofilter-path
2122                  nil nil nil switch
2123                  (if db `("-d" ,db "-v") `("-v"))))))))
2124
2125 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2126   (spam-bogofilter-register-with-bogofilter articles t unregister))
2127
2128 (defun spam-bogofilter-unregister-spam-routine (articles)
2129   (spam-bogofilter-register-spam-routine articles t))
2130
2131 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2132   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2133
2134 (defun spam-bogofilter-unregister-ham-routine (articles)
2135   (spam-bogofilter-register-ham-routine articles t))
2136
2137
2138 \f
2139 ;;;; spamoracle
2140 (defun spam-check-spamoracle ()
2141   "Run spamoracle on an article to determine whether it's spam."
2142   (let ((article-buffer-name (buffer-name))
2143         (spam-split-group (if spam-split-symbolic-return
2144                               'spam
2145                             spam-split-group)))
2146     (with-temp-buffer
2147       (let ((temp-buffer-name (buffer-name)))
2148         (save-excursion
2149           (set-buffer article-buffer-name)
2150           (let ((status
2151                  (apply 'call-process-region
2152                         (point-min) (point-max)
2153                         spam-spamoracle-binary
2154                         nil temp-buffer-name nil
2155                         (if spam-spamoracle-database
2156                             `("-f" ,spam-spamoracle-database "mark")
2157                           '("mark")))))
2158             (if (eq 0 status)
2159                 (progn
2160                   (set-buffer temp-buffer-name)
2161                   (goto-char (point-min))
2162                   (when (re-search-forward "^X-Spam: yes;" nil t)
2163                     spam-split-group))
2164               (error "Error running spamoracle: %s" status))))))))
2165
2166 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2167   "Run spamoracle in training mode."
2168   (with-temp-buffer
2169     (let ((temp-buffer-name (buffer-name)))
2170       (save-excursion
2171         (goto-char (point-min))
2172         (dolist (article articles)
2173           (insert (spam-get-article-as-string article)))
2174         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2175                         "-spam"
2176                       "-good"))
2177                (status
2178                 (apply 'call-process-region
2179                        (point-min) (point-max)
2180                        spam-spamoracle-binary
2181                        nil temp-buffer-name nil
2182                        (if spam-spamoracle-database
2183                            `("-f" ,spam-spamoracle-database
2184                              "add" ,arg)
2185                          `("add" ,arg)))))
2186           (unless (eq 0 status)
2187             (error "Error running spamoracle: %s" status)))))))
2188
2189 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2190   (spam-spamoracle-learn articles nil unregister))
2191
2192 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2193   (spam-spamoracle-learn-ham articles t))
2194
2195 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2196   (spam-spamoracle-learn articles t unregister))
2197
2198 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2199   (spam-spamoracle-learn-spam articles t))
2200
2201 \f
2202 ;;;; SpamAssassin
2203 ;;; based mostly on the bogofilter code
2204 (defun spam-check-spamassassin-headers (&optional score)
2205   "Check the SpamAssassin headers for the classification of this message."
2206   (if score                             ; scoring mode
2207       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2208         (when header
2209           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2210               (match-string 1 header)
2211             "0")))
2212     ;; spam detection mode
2213     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header))
2214           (spam-split-group (if spam-split-symbolic-return
2215                                  'spam
2216                                spam-split-group)))
2217           (when header                  ; return nil when no header
2218             (when (string-match spam-spamassassin-positive-spam-flag-header
2219                                 header)
2220               spam-split-group)))))
2221
2222 (defun spam-check-spamassassin (&optional score)
2223   "Check the SpamAssassin backend for the classification of this message."
2224   (let ((article-buffer-name (buffer-name)))
2225     (with-temp-buffer
2226       (let ((temp-buffer-name (buffer-name)))
2227         (save-excursion
2228           (set-buffer article-buffer-name)
2229           (apply 'call-process-region
2230                  (point-min) (point-max) spam-spamassassin-path
2231                  nil temp-buffer-name nil spam-spamassassin-arguments))
2232         ;; check the return now (we're back in the temp buffer)
2233         (goto-char (point-min))
2234         (spam-check-spamassassin-headers score)))))
2235
2236 ;; return something sensible if the score can't be determined
2237 (defun spam-spamassassin-score (&optional recheck)
2238   "Get the SpamAssassin score"
2239   (interactive "P")
2240   (save-window-excursion
2241     (gnus-summary-show-article t)
2242     (set-buffer gnus-article-buffer)
2243     (let ((score (or (unless recheck
2244                        (spam-check-spamassassin-headers t))
2245                      (spam-check-spamassassin t))))
2246       (gnus-summary-show-article)
2247       (message "SpamAssassin score %s" score)
2248       (or score "0"))))
2249
2250 (defun spam-spamassassin-register-with-sa-learn (articles spam
2251                                                  &optional unregister)
2252   "Register articles with spamassassin's sa-learn as spam or non-spam."
2253   (if articles
2254       (let ((action (if unregister spam-sa-learn-unregister-switch
2255                       (if spam spam-sa-learn-spam-switch
2256                         spam-sa-learn-ham-switch)))
2257             (summary-buffer-name (buffer-name)))
2258         (with-temp-buffer
2259           ;; group the articles into mbox format
2260           (dolist (article articles)
2261             (let (article-string)
2262               (save-excursion
2263                 (set-buffer summary-buffer-name)
2264                 (setq article-string (spam-get-article-as-string article)))
2265               (when (stringp article-string)
2266                 (insert "From \n") ; mbox separator (sa-learn only checks the
2267                                    ; first five chars, so we can get away with
2268                                    ; a bogus line))
2269                 (insert article-string)
2270                 (insert "\n"))))
2271           ;; call sa-learn on all messages at the same time
2272           (apply 'call-process-region
2273                  (point-min) (point-max)
2274                  spam-sa-learn-path
2275                  nil nil nil "--mbox"
2276                  (if spam-sa-learn-rebuild
2277                      (list action)
2278                    `("--no-rebuild" ,action)))))))
2279
2280 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2281   (spam-spamassassin-register-with-sa-learn articles t unregister))
2282
2283 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2284   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2285
2286 (defun spam-spamassassin-unregister-spam-routine (articles)
2287   (spam-spamassassin-register-with-sa-learn articles t t))
2288
2289 (defun spam-spamassassin-unregister-ham-routine (articles)
2290   (spam-spamassassin-register-with-sa-learn articles nil t))
2291
2292 \f
2293 ;;;; Bsfilter
2294 ;;; based mostly on the bogofilter code
2295 (defun spam-check-bsfilter-headers (&optional score)
2296   (if score
2297       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2298           "0")
2299     (let ((header (nnmail-fetch-field spam-bsfilter-header))
2300           (spam-split-group (if spam-split-symbolic-return
2301                                 'spam
2302                               spam-split-group)))
2303       (when header ; return nil when no header
2304         (when (string-match "YES" header)
2305           spam-split-group)))))
2306
2307 ;; return something sensible if the score can't be determined
2308 (defun spam-bsfilter-score (&optional recheck)
2309   "Get the Bsfilter spamicity score"
2310   (interactive "P")
2311   (save-window-excursion
2312     (gnus-summary-show-article t)
2313     (set-buffer gnus-article-buffer)
2314     (let ((score (or (unless recheck
2315                        (spam-check-bsfilter-headers t))
2316                      (spam-check-bsfilter t))))
2317       (gnus-summary-show-article)
2318       (message "Spamicity score %s" score)
2319       (or score "0"))))
2320
2321 (defun spam-check-bsfilter (&optional score)
2322   "Check the Bsfilter backend for the classification of this message"
2323   (let ((article-buffer-name (buffer-name))
2324         (dir spam-bsfilter-database-directory)
2325         return)
2326     (with-temp-buffer
2327       (let ((temp-buffer-name (buffer-name)))
2328         (save-excursion
2329           (set-buffer article-buffer-name)
2330           (apply 'call-process-region
2331                  (point-min) (point-max)
2332                  spam-bsfilter-path
2333                  nil temp-buffer-name nil
2334                  "--pipe"
2335                  "--insert-flag"
2336                  "--insert-probability"
2337                  (when dir
2338                    (list "--homedir" dir))))
2339         (setq return (spam-check-bsfilter-headers score))))
2340     return))
2341
2342 (defun spam-bsfilter-register-with-bsfilter (articles
2343                                              spam
2344                                              &optional unregister)
2345   "Register an article, given as a string, as spam or non-spam."
2346   (dolist (article articles)
2347     (let ((article-string (spam-get-article-as-string article))
2348           (switch (if unregister
2349                       (if spam
2350                           spam-bsfilter-spam-strong-switch
2351                         spam-bsfilter-ham-strong-switch)
2352                     (if spam
2353                         spam-bsfilter-spam-switch
2354                       spam-bsfilter-ham-switch))))
2355       (when (stringp article-string)
2356         (with-temp-buffer
2357           (insert article-string)
2358           (apply 'call-process-region
2359                  (point-min) (point-max)
2360                  spam-bsfilter-path
2361                  nil nil nil switch
2362                  "--update"
2363                  (when spam-bsfilter-database-directory
2364                    (list "--homedir"
2365                          spam-bsfilter-database-directory))))))))
2366
2367 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2368   (spam-bsfilter-register-with-bsfilter articles t unregister))
2369
2370 (defun spam-bsfilter-unregister-spam-routine (articles)
2371   (spam-bsfilter-register-spam-routine articles t))
2372
2373 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2374   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2375
2376 (defun spam-bsfilter-unregister-ham-routine (articles)
2377   (spam-bsfilter-register-ham-routine articles t))
2378
2379 \f
2380 ;;;; Hooks
2381
2382 ;;;###autoload
2383 (defun spam-initialize (&rest symbols)
2384   "Install the spam.el hooks and do other initialization.
2385 When SYMBOLS is given, set those variables to t.  This is so you
2386 can call spam-initialize before you set spam-use-* variables on
2387 explicitly, and matters only if you need the extra headers
2388 installed through spam-necessary-extra-headers."
2389   (interactive)
2390
2391   (dolist (var symbols)
2392     (set var t))
2393
2394   (dolist (header (spam-necessary-extra-headers))
2395     (add-to-list 'nnmail-extra-headers header)
2396     (add-to-list 'gnus-extra-headers header))
2397
2398   (setq spam-install-hooks t)
2399   ;; TODO: How do we redo this every time spam-face is customized?
2400   (push '((eq mark gnus-spam-mark) . spam-face)
2401         gnus-summary-highlight)
2402   ;; Add hooks for loading and saving the spam stats
2403   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2404   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2405   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2406   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2407   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2408   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2409   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2410
2411 (defun spam-unload-hook ()
2412   "Uninstall the spam.el hooks"
2413   (interactive)
2414   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2415   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2416   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2417   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2418   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2419   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2420   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2421
2422 (when spam-install-hooks
2423   (spam-initialize))
2424
2425 (provide 'spam)
2426
2427 ;;; spam.el ends here