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

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