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

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