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