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

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