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