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

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