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

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