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 CRM114, resend and gmane processors are not defined in gnus.el
 717   '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
 718     (gnus-group-spam-exit-processor-report-resend 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     (gnus-group-spam-exit-processor-crm114       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     (gnus-group-ham-exit-processor-crm114        ham spam-use-crm114))
 737   "The `spam-list-of-processors' list.
 738 This list contains pairs associating a ham/spam exit processor
 739 variable with a classification and a spam-use-* variable.")
 740
 741 (defun spam-group-processor-p (group processor)
 742   (if (and (stringp group)
 743            (symbolp processor))
 744       (or (member processor (nth 0 (gnus-parameter-spam-process group)))
 745           (spam-group-processor-multiple-p
 746            group
 747            (cdr-safe (assoc processor spam-list-of-processors))))
 748     nil))
 749
 750 (defun spam-group-processor-multiple-p (group processor-info)
 751   (let* ((classification (nth 0 processor-info))
 752          (check (nth 1 processor-info))
 753          (parameters (nth 0 (gnus-parameter-spam-process group)))
 754          found)
 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
 763 (defun spam-group-spam-processor-report-gmane-p (group)
 764   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
 765
 766 (defun spam-group-spam-processor-report-resend-p (group)
 767   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-resend))
 768
 769 (defun spam-group-spam-processor-bogofilter-p (group)
 770   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 771
 772 (defun spam-group-spam-processor-blacklist-p (group)
 773   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 774
 775 (defun spam-group-spam-processor-ifile-p (group)
 776   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 777
 778 (defun spam-group-ham-processor-ifile-p (group)
 779   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 780
 781 (defun spam-group-spam-processor-spamoracle-p (group)
 782   (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
 783
 784 (defun spam-group-spam-processor-crm114-p (group)
 785   (spam-group-processor-p group 'gnus-group-spam-exit-processor-crm114))
 786
 787 (defun spam-group-ham-processor-bogofilter-p (group)
 788   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 789
 790 (defun spam-group-spam-processor-stat-p (group)
 791   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 792
 793 (defun spam-group-ham-processor-stat-p (group)
 794   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 795
 796 (defun spam-group-ham-processor-whitelist-p (group)
 797   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 798
 799 (defun spam-group-ham-processor-BBDB-p (group)
 800   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 801
 802 (defun spam-group-ham-processor-copy-p (group)
 803   (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
 804
 805 (defun spam-group-ham-processor-spamoracle-p (group)
 806   (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
 807
 808 (defun spam-group-ham-processor-crm114-p (group)
 809   (spam-group-processor-p group 'gnus-group-ham-exit-processor-crm114))
 810
 811 (defun spam-report-articles-gmane (n)
 812   "Report the current message as spam via Gmane.
 813 Respects the process/prefix convention."
 814   (interactive "P")
 815   (dolist (article (gnus-summary-work-articles n))
 816     (gnus-summary-remove-process-mark article)
 817     (spam-report-gmane article)))
 818
 819 (defun spam-report-articles-resend (n)
 820   "Report the current message as spam by resending it.
 821 Respects the process/prefix convention.  Also see
 822 `spam-report-resend-to'."
 823   (interactive "P")
 824   (let ((articles (gnus-summary-work-articles n)))
 825     (spam-report-resend articles)
 826     (dolist (article articles)
 827       (gnus-summary-remove-process-mark article))))
 828
 829 (defun spam-necessary-extra-headers ()
 830   "Return the extra headers spam.el thinks are necessary."
 831   (let (list)
 832     (when (or spam-use-spamassassin
 833               spam-use-spamassassin-headers
 834               spam-use-regex-headers)
 835       (push 'X-Spam-Status list))
 836     list))
 837
 838 (defun spam-user-format-function-S (headers)
 839   (when headers
 840     (spam-summary-score headers)))
 841
 842 (defun spam-article-sort-by-spam-status (h1 h2)
 843   "Sort articles by score."
 844   (let (result)
 845     (dolist (header (spam-necessary-extra-headers))
 846       (let ((s1 (spam-summary-score h1 header))
 847             (s2 (spam-summary-score h2 header)))
 848       (unless (= s1 s2)
 849         (setq result (< s1 s2))
 850         (return))))
 851     result))
 852
 853 (defun spam-extra-header-to-number (header headers)
 854   "Transform an extra header to a number."
 855   (if (gnus-extra-header header headers)
 856       (cond
 857        ((eq header 'X-Spam-Status)
 858         (string-to-number (gnus-replace-in-string
 859                            (gnus-extra-header header headers)
 860                            ".*hits=" "")))
 861        ;; for CRM checking, it's probably faster to just do the string match
 862        ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header))
 863         (match-string 1 header))
 864        (t nil))
 865     nil))
 866
 867 (defun spam-summary-score (headers &optional specific-header)
 868   "Score an article for the summary buffer, as fast as possible.
 869 With SPECIFIC-HEADER, returns only that header's score.
 870 Will not return a nil score."
 871   (let (score)
 872     (dolist (header
 873              (if specific-header
 874                  (list specific-header)
 875                (spam-necessary-extra-headers)))
 876       (setq score
 877             (spam-extra-header-to-number header headers))
 878       (when score
 879         (return)))
 880     (or score 0)))
 881
 882 (defun spam-generic-score (&optional recheck)
 883   "Invoke whatever scoring method we can."
 884   (interactive "P")
 885   (cond
 886    ((or spam-use-spamassassin spam-use-spamassassin-headers)
 887     (spam-spamassassin-score recheck))
 888    ((or spam-use-bsfilter spam-use-bsfilter-headers)
 889     (spam-bsfilter-score recheck))
 890    (spam-use-crm114
 891     (spam-crm114-score))
 892    (t (spam-bogofilter-score recheck))))
 893
 894 ;;; Summary entry and exit processing.
 895
 896 (defun spam-summary-prepare ()
 897   (setq spam-old-ham-articles
 898         (spam-list-articles gnus-newsgroup-articles 'ham))
 899   (setq spam-old-spam-articles
 900         (spam-list-articles gnus-newsgroup-articles 'spam))
 901   (spam-mark-junk-as-spam-routine))
 902
 903 ;; The spam processors are invoked for any group, spam or ham or neither
 904 (defun spam-summary-prepare-exit ()
 905   (unless gnus-group-is-exiting-without-update-p
 906     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 907
 908     ;; first of all, unregister any articles that are no longer ham or spam
 909     ;; we have to iterate over the processors, or else we'll be too slow
 910     (dolist (classification '(spam ham))
 911       (let* ((old-articles (if (eq classification 'spam)
 912                                spam-old-spam-articles
 913                              spam-old-ham-articles))
 914              (new-articles (spam-list-articles
 915                             gnus-newsgroup-articles
 916                             classification))
 917              (changed-articles (spam-set-difference new-articles old-articles)))
 918         ;; now that we have the changed articles, we go through the processors
 919         (dolist (processor-param spam-list-of-processors)
 920           (let ((processor (nth 0 processor-param))
 921                 (processor-classification (nth 1 processor-param))
 922                 (check (nth 2 processor-param))
 923                 unregister-list)
 924             (dolist (article changed-articles)
 925               (let ((id (spam-fetch-field-message-id-fast article)))
 926                 (when (spam-log-unregistration-needed-p
 927                        id 'process classification check)
 928                   (push article unregister-list))))
 929             ;; call spam-register-routine with specific articles to unregister,
 930             ;; when there are articles to unregister and the check is enabled
 931             (when (and unregister-list (symbol-value check))
 932               (spam-register-routine
 933                classification check t unregister-list))))))
 934
 935     ;; find all the spam processors applicable to this group
 936     (dolist (processor-param spam-list-of-processors)
 937       (let ((processor (nth 0 processor-param))
 938             (classification (nth 1 processor-param))
 939             (check (nth 2 processor-param)))
 940         (when (and (eq 'spam classification)
 941                    (spam-group-processor-p gnus-newsgroup-name processor))
 942           (spam-register-routine classification check))))
 943
 944     (unless (and spam-move-spam-nonspam-groups-only
 945                  (spam-group-spam-contents-p gnus-newsgroup-name))
 946       (let* ((group (gnus-parameter-spam-process-destination
 947                      gnus-newsgroup-name))
 948              (num (spam-mark-spam-as-expired-and-move-routine group)))
 949         (when (> num 0)
 950           (gnus-message 6
 951                         "%d spam messages are marked as expired and moved it to %s"
 952                         num group))))
 953
 954     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 955     ;; expire spam, in case the above did not expire them
 956     (let ((num (spam-mark-spam-as-expired-and-move-routine nil)))
 957       (when (> num 0)
 958         (gnus-message 6
 959                       "%d spam messages are markd as expired without moving it"
 960                       num)))
 961
 962     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 963               (and (spam-group-spam-contents-p gnus-newsgroup-name)
 964                    spam-process-ham-in-spam-groups)
 965               spam-process-ham-in-nonham-groups)
 966       ;; find all the ham processors applicable to this group
 967       (dolist (processor-param spam-list-of-processors)
 968         (let ((processor (nth 0 processor-param))
 969               (classification (nth 1 processor-param))
 970               (check (nth 2 processor-param)))
 971           (when (and (eq 'ham classification)
 972                      (spam-group-processor-p gnus-newsgroup-name processor))
 973             (spam-register-routine classification check)))))
 974
 975     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
 976       (let ((num
 977              (spam-ham-copy-routine
 978               (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 979         (when (> num 0)
 980           (gnus-message 6 "%d ham messages are copied" num))))
 981
 982     ;; now move all ham articles out of spam groups
 983     (when (spam-group-spam-contents-p gnus-newsgroup-name)
 984       (let ((num
 985              (spam-ham-move-routine
 986               (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 987         (when (> num 0)
 988           (gnus-message 6 "%d ham messages are moved from spam group" num)))))
 989
 990   (setq spam-old-ham-articles nil)
 991   (setq spam-old-spam-articles nil))
 992
 993 (defun spam-set-difference (list1 list2)
 994   "Return a set difference of LIST1 and LIST2.
 995 When either list is nil, the other is returned."
 996   (if (and list1 list2)
 997       ;; we have two non-nil lists
 998       (progn
 999         (dolist (item (append list1 list2))
1000           (when (and (memq item list1) (memq item list2))
1001             (setq list1 (delq item list1))
1002             (setq list2 (delq item list2))))
1003         (append list1 list2))
1004     ;; if either of the lists was nil, return the other one
1005     (if list1 list1 list2)))
1006
1007 (defun spam-mark-junk-as-spam-routine ()
1008   ;; check the global list of group names spam-junk-mailgroups and the
1009   ;; group parameters
1010   (when (spam-group-spam-contents-p gnus-newsgroup-name)
1011     (gnus-message 6 "Marking %s articles as spam"
1012                   (if spam-mark-only-unseen-as-spam
1013                       "unseen"
1014                     "unread"))
1015     (let ((articles (if spam-mark-only-unseen-as-spam
1016                         gnus-newsgroup-unseen
1017                       gnus-newsgroup-unreads)))
1018       (dolist (article articles)
1019         (gnus-summary-mark-article article gnus-spam-mark)))))
1020
1021 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
1022   (if (and (car-safe groups) (listp (car-safe groups)))
1023       (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
1024     (gnus-summary-kill-process-mark)
1025     (let ((articles gnus-newsgroup-articles)
1026           (backend-supports-deletions
1027            (gnus-check-backend-function
1028             'request-move-article gnus-newsgroup-name))
1029           article tomove deletep)
1030       (dolist (article articles)
1031         (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
1032           (gnus-summary-mark-article article gnus-expirable-mark)
1033           (push article tomove)))
1034
1035       ;; now do the actual copies
1036       (dolist (group groups)
1037         (when (and tomove
1038                    (stringp group))
1039           (dolist (article tomove)
1040             (gnus-summary-set-process-mark article))
1041           (when tomove
1042             (if (or (not backend-supports-deletions)
1043                     (> (length groups) 1))
1044                 (progn
1045                   (gnus-summary-copy-article nil group)
1046                   (setq deletep t))
1047               (gnus-summary-move-article nil group)))))
1048
1049       ;; now delete the articles, if there was a copy done, and the
1050       ;; backend allows it
1051       (when (and deletep backend-supports-deletions)
1052         (dolist (article tomove)
1053           (gnus-summary-set-process-mark article))
1054         (when tomove
1055           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1056             (gnus-summary-delete-article nil))))
1057
1058       (gnus-summary-yank-process-mark)
1059       (length tomove))))
1060
1061 (defun spam-ham-copy-or-move-routine (copy groups)
1062   (gnus-summary-kill-process-mark)
1063   (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
1064         (backend-supports-deletions
1065          (gnus-check-backend-function
1066           'request-move-article gnus-newsgroup-name))
1067         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
1068         article mark todo deletep respool)
1069
1070     (when (member 'respool groups)
1071       (setq respool t)                  ; boolean for later
1072       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
1073
1074     ;; now do the actual move
1075     (dolist (group groups)
1076       (when (and todo (stringp group))
1077         (dolist (article todo)
1078           (when spam-mark-ham-unread-before-move-from-spam-group
1079             (gnus-summary-mark-article article gnus-unread-mark))
1080           (gnus-summary-set-process-mark article))
1081
1082         (if respool                        ; respooling is with a "fake" group
1083             (let ((spam-split-disabled
1084                    (or spam-split-disabled
1085                        spam-disable-spam-split-during-ham-respool)))
1086               (gnus-summary-respool-article nil respool-method))
1087           (if (or (not backend-supports-deletions) ; else, we are not respooling
1088                   (> (length groups) 1))
1089               (progn                ; if copying, copy and set deletep
1090                 (gnus-summary-copy-article nil group)
1091                 (setq deletep t))
1092             (gnus-summary-move-article nil group))))) ; else move articles
1093
1094     ;; now delete the articles, unless a) copy is t, and there was a copy done
1095     ;;                                 b) a move was done to a single group
1096     ;;                                 c) backend-supports-deletions is nil
1097     (unless copy
1098       (when (and deletep backend-supports-deletions)
1099         (dolist (article todo)
1100           (gnus-summary-set-process-mark article))
1101         (when todo
1102           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1103             (gnus-summary-delete-article nil)))))
1104
1105     (gnus-summary-yank-process-mark)
1106     (length todo)))
1107
1108 (defun spam-ham-copy-routine (&rest groups)
1109   (if (and (car-safe groups) (listp (car-safe groups)))
1110       (apply 'spam-ham-copy-routine (car groups))
1111     (spam-ham-copy-or-move-routine t groups)))
1112
1113 (defun spam-ham-move-routine (&rest groups)
1114   (if (and (car-safe groups) (listp (car-safe groups)))
1115       (apply 'spam-ham-move-routine (car groups))
1116     (spam-ham-copy-or-move-routine nil groups)))
1117
1118 (defun spam-get-article-as-string (article)
1119   (when (numberp article)
1120     (with-temp-buffer
1121       (gnus-request-article-this-buffer
1122        article
1123        gnus-newsgroup-name)
1124       (buffer-string))))
1125
1126 ;; disabled for now
1127 ;; (defun spam-get-article-as-filename (article)
1128 ;;   (let ((article-filename))
1129 ;;     (when (numberp article)
1130 ;;       (nnml-possibly-change-directory
1131 ;;        (gnus-group-real-name gnus-newsgroup-name))
1132 ;;       (setq article-filename (expand-file-name
1133 ;;                              (int-to-string article) nnml-current-directory)))
1134 ;;     (if (file-exists-p article-filename)
1135 ;;      article-filename
1136 ;;       nil)))
1137
1138 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
1139   "Fetch a field quickly, using the internal gnus-data-list function"
1140   (when (numberp article)
1141     (let* ((data-header (or prepared-data-header
1142                             (spam-fetch-article-header article))))
1143       (if (arrayp data-header)
1144         (cond
1145          ((equal field 'from)
1146           (mail-header-from data-header))
1147          ((equal field 'message-id)
1148           (mail-header-message-id data-header))
1149          ((equal field 'subject)
1150           (mail-header-subject data-header))
1151          ((equal field 'references)
1152           (mail-header-references data-header))
1153          ((equal field 'date)
1154           (mail-header-date data-header))
1155          ((equal field 'xref)
1156           (mail-header-xref data-header))
1157          ((equal field 'extra)
1158           (mail-header-extra data-header))
1159          (t
1160           nil))
1161         (gnus-message 6 "Article %d has a nil data header" article)))))
1162
1163 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1164   (spam-fetch-field-fast article 'from prepared-data-header))
1165
1166 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1167   (spam-fetch-field-fast article 'subject prepared-data-header))
1168
1169 (defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1170   (spam-fetch-field-fast article 'message-id prepared-data-header))
1171
1172 (defun spam-generate-fake-headers (article)
1173   (let ((dh (spam-fetch-article-header article)))
1174     (if dh
1175         (concat
1176          (format
1177           (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1178                   "Date: %s\nReferences: %s\nXref: %s\n")
1179           (spam-fetch-field-fast article 'from dh)
1180           (spam-fetch-field-fast article 'subject dh)
1181           (spam-fetch-field-fast article 'message-id dh)
1182           (spam-fetch-field-fast article 'date dh)
1183           (spam-fetch-field-fast article 'references dh)
1184           (spam-fetch-field-fast article 'xref dh))
1185          (when (spam-fetch-field-fast article 'extra dh)
1186            (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1187       (gnus-message
1188        5
1189        "spam-generate-fake-headers: article %d didn't have a valid header"
1190        article))))
1191
1192 (defun spam-fetch-article-header (article)
1193   (save-excursion
1194     (set-buffer gnus-summary-buffer)
1195     (gnus-read-header article)
1196     (nth 3 (assq article gnus-newsgroup-data))))
1197
1198 \f
1199 ;;;; Spam determination.
1200
1201 (defvar spam-list-of-checks
1202   '((spam-use-blacklist                 .       spam-check-blacklist)
1203     (spam-use-regex-headers             .       spam-check-regex-headers)
1204     (spam-use-gmane-xref                .       spam-check-gmane-xref)
1205     (spam-use-regex-body                .       spam-check-regex-body)
1206     (spam-use-whitelist                 .       spam-check-whitelist)
1207     (spam-use-BBDB                      .       spam-check-BBDB)
1208     (spam-use-BBDB-exclusive            .       spam-check-BBDB)
1209     (spam-use-ifile                     .       spam-check-ifile)
1210     (spam-use-spamoracle                .       spam-check-spamoracle)
1211     (spam-use-stat                      .       spam-check-stat)
1212     (spam-use-blackholes                .       spam-check-blackholes)
1213     (spam-use-hashcash                  .       spam-check-hashcash)
1214     (spam-use-spamassassin-headers      .       spam-check-spamassassin-headers)
1215     (spam-use-spamassassin              .       spam-check-spamassassin)
1216     (spam-use-bogofilter-headers        .       spam-check-bogofilter-headers)
1217     (spam-use-bogofilter                .       spam-check-bogofilter)
1218     (spam-use-bsfilter-headers          .       spam-check-bsfilter-headers)
1219     (spam-use-bsfilter                  .       spam-check-bsfilter)
1220     (spam-use-crm114                    .       spam-check-crm114))
1221   "The spam-list-of-checks list contains pairs associating a
1222 parameter variable with a spam checking function.  If the
1223 parameter variable is true, then the checking function is called,
1224 and its value decides what happens.  Each individual check may
1225 return nil, t, or a mailgroup name.  The value nil means that the
1226 check does not yield a decision, and so, that further checks are
1227 needed.  The value t means that the message is definitely not
1228 spam, and that further spam checks should be inhibited.
1229 Otherwise, a mailgroup name or the symbol 'spam (depending on
1230 spam-split-symbolic-return) is returned where the mail should go,
1231 and further checks are also inhibited.  The usual mailgroup name
1232 is the value of `spam-split-group', meaning that the message is
1233 definitely a spam.")
1234
1235 (defvar spam-list-of-statistical-checks
1236   '(spam-use-ifile
1237     spam-use-regex-body
1238     spam-use-stat
1239     spam-use-bogofilter
1240     spam-use-bsfilter
1241     spam-use-blackholes
1242     spam-use-spamassassin
1243     spam-use-spamoracle
1244     spam-use-crm114)
1245   "The spam-list-of-statistical-checks list contains all the mail
1246 splitters that need to have the full message body available.
1247 Note that you should fetch extra headers if you don't like this,
1248 e.g. fetch the 'Received' header for spam-use-blackholes.")
1249
1250 (defun spam-split (&rest specific-checks)
1251   "Split this message into the `spam' group if it is spam.
1252 This function can be used as an entry in the variable `nnmail-split-fancy',
1253 for example like this: (: spam-split).  It can take checks as
1254 parameters.  A string as a parameter will set the
1255 spam-split-group to that string.
1256
1257 See the Info node `(gnus)Fancy Mail Splitting' for more details."
1258   (interactive)
1259   (setq spam-split-last-successful-check nil)
1260   (unless spam-split-disabled
1261     (let ((spam-split-group-choice spam-split-group))
1262       (dolist (check specific-checks)
1263         (when (stringp check)
1264           (setq spam-split-group-choice check)
1265           (setq specific-checks (delq check specific-checks))))
1266
1267       (let ((spam-split-group spam-split-group-choice))
1268         (save-excursion
1269           (save-restriction
1270             (dolist (check spam-list-of-statistical-checks)
1271               (when (and (symbolp check)
1272                          (or (symbol-value check)
1273                              (memq check specific-checks)))
1274                 (widen)
1275                 (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
1276                               (symbol-name check))
1277                 (return)))
1278             ;;   (progn (widen) (debug (buffer-string)))
1279             (let ((list-of-checks spam-list-of-checks)
1280                   decision)
1281               (while (and list-of-checks (not decision))
1282                 (let ((pair (pop list-of-checks)))
1283                   (when (or
1284                          ;; either, given specific checks, this is one of them
1285                          (and specific-checks (memq (car pair) specific-checks))
1286                          ;; or, given no specific checks, spam-use-CHECK is set
1287                          (and (null specific-checks) (symbol-value (car pair))))
1288                     (gnus-message 6 "spam-split: calling the %s function"
1289                                   (symbol-name (cdr pair)))
1290                     (setq decision (funcall (cdr pair)))
1291                     ;; if we got a decision at all, save the current check
1292                     (when decision
1293                       (setq spam-split-last-successful-check (car pair)))
1294
1295                     (when (eq decision 'spam)
1296                       (unless spam-split-symbolic-return
1297                         (gnus-error
1298                          5
1299                          (format "spam-split got %s but %s is nil"
1300                                  (symbol-name decision)
1301                                  (symbol-name spam-split-symbolic-return))))))))
1302               (if (eq decision t)
1303                   (if spam-split-symbolic-return-positive 'ham nil)
1304                 decision))))))))
1305
1306 (defun spam-find-spam ()
1307   "This function will detect spam in the current newsgroup using spam-split."
1308   (interactive)
1309
1310   (let* ((group gnus-newsgroup-name)
1311          (autodetect (gnus-parameter-spam-autodetect group))
1312          (methods (gnus-parameter-spam-autodetect-methods group))
1313          (first-method (nth 0 methods))
1314          (articles (if spam-autodetect-recheck-messages
1315                        gnus-newsgroup-articles
1316                      gnus-newsgroup-unseen))
1317          article-cannot-be-faked)
1318
1319     (dolist (check spam-list-of-statistical-checks)
1320       (when (and (symbolp check)
1321                  (memq check methods))
1322         (setq article-cannot-be-faked t)
1323         (return)))
1324
1325     (when (memq 'default methods)
1326       (setq article-cannot-be-faked t))
1327
1328     (when (and autodetect
1329                (not (equal first-method 'none)))
1330     (mapcar
1331      (lambda (article)
1332        (let ((id (spam-fetch-field-message-id-fast article))
1333              (subject (spam-fetch-field-subject-fast article))
1334              (sender (spam-fetch-field-from-fast article))
1335              registry-lookup)
1336
1337          (unless id
1338            (gnus-message 6 "Article %d has no message ID!" article))
1339
1340          (when (and id spam-log-to-registry)
1341            (setq registry-lookup (spam-log-registration-type id 'incoming))
1342            (when registry-lookup
1343              (gnus-message
1344               9
1345               "spam-find-spam: message %s was already registered incoming"
1346               id)))
1347
1348          (let* ((spam-split-symbolic-return t)
1349                 (spam-split-symbolic-return-positive t)
1350                 (fake-headers (spam-generate-fake-headers article))
1351                 (split-return
1352                  (or registry-lookup
1353                      (with-temp-buffer
1354                        (if article-cannot-be-faked
1355                            (gnus-request-article-this-buffer
1356                             article
1357                             group)
1358                          ;; else, we fake the article
1359                          (when fake-headers (insert fake-headers)))
1360                        (if (or (null first-method)
1361                                (equal first-method 'default))
1362                            (spam-split)
1363                          (apply 'spam-split methods))))))
1364            (if (equal split-return 'spam)
1365                (gnus-summary-mark-article article gnus-spam-mark))
1366
1367            (when (and id split-return spam-log-to-registry)
1368              (when (zerop (gnus-registry-group-count id))
1369                (gnus-registry-add-group
1370                 id group subject sender))
1371
1372              (unless registry-lookup
1373                (spam-log-processing-to-registry
1374                 id
1375                 'incoming
1376                 split-return
1377                 spam-split-last-successful-check
1378                 group))))))
1379     articles))))
1380
1381 (defvar spam-registration-functions
1382   ;; first the ham register, second the spam register function
1383   ;; third the ham unregister, fourth the spam unregister function
1384   '((spam-use-blacklist  nil
1385                          spam-blacklist-register-routine
1386                          nil
1387                          spam-blacklist-unregister-routine)
1388     (spam-use-whitelist  spam-whitelist-register-routine
1389                          nil
1390                          spam-whitelist-unregister-routine
1391                          nil)
1392     (spam-use-ham-copy   nil
1393                          nil
1394                          nil
1395                          nil)
1396     (spam-use-BBDB       spam-BBDB-register-routine
1397                          nil
1398                          spam-BBDB-unregister-routine
1399                          nil)
1400     (spam-use-ifile      spam-ifile-register-ham-routine
1401                          spam-ifile-register-spam-routine
1402                          spam-ifile-unregister-ham-routine
1403                          spam-ifile-unregister-spam-routine)
1404     (spam-use-spamoracle spam-spamoracle-learn-ham
1405                          spam-spamoracle-learn-spam
1406                          spam-spamoracle-unlearn-ham
1407                          spam-spamoracle-unlearn-spam)
1408     (spam-use-stat       spam-stat-register-ham-routine
1409                          spam-stat-register-spam-routine
1410                          spam-stat-unregister-ham-routine
1411                          spam-stat-unregister-spam-routine)
1412     ;; note that spam-use-gmane and spam-use-resend are not legitimate checks
1413     (spam-use-gmane      nil
1414                          spam-report-gmane-register-routine
1415                          ;; does Gmane support unregistration?
1416                          nil
1417                          nil)
1418     (spam-use-resend     nil
1419                          spam-report-resend-register-routine
1420                          nil
1421                          nil)
1422     (spam-use-spamassassin spam-spamassassin-register-ham-routine
1423                            spam-spamassassin-register-spam-routine
1424                            spam-spamassassin-unregister-ham-routine
1425                            spam-spamassassin-unregister-spam-routine)
1426     (spam-use-bogofilter spam-bogofilter-register-ham-routine
1427                          spam-bogofilter-register-spam-routine
1428                          spam-bogofilter-unregister-ham-routine
1429                          spam-bogofilter-unregister-spam-routine)
1430     (spam-use-bsfilter   spam-bsfilter-register-ham-routine
1431                          spam-bsfilter-register-spam-routine
1432                          spam-bsfilter-unregister-ham-routine
1433                          spam-bsfilter-unregister-spam-routine)
1434     (spam-use-crm114 spam-crm114-register-ham-routine
1435                      spam-crm114-register-spam-routine
1436                      ;; does CRM114 Mailfilter support unregistration?
1437                      nil
1438                      nil))
1439   "The spam-registration-functions list contains pairs
1440 associating a parameter variable with the ham and spam
1441 registration functions, and the ham and spam unregistration
1442 functions")
1443
1444 (defun spam-classification-valid-p (classification)
1445   (or  (eq classification 'spam)
1446        (eq classification 'ham)))
1447
1448 (defun spam-process-type-valid-p (process-type)
1449   (or  (eq process-type 'incoming)
1450        (eq process-type 'process)))
1451
1452 (defun spam-registration-check-valid-p (check)
1453   (assoc check spam-registration-functions))
1454
1455 (defun spam-unregistration-check-valid-p (check)
1456   (assoc check spam-registration-functions))
1457
1458 (defun spam-registration-function (classification check)
1459   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1460     (if (eq classification 'spam)
1461         (nth 1 flist)
1462       (nth 0 flist))))
1463
1464 (defun spam-unregistration-function (classification check)
1465   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1466     (if (eq classification 'spam)
1467         (nth 3 flist)
1468       (nth 2 flist))))
1469
1470 (defun spam-list-articles (articles classification)
1471   (let ((mark-check (if (eq classification 'spam)
1472                         'spam-group-spam-mark-p
1473                       'spam-group-ham-mark-p))
1474         alist mark-cache-yes mark-cache-no)
1475     (dolist (article articles)
1476       (let ((mark (gnus-summary-article-mark article)))
1477         (unless (or (memq mark mark-cache-yes)
1478                     (memq mark mark-cache-no))
1479           (if (funcall mark-check
1480                        gnus-newsgroup-name
1481                        mark)
1482               (push mark mark-cache-yes)
1483             (push mark mark-cache-no)))
1484         (when (memq mark mark-cache-yes)
1485           (push article alist))))
1486     alist))
1487
1488 (defun spam-register-routine (classification
1489                               check
1490                               &optional unregister
1491                               specific-articles)
1492   (when (and (spam-classification-valid-p classification)
1493              (spam-registration-check-valid-p check))
1494     (let* ((register-function
1495             (spam-registration-function classification check))
1496            (unregister-function
1497             (spam-unregistration-function classification check))
1498            (run-function (if unregister
1499                              unregister-function
1500                            register-function))
1501            (log-function (if unregister
1502                              'spam-log-undo-registration
1503                            'spam-log-processing-to-registry))
1504            article articles)
1505
1506       (when run-function
1507         ;; make list of articles, using specific-articles if given
1508         (setq articles (or specific-articles
1509                            (spam-list-articles
1510                             gnus-newsgroup-articles
1511                             classification)))
1512         ;; process them
1513         (gnus-message 5 "%s %d %s articles as %s using backend %s"
1514                       (if unregister "Unregistering" "Registering")
1515                       (length articles)
1516                       (if specific-articles "specific" "")
1517                       (symbol-name classification)
1518                       (symbol-name check))
1519         (funcall run-function articles)
1520         ;; now log all the registrations (or undo them, depending on unregister)
1521         (dolist (article articles)
1522           (funcall log-function
1523                    (spam-fetch-field-message-id-fast article)
1524                    'process
1525                    classification
1526                    check
1527                    gnus-newsgroup-name))))))
1528
1529 ;;; log a ham- or spam-processor invocation to the registry
1530 (defun spam-log-processing-to-registry (id type classification check group)
1531   (when spam-log-to-registry
1532     (if (and (stringp id)
1533              (stringp group)
1534              (spam-process-type-valid-p type)
1535              (spam-classification-valid-p classification)
1536              (spam-registration-check-valid-p check))
1537         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1538               (cell (list classification check group)))
1539           (push cell cell-list)
1540           (gnus-registry-store-extra-entry
1541            id
1542            type
1543            cell-list))
1544
1545       (gnus-message
1546        5
1547        (format "%s call with bad ID, type, classification, spam-check, or group"
1548                "spam-log-processing-to-registry")))))
1549
1550 ;;; check if a ham- or spam-processor registration has been done
1551 (defun spam-log-registered-p (id type)
1552   (when spam-log-to-registry
1553     (if (and (stringp id)
1554              (spam-process-type-valid-p type))
1555         (cdr-safe (gnus-registry-fetch-extra id type))
1556       (progn
1557         (gnus-message
1558          5
1559          (format "%s called with bad ID, type, classification, or spam-check"
1560                  "spam-log-registered-p"))
1561         nil))))
1562
1563 ;;; check what a ham- or spam-processor registration says
1564 ;;; returns nil if conflicting registrations are found
1565 (defun spam-log-registration-type (id type)
1566   (let ((count 0)
1567         decision)
1568     (dolist (reg (spam-log-registered-p id type))
1569       (let ((classification (nth 0 reg)))
1570         (when (spam-classification-valid-p classification)
1571           (when (and decision
1572                      (not (eq classification decision)))
1573             (setq count (+ 1 count)))
1574           (setq decision classification))))
1575     (if (< 0 count)
1576         nil
1577       decision)))
1578
1579
1580 ;;; check if a ham- or spam-processor registration needs to be undone
1581 (defun spam-log-unregistration-needed-p (id type classification check)
1582   (when spam-log-to-registry
1583     (if (and (stringp id)
1584              (spam-process-type-valid-p type)
1585              (spam-classification-valid-p classification)
1586              (spam-registration-check-valid-p check))
1587         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1588               found)
1589           (dolist (cell cell-list)
1590             (unless found
1591               (when (and (eq classification (nth 0 cell))
1592                          (eq check (nth 1 cell)))
1593                 (setq found t))))
1594           found)
1595       (progn
1596         (gnus-message
1597          5
1598          (format "%s called with bad ID, type, classification, or spam-check"
1599                  "spam-log-unregistration-needed-p"))
1600         nil))))
1601
1602
1603 ;;; undo a ham- or spam-processor registration (the group is not used)
1604 (defun spam-log-undo-registration (id type classification check &optional group)
1605   (when (and spam-log-to-registry
1606              (spam-log-unregistration-needed-p id type classification check))
1607     (if (and (stringp id)
1608              (spam-process-type-valid-p type)
1609              (spam-classification-valid-p classification)
1610              (spam-registration-check-valid-p check))
1611         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1612               new-cell-list found)
1613           (dolist (cell cell-list)
1614             (unless (and (eq classification (nth 0 cell))
1615                          (eq check (nth 1 cell)))
1616               (push cell new-cell-list)))
1617           (gnus-registry-store-extra-entry
1618            id
1619            type
1620            new-cell-list))
1621       (progn
1622         (gnus-message 6 (format "%s call with bad ID, type, spam-check, or group"
1623                                 "spam-log-undo-registration"))
1624         nil))))
1625
1626 ;;; set up IMAP widening if it's necessary
1627 (defun spam-setup-widening ()
1628   (dolist (check spam-list-of-statistical-checks)
1629     (when (symbol-value check)
1630       (setq nnimap-split-download-body-default t))))
1631
1632 \f
1633 ;;;; Gmane xrefs
1634 (defun spam-check-gmane-xref ()
1635   (let ((header (or
1636                  (message-fetch-field "Xref")
1637                  (message-fetch-field "Newsgroups")))
1638         (spam-split-group (if spam-split-symbolic-return
1639                               'spam
1640                             spam-split-group)))
1641     (when header                        ; return nil when no header
1642       (when (string-match spam-gmane-xref-spam-group
1643                           header)
1644           spam-split-group))))
1645
1646 \f
1647 ;;;; Regex body
1648
1649 (defun spam-check-regex-body ()
1650   (let ((spam-regex-headers-ham spam-regex-body-ham)
1651         (spam-regex-headers-spam spam-regex-body-spam))
1652     (spam-check-regex-headers t)))
1653
1654 \f
1655 ;;;; Regex headers
1656
1657 (defun spam-check-regex-headers (&optional body)
1658   (let ((type (if body "body" "header"))
1659         (spam-split-group (if spam-split-symbolic-return
1660                               'spam
1661                             spam-split-group))
1662         ret found)
1663     (dolist (h-regex spam-regex-headers-ham)
1664       (unless found
1665         (goto-char (point-min))
1666         (when (re-search-forward h-regex nil t)
1667           (message "Ham regex %s search positive." type)
1668           (setq found t))))
1669     (dolist (s-regex spam-regex-headers-spam)
1670       (unless found
1671         (goto-char (point-min))
1672         (when (re-search-forward s-regex nil t)
1673           (message "Spam regex %s search positive." type)
1674           (setq found t)
1675           (setq ret spam-split-group))))
1676     ret))
1677
1678 \f
1679 ;;;; Blackholes.
1680
1681 (defun spam-reverse-ip-string (ip)
1682   (when (stringp ip)
1683     (mapconcat 'identity
1684                (nreverse (split-string ip "\\."))
1685                ".")))
1686
1687 (defun spam-check-blackholes ()
1688   "Check the Received headers for blackholed relays."
1689   (let ((headers (message-fetch-field "received"))
1690         (spam-split-group (if spam-split-symbolic-return
1691                               'spam
1692                             spam-split-group))
1693         ips matches)
1694     (when headers
1695       (with-temp-buffer
1696         (insert headers)
1697         (goto-char (point-min))
1698         (gnus-message 6 "Checking headers for relay addresses")
1699         (while (re-search-forward
1700                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1701           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1702           (push (spam-reverse-ip-string (match-string 1))
1703                 ips)))
1704       (dolist (server spam-blackhole-servers)
1705         (dolist (ip ips)
1706           (unless (and spam-blackhole-good-server-regex
1707                        ;; match the good-server-regex against the reversed (again) IP string
1708                        (string-match
1709                         spam-blackhole-good-server-regex
1710                         (spam-reverse-ip-string ip)))
1711             (unless matches
1712               (let ((query-string (concat ip "." server)))
1713                 (if spam-use-dig
1714                     (let ((query-result (query-dig query-string)))
1715                       (when query-result
1716                         (gnus-message 6 "(DIG): positive blackhole check '%s'"
1717                                       query-result)
1718                         (push (list ip server query-result)
1719                               matches)))
1720                   ;; else, if not using dig.el
1721                   (when (query-dns query-string)
1722                     (gnus-message 6 "positive blackhole check")
1723                     (push (list ip server (query-dns query-string 'TXT))
1724                           matches)))))))))
1725     (when matches
1726       spam-split-group)))
1727 \f
1728 ;;;; Hashcash.
1729
1730 (condition-case nil
1731     (progn
1732       (require 'hashcash)
1733
1734       (defun spam-check-hashcash ()
1735         "Check the headers for hashcash payments."
1736         (mail-check-payment)))   ;mail-check-payment returns a boolean
1737
1738   (file-error (progn
1739                 (defalias 'mail-check-payment 'ignore)
1740                 (defalias 'spam-check-hashcash 'ignore))))
1741 \f
1742 ;;;; BBDB
1743
1744 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
1745 ;;; <sacha@giotto.sj.ru>
1746
1747 ;; all this is done inside a condition-case to trap errors
1748
1749 (condition-case nil
1750     (progn
1751       (require 'bbdb)
1752       (require 'bbdb-com)
1753
1754       ;; when the BBDB changes, we want to clear out our cache
1755       (defun spam-clear-cache-BBDB (&rest immaterial)
1756         (spam-clear-cache 'spam-use-BBDB))
1757
1758       (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
1759
1760       (defun spam-enter-ham-BBDB (addresses &optional remove)
1761         "Enter an address into the BBDB; implies ham (non-spam) sender"
1762         (dolist (from addresses)
1763           (when (stringp from)
1764             (let* ((parsed-address (gnus-extract-address-components from))
1765                    (name (or (nth 0 parsed-address) "Ham Sender"))
1766                    (remove-function (if remove
1767                                         'bbdb-delete-record-internal
1768                                       'ignore))
1769                    (net-address (nth 1 parsed-address))
1770                    (record (and net-address
1771                                 (bbdb-search-simple nil net-address))))
1772               (when net-address
1773                 (gnus-message 6 "%s address %s %s BBDB"
1774                               (if remove "Deleting" "Adding")
1775                               from
1776                               (if remove "from" "to"))
1777                 (if record
1778                     (funcall remove-function record)
1779                   (bbdb-create-internal name nil net-address nil nil
1780                                         "ham sender added by spam.el")))))))
1781
1782       (defun spam-BBDB-register-routine (articles &optional unregister)
1783         (let (addresses)
1784           (dolist (article articles)
1785             (when (stringp (spam-fetch-field-from-fast article))
1786               (push (spam-fetch-field-from-fast article) addresses)))
1787           ;; now do the register/unregister action
1788           (spam-enter-ham-BBDB addresses unregister)))
1789
1790       (defun spam-BBDB-unregister-routine (articles)
1791         (spam-BBDB-register-routine articles t))
1792
1793       (defun spam-check-BBDB ()
1794         "Mail from people in the BBDB is classified as ham or non-spam"
1795         (let ((who (message-fetch-field "from"))
1796               (spam-split-group (if spam-split-symbolic-return
1797                                     'spam
1798                                   spam-split-group))
1799               bbdb-cache bbdb-hashtable)
1800           (when spam-cache-lookups
1801             (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
1802             (unless bbdb-cache
1803               (setq bbdb-cache
1804                     ;; this is the expanded (bbdb-hashtable) macro
1805                     ;; without the debugging support
1806                     (with-current-buffer (bbdb-buffer)
1807                       (save-excursion
1808                         (save-window-excursion
1809                           (bbdb-records nil t)
1810                           bbdb-hashtable))))
1811               (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
1812           (when who
1813             (setq who (nth 1 (gnus-extract-address-components who)))
1814             (if
1815                 (if spam-cache-lookups
1816                     (symbol-value
1817                      (intern-soft who bbdb-cache))
1818                   (bbdb-search-simple nil who))
1819                 t
1820               (if spam-use-BBDB-exclusive
1821                   spam-split-group
1822                 nil))))))
1823
1824   (file-error (progn
1825                 (defalias 'bbdb-search-simple 'ignore)
1826                 (defalias 'bbdb-records 'ignore)
1827                 (defalias 'bbdb-buffer 'ignore)
1828                 (defalias 'spam-check-BBDB 'ignore)
1829                 (defalias 'spam-BBDB-register-routine 'ignore)
1830                 (defalias 'spam-enter-ham-BBDB 'ignore)
1831                 (defalias 'bbdb-create-internal 'ignore)
1832                 (defalias 'bbdb-delete-record-internal 'ignore)
1833                 (defalias 'bbdb-records 'ignore))))
1834
1835 \f
1836 ;;;; ifile
1837
1838 ;;; check the ifile backend; return nil if the mail was NOT classified
1839 ;;; as spam
1840
1841 (defun spam-get-ifile-database-parameter ()
1842   "Get the command-line parameter for ifile's database from
1843   spam-ifile-database-path."
1844   (if spam-ifile-database-path
1845       (format "--db-file=%s" spam-ifile-database-path)
1846     nil))
1847
1848 (defun spam-check-ifile ()
1849   "Check the ifile backend for the classification of this message."
1850   (let ((article-buffer-name (buffer-name))
1851         (spam-split-group (if spam-split-symbolic-return
1852                               'spam
1853                             spam-split-group))
1854         category return)
1855     (with-temp-buffer
1856       (let ((temp-buffer-name (buffer-name))
1857             (db-param (spam-get-ifile-database-parameter)))
1858         (save-excursion
1859           (set-buffer article-buffer-name)
1860           (apply 'call-process-region
1861                  (point-min) (point-max) spam-ifile-path
1862                  nil temp-buffer-name nil "-c"
1863                  (if db-param `(,db-param "-q") `("-q"))))
1864         ;; check the return now (we're back in the temp buffer)
1865         (goto-char (point-min))
1866         (if (not (eobp))
1867             (setq category (buffer-substring (point) (point-at-eol))))
1868         (when (not (zerop (length category))) ; we need a category here
1869           (if spam-ifile-all-categories
1870               (setq return category)
1871             ;; else, if spam-ifile-all-categories is not set...
1872             (when (string-equal spam-ifile-spam-category category)
1873               (setq return spam-split-group)))))) ; note return is nil otherwise
1874     return))
1875
1876 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
1877   "Register an article, given as a string, with a category.
1878 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1879   (let ((category (or category gnus-newsgroup-name))
1880         (add-or-delete-option (if unregister "-d" "-i"))
1881         (db (spam-get-ifile-database-parameter))
1882         parameters)
1883     (with-temp-buffer
1884       (dolist (article articles)
1885         (let ((article-string (spam-get-article-as-string article)))
1886           (when (stringp article-string)
1887             (insert article-string))))
1888       (apply 'call-process-region
1889              (point-min) (point-max) spam-ifile-path
1890              nil nil nil
1891              add-or-delete-option category
1892              (if db `(,db "-h") `("-h"))))))
1893
1894 (defun spam-ifile-register-spam-routine (articles &optional unregister)
1895   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
1896
1897 (defun spam-ifile-unregister-spam-routine (articles)
1898   (spam-ifile-register-spam-routine articles t))
1899
1900 (defun spam-ifile-register-ham-routine (articles &optional unregister)
1901   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
1902
1903 (defun spam-ifile-unregister-ham-routine (articles)
1904   (spam-ifile-register-ham-routine articles t))
1905
1906 \f
1907 ;;;; spam-stat
1908
1909 (condition-case nil
1910     (progn
1911       (let ((spam-stat-install-hooks nil))
1912         (require 'spam-stat))
1913
1914       (defun spam-check-stat ()
1915         "Check the spam-stat backend for the classification of this message"
1916         (let ((spam-split-group (if spam-split-symbolic-return
1917                                     'spam
1918                                   spam-split-group))
1919               (spam-stat-split-fancy-spam-group spam-split-group) ; override
1920               (spam-stat-buffer (buffer-name)) ; stat the current buffer
1921               category return)
1922           (spam-stat-split-fancy)))
1923
1924       (defun spam-stat-register-spam-routine (articles &optional unregister)
1925         (dolist (article articles)
1926           (let ((article-string (spam-get-article-as-string article)))
1927             (with-temp-buffer
1928               (insert article-string)
1929               (if unregister
1930                   (spam-stat-buffer-change-to-non-spam)
1931               (spam-stat-buffer-is-spam))))))
1932
1933       (defun spam-stat-unregister-spam-routine (articles)
1934         (spam-stat-register-spam-routine articles t))
1935
1936       (defun spam-stat-register-ham-routine (articles &optional unregister)
1937         (dolist (article articles)
1938           (let ((article-string (spam-get-article-as-string article)))
1939             (with-temp-buffer
1940               (insert article-string)
1941               (if unregister
1942                   (spam-stat-buffer-change-to-spam)
1943               (spam-stat-buffer-is-non-spam))))))
1944
1945       (defun spam-stat-unregister-ham-routine (articles)
1946         (spam-stat-register-ham-routine articles t))
1947
1948       (defun spam-maybe-spam-stat-load ()
1949         (when spam-use-stat (spam-stat-load)))
1950
1951       (defun spam-maybe-spam-stat-save ()
1952         (when spam-use-stat (spam-stat-save))))
1953
1954   (file-error (progn
1955                 (defalias 'spam-stat-load 'ignore)
1956                 (defalias 'spam-stat-save 'ignore)
1957                 (defalias 'spam-maybe-spam-stat-load 'ignore)
1958                 (defalias 'spam-maybe-spam-stat-save 'ignore)
1959                 (defalias 'spam-stat-register-ham-routine 'ignore)
1960                 (defalias 'spam-stat-unregister-ham-routine 'ignore)
1961                 (defalias 'spam-stat-register-spam-routine 'ignore)
1962                 (defalias 'spam-stat-unregister-spam-routine 'ignore)
1963                 (defalias 'spam-stat-buffer-is-spam 'ignore)
1964                 (defalias 'spam-stat-buffer-change-to-spam 'ignore)
1965                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
1966                 (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
1967                 (defalias 'spam-stat-split-fancy 'ignore)
1968                 (defalias 'spam-check-stat 'ignore))))
1969
1970 \f
1971
1972 ;;;; Blacklists and whitelists.
1973
1974 (defvar spam-whitelist-cache nil)
1975 (defvar spam-blacklist-cache nil)
1976
1977 (defun spam-kill-whole-line ()
1978   (beginning-of-line)
1979   (let ((kill-whole-line t))
1980     (kill-line)))
1981
1982 ;;; address can be a list, too
1983 (defun spam-enter-whitelist (address &optional remove)
1984   "Enter ADDRESS (list or single) into the whitelist.
1985 With a non-nil REMOVE, remove them."
1986   (interactive "sAddress: ")
1987   (spam-enter-list address spam-whitelist remove)
1988   (setq spam-whitelist-cache nil)
1989   (spam-clear-cache 'spam-use-whitelist))
1990
1991 ;;; address can be a list, too
1992 (defun spam-enter-blacklist (address &optional remove)
1993   "Enter ADDRESS (list or single) into the blacklist.
1994 With a non-nil REMOVE, remove them."
1995   (interactive "sAddress: ")
1996   (spam-enter-list address spam-blacklist remove)
1997   (setq spam-blacklist-cache nil)
1998   (spam-clear-cache 'spam-use-whitelist))
1999
2000 (defun spam-enter-list (addresses file &optional remove)
2001   "Enter ADDRESSES into the given FILE.
2002 Either the whitelist or the blacklist files can be used.  With
2003 REMOVE not nil, remove the ADDRESSES."
2004   (if (stringp addresses)
2005       (spam-enter-list (list addresses) file remove)
2006     ;; else, we have a list of addresses here
2007     (unless (file-exists-p (file-name-directory file))
2008       (make-directory (file-name-directory file) t))
2009     (save-excursion
2010       (set-buffer
2011        (find-file-noselect file))
2012       (dolist (a addresses)
2013         (when (stringp a)
2014           (goto-char (point-min))
2015           (if (re-search-forward (regexp-quote a) nil t)
2016               ;; found the address
2017               (when remove
2018                 (spam-kill-whole-line))
2019             ;; else, the address was not found
2020             (unless remove
2021               (goto-char (point-max))
2022               (unless (bobp)
2023                 (insert "\n"))
2024               (insert a "\n")))))
2025       (save-buffer))))
2026
2027 (defun spam-filelist-build-cache (type)
2028   (let ((cache (if (eq type 'spam-use-blacklist)
2029                    spam-blacklist-cache
2030                  spam-whitelist-cache))
2031         parsed-cache)
2032     (unless (gethash type spam-caches)
2033       (while cache
2034         (let ((address (pop cache)))
2035           (unless (zerop (length address)) ; 0 for a nil address too
2036             (setq address (regexp-quote address))
2037             ;; fix regexp-quote's treatment of user-intended regexes
2038             (while (string-match "\\\\\\*" address)
2039               (setq address (replace-match ".*" t t address))))
2040           (push address parsed-cache)))
2041       (puthash type parsed-cache spam-caches))))
2042
2043 (defun spam-filelist-check-cache (type from)
2044   (when (stringp from)
2045     (spam-filelist-build-cache type)
2046     (let (found)
2047       (dolist (address (gethash type spam-caches))
2048         (when (and address (string-match address from))
2049           (setq found t)
2050           (return)))
2051       found)))
2052
2053 ;;; returns t if the sender is in the whitelist, nil or
2054 ;;; spam-split-group otherwise
2055 (defun spam-check-whitelist ()
2056   ;; FIXME!  Should it detect when file timestamps change?
2057   (let ((spam-split-group (if spam-split-symbolic-return
2058                               'spam
2059                             spam-split-group)))
2060     (unless spam-whitelist-cache
2061       (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2062     (if (spam-from-listed-p 'spam-use-whitelist)
2063         t
2064       (if spam-use-whitelist-exclusive
2065           spam-split-group
2066         nil))))
2067
2068 (defun spam-check-blacklist ()
2069   ;; FIXME!  Should it detect when file timestamps change?
2070   (let ((spam-split-group (if spam-split-symbolic-return
2071                               'spam
2072                             spam-split-group)))
2073     (unless spam-blacklist-cache
2074       (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2075     (and (spam-from-listed-p 'spam-use-blacklist) spam-split-group)))
2076
2077 (defun spam-parse-list (file)
2078   (when (file-readable-p file)
2079     (let (contents address)
2080       (with-temp-buffer
2081         (insert-file-contents file)
2082         (while (not (eobp))
2083           (setq address (buffer-substring (point) (point-at-eol)))
2084           (forward-line 1)
2085           ;; insert the e-mail address if detected, otherwise the raw data
2086           (unless (zerop (length address))
2087             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2088               (push (or pure-address address) contents)))))
2089       (nreverse contents))))
2090
2091 (defun spam-from-listed-p (type)
2092   (let ((from (message-fetch-field "from"))
2093         found)
2094     (spam-filelist-check-cache type from)))
2095
2096 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2097   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2098         (declassification (if blacklist 'ham 'spam))
2099         (enter-function
2100          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2101         (remove-function
2102          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2103         from addresses unregister-list article-unregister-list)
2104     (dolist (article articles)
2105       (let ((from (spam-fetch-field-from-fast article))
2106             (id (spam-fetch-field-message-id-fast article))
2107             sender-ignored)
2108         (when (stringp from)
2109           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2110             (when (and (not sender-ignored)
2111                        (stringp ignore-regex)
2112                        (string-match ignore-regex from))
2113               (setq sender-ignored t)))
2114           ;; remember the messages we need to unregister, unless remove is set
2115           (when (and
2116                  (null unregister)
2117                  (spam-log-unregistration-needed-p
2118                   id 'process declassification de-symbol))
2119             (push article article-unregister-list)
2120             (push from unregister-list))
2121           (unless sender-ignored
2122             (push from addresses)))))
2123
2124     (if unregister
2125         (funcall enter-function addresses t) ; unregister all these addresses
2126       ;; else, register normally and unregister what we need to
2127       (funcall remove-function unregister-list t)
2128       (dolist (article article-unregister-list)
2129         (spam-log-undo-registration
2130          (spam-fetch-field-message-id-fast article)
2131          'process
2132          declassification
2133          de-symbol))
2134       (funcall enter-function addresses nil))))
2135
2136 (defun spam-blacklist-unregister-routine (articles)
2137   (spam-blacklist-register-routine articles t))
2138
2139 (defun spam-blacklist-register-routine (articles &optional unregister)
2140   (spam-filelist-register-routine articles t unregister))
2141
2142 (defun spam-whitelist-unregister-routine (articles)
2143   (spam-whitelist-register-routine articles t))
2144
2145 (defun spam-whitelist-register-routine (articles &optional unregister)
2146   (spam-filelist-register-routine articles nil unregister))
2147
2148 \f
2149 ;;;; Spam-report glue
2150 (defun spam-report-gmane-register-routine (articles)
2151   (when articles
2152     (apply 'spam-report-gmane articles)))
2153
2154 (defun spam-report-resend-register-routine (articles)
2155   (spam-report-resend articles))
2156
2157 \f
2158 ;;;; Bogofilter
2159 (defun spam-check-bogofilter-headers (&optional score)
2160   (let ((header (message-fetch-field spam-bogofilter-header))
2161         (spam-split-group (if spam-split-symbolic-return
2162                               'spam
2163                             spam-split-group)))
2164     (when header                        ; return nil when no header
2165       (if score                         ; scoring mode
2166           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2167               (match-string 1 header)
2168             "0")
2169         ;; spam detection mode
2170         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2171                             header)
2172           spam-split-group)))))
2173
2174 ;; return something sensible if the score can't be determined
2175 (defun spam-bogofilter-score (&optional recheck)
2176   "Get the Bogofilter spamicity score"
2177   (interactive "P")
2178   (save-window-excursion
2179     (gnus-summary-show-article t)
2180     (set-buffer gnus-article-buffer)
2181     (let ((score (or (unless recheck
2182                        (spam-check-bogofilter-headers t))
2183                      (spam-check-bogofilter t))))
2184       (gnus-summary-show-article)
2185       (message "Spamicity score %s" score)
2186       (or score "0"))))
2187
2188 (defun spam-check-bogofilter (&optional score)
2189   "Check the Bogofilter backend for the classification of this message"
2190   (let ((article-buffer-name (buffer-name))
2191         (db spam-bogofilter-database-directory)
2192         return)
2193     (with-temp-buffer
2194       (let ((temp-buffer-name (buffer-name)))
2195         (save-excursion
2196           (set-buffer article-buffer-name)
2197           (apply 'call-process-region
2198                  (point-min) (point-max)
2199                  spam-bogofilter-path
2200                  nil temp-buffer-name nil
2201                  (if db `("-d" ,db "-v") `("-v"))))
2202         (setq return (spam-check-bogofilter-headers score))))
2203     return))
2204
2205 (defun spam-bogofilter-register-with-bogofilter (articles
2206                                                  spam
2207                                                  &optional unregister)
2208   "Register an article, given as a string, as spam or non-spam."
2209   (dolist (article articles)
2210     (let ((article-string (spam-get-article-as-string article))
2211           (db spam-bogofilter-database-directory)
2212           (switch (if unregister
2213                       (if spam
2214                           spam-bogofilter-spam-strong-switch
2215                         spam-bogofilter-ham-strong-switch)
2216                     (if spam
2217                         spam-bogofilter-spam-switch
2218                       spam-bogofilter-ham-switch))))
2219       (when (stringp article-string)
2220         (with-temp-buffer
2221           (insert article-string)
2222
2223           (apply 'call-process-region
2224                  (point-min) (point-max)
2225                  spam-bogofilter-path
2226                  nil nil nil switch
2227                  (if db `("-d" ,db "-v") `("-v"))))))))
2228
2229 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2230   (spam-bogofilter-register-with-bogofilter articles t unregister))
2231
2232 (defun spam-bogofilter-unregister-spam-routine (articles)
2233   (spam-bogofilter-register-spam-routine articles t))
2234
2235 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2236   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2237
2238 (defun spam-bogofilter-unregister-ham-routine (articles)
2239   (spam-bogofilter-register-ham-routine articles t))
2240
2241
2242 \f
2243 ;;;; spamoracle
2244 (defun spam-check-spamoracle ()
2245   "Run spamoracle on an article to determine whether it's spam."
2246   (let ((article-buffer-name (buffer-name))
2247         (spam-split-group (if spam-split-symbolic-return
2248                               'spam
2249                             spam-split-group)))
2250     (with-temp-buffer
2251       (let ((temp-buffer-name (buffer-name)))
2252         (save-excursion
2253           (set-buffer article-buffer-name)
2254           (let ((status
2255                  (apply 'call-process-region
2256                         (point-min) (point-max)
2257                         spam-spamoracle-binary
2258                         nil temp-buffer-name nil
2259                         (if spam-spamoracle-database
2260                             `("-f" ,spam-spamoracle-database "mark")
2261                           '("mark")))))
2262             (if (eq 0 status)
2263                 (progn
2264                   (set-buffer temp-buffer-name)
2265                   (goto-char (point-min))
2266                   (when (re-search-forward "^X-Spam: yes;" nil t)
2267                     spam-split-group))
2268               (error "Error running spamoracle: %s" status))))))))
2269
2270 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2271   "Run spamoracle in training mode."
2272   (with-temp-buffer
2273     (let ((temp-buffer-name (buffer-name)))
2274       (save-excursion
2275         (goto-char (point-min))
2276         (dolist (article articles)
2277           (insert (spam-get-article-as-string article)))
2278         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2279                         "-spam"
2280                       "-good"))
2281                (status
2282                 (apply 'call-process-region
2283                        (point-min) (point-max)
2284                        spam-spamoracle-binary
2285                        nil temp-buffer-name nil
2286                        (if spam-spamoracle-database
2287                            `("-f" ,spam-spamoracle-database
2288                              "add" ,arg)
2289                          `("add" ,arg)))))
2290           (unless (eq 0 status)
2291             (error "Error running spamoracle: %s" status)))))))
2292
2293 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2294   (spam-spamoracle-learn articles nil unregister))
2295
2296 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2297   (spam-spamoracle-learn-ham articles t))
2298
2299 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2300   (spam-spamoracle-learn articles t unregister))
2301
2302 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2303   (spam-spamoracle-learn-spam articles t))
2304
2305 \f
2306 ;;;; SpamAssassin
2307 ;;; based mostly on the bogofilter code
2308 (defun spam-check-spamassassin-headers (&optional score)
2309   "Check the SpamAssassin headers for the classification of this message."
2310   (if score                             ; scoring mode
2311       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2312         (when header
2313           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2314               (match-string 1 header)
2315             "0")))
2316     ;; spam detection mode
2317     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header))
2318           (spam-split-group (if spam-split-symbolic-return
2319                                  'spam
2320                                spam-split-group)))
2321           (when header                  ; return nil when no header
2322             (when (string-match spam-spamassassin-positive-spam-flag-header
2323                                 header)
2324               spam-split-group)))))
2325
2326 (defun spam-check-spamassassin (&optional score)
2327   "Check the SpamAssassin backend for the classification of this message."
2328   (let ((article-buffer-name (buffer-name)))
2329     (with-temp-buffer
2330       (let ((temp-buffer-name (buffer-name)))
2331         (save-excursion
2332           (set-buffer article-buffer-name)
2333           (apply 'call-process-region
2334                  (point-min) (point-max) spam-spamassassin-path
2335                  nil temp-buffer-name nil spam-spamassassin-arguments))
2336         ;; check the return now (we're back in the temp buffer)
2337         (goto-char (point-min))
2338         (spam-check-spamassassin-headers score)))))
2339
2340 ;; return something sensible if the score can't be determined
2341 (defun spam-spamassassin-score (&optional recheck)
2342   "Get the SpamAssassin score"
2343   (interactive "P")
2344   (save-window-excursion
2345     (gnus-summary-show-article t)
2346     (set-buffer gnus-article-buffer)
2347     (let ((score (or (unless recheck
2348                        (spam-check-spamassassin-headers t))
2349                      (spam-check-spamassassin t))))
2350       (gnus-summary-show-article)
2351       (message "SpamAssassin score %s" score)
2352       (or score "0"))))
2353
2354 (defun spam-spamassassin-register-with-sa-learn (articles spam
2355                                                  &optional unregister)
2356   "Register articles with spamassassin's sa-learn as spam or non-spam."
2357   (if articles
2358       (let ((action (if unregister spam-sa-learn-unregister-switch
2359                       (if spam spam-sa-learn-spam-switch
2360                         spam-sa-learn-ham-switch)))
2361             (summary-buffer-name (buffer-name)))
2362         (with-temp-buffer
2363           ;; group the articles into mbox format
2364           (dolist (article articles)
2365             (let (article-string)
2366               (save-excursion
2367                 (set-buffer summary-buffer-name)
2368                 (setq article-string (spam-get-article-as-string article)))
2369               (when (stringp article-string)
2370                 (insert "From \n") ; mbox separator (sa-learn only checks the
2371                                    ; first five chars, so we can get away with
2372                                    ; a bogus line))
2373                 (insert article-string)
2374                 (insert "\n"))))
2375           ;; call sa-learn on all messages at the same time
2376           (apply 'call-process-region
2377                  (point-min) (point-max)
2378                  spam-sa-learn-path
2379                  nil nil nil "--mbox"
2380                  (if spam-sa-learn-rebuild
2381                      (list action)
2382                    `("--no-rebuild" ,action)))))))
2383
2384 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2385   (spam-spamassassin-register-with-sa-learn articles t unregister))
2386
2387 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2388   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2389
2390 (defun spam-spamassassin-unregister-spam-routine (articles)
2391   (spam-spamassassin-register-with-sa-learn articles t t))
2392
2393 (defun spam-spamassassin-unregister-ham-routine (articles)
2394   (spam-spamassassin-register-with-sa-learn articles nil t))
2395
2396 \f
2397 ;;;; Bsfilter
2398 ;;; based mostly on the bogofilter code
2399 (defun spam-check-bsfilter-headers (&optional score)
2400   (if score
2401       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2402           "0")
2403     (let ((header (nnmail-fetch-field spam-bsfilter-header))
2404           (spam-split-group (if spam-split-symbolic-return
2405                                 'spam
2406                               spam-split-group)))
2407       (when header ; return nil when no header
2408         (when (string-match "YES" header)
2409           spam-split-group)))))
2410
2411 ;; return something sensible if the score can't be determined
2412 (defun spam-bsfilter-score (&optional recheck)
2413   "Get the Bsfilter spamicity score"
2414   (interactive "P")
2415   (save-window-excursion
2416     (gnus-summary-show-article t)
2417     (set-buffer gnus-article-buffer)
2418     (let ((score (or (unless recheck
2419                        (spam-check-bsfilter-headers t))
2420                      (spam-check-bsfilter t))))
2421       (gnus-summary-show-article)
2422       (message "Spamicity score %s" score)
2423       (or score "0"))))
2424
2425 (defun spam-check-bsfilter (&optional score)
2426   "Check the Bsfilter backend for the classification of this message"
2427   (let ((article-buffer-name (buffer-name))
2428         (dir spam-bsfilter-database-directory)
2429         return)
2430     (with-temp-buffer
2431       (let ((temp-buffer-name (buffer-name)))
2432         (save-excursion
2433           (set-buffer article-buffer-name)
2434           (apply 'call-process-region
2435                  (point-min) (point-max)
2436                  spam-bsfilter-path
2437                  nil temp-buffer-name nil
2438                  "--pipe"
2439                  "--insert-flag"
2440                  "--insert-probability"
2441                  (when dir
2442                    (list "--homedir" dir))))
2443         (setq return (spam-check-bsfilter-headers score))))
2444     return))
2445
2446 (defun spam-bsfilter-register-with-bsfilter (articles
2447                                              spam
2448                                              &optional unregister)
2449   "Register an article, given as a string, as spam or non-spam."
2450   (dolist (article articles)
2451     (let ((article-string (spam-get-article-as-string article))
2452           (switch (if unregister
2453                       (if spam
2454                           spam-bsfilter-spam-strong-switch
2455                         spam-bsfilter-ham-strong-switch)
2456                     (if spam
2457                         spam-bsfilter-spam-switch
2458                       spam-bsfilter-ham-switch))))
2459       (when (stringp article-string)
2460         (with-temp-buffer
2461           (insert article-string)
2462           (apply 'call-process-region
2463                  (point-min) (point-max)
2464                  spam-bsfilter-path
2465                  nil nil nil switch
2466                  "--update"
2467                  (when spam-bsfilter-database-directory
2468                    (list "--homedir"
2469                          spam-bsfilter-database-directory))))))))
2470
2471 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2472   (spam-bsfilter-register-with-bsfilter articles t unregister))
2473
2474 (defun spam-bsfilter-unregister-spam-routine (articles)
2475   (spam-bsfilter-register-spam-routine articles t))
2476
2477 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2478   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2479
2480 (defun spam-bsfilter-unregister-ham-routine (articles)
2481   (spam-bsfilter-register-ham-routine articles t))
2482
2483 \f
2484 ;;;; CRM114 Mailfilter
2485 (defun spam-check-crm114-headers (&optional score)
2486   (let ((header (message-fetch-field spam-crm114-header))
2487         (spam-split-group (if spam-split-symbolic-return
2488                               'spam
2489                             spam-split-group)))
2490     (when header                        ; return nil when no header
2491       (if score                         ; scoring mode
2492           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2493               (match-string 1 header)
2494             "0")
2495         ;; spam detection mode
2496         (when (string-match spam-crm114-positive-spam-header
2497                             header)
2498           spam-split-group)))))
2499
2500 ;; return something sensible if the score can't be determined
2501 (defun spam-crm114-score ()
2502   "Get the CRM114 Mailfilter pR"
2503   (interactive)
2504   (save-window-excursion
2505     (gnus-summary-show-article t)
2506     (set-buffer gnus-article-buffer)
2507     (let ((score (or (spam-check-crm114-headers t)
2508                      (spam-check-crm114 t))))
2509       (gnus-summary-show-article)
2510       (message "pR: %s" score)
2511       (or score "0"))))
2512
2513 (defun spam-check-crm114 (&optional score)
2514   "Check the CRM114 Mailfilter backend for the classification of this message"
2515   (let ((article-buffer-name (buffer-name))
2516         (db spam-crm114-database-directory)
2517         return)
2518     (with-temp-buffer
2519       (let ((temp-buffer-name (buffer-name)))
2520         (save-excursion
2521           (set-buffer article-buffer-name)
2522           (apply 'call-process-region
2523                  (point-min) (point-max)
2524                  spam-crm114-program
2525                  nil temp-buffer-name nil
2526                  (when db (list (concat "--fileprefix=" db)))))
2527         (setq return (spam-check-crm114-headers score))))
2528     return))
2529
2530 (defun spam-crm114-register-with-crm114 (articles
2531                                          spam
2532                                          &optional unregister)
2533   "Register an article, given as a string, as spam or non-spam."
2534   (dolist (article articles)
2535     (let ((article-string (spam-get-article-as-string article))
2536           (db spam-crm114-database-directory)
2537           (switch (if unregister
2538                       (if spam
2539                           spam-crm114-spam-strong-switch
2540                         spam-crm114-ham-strong-switch)
2541                     (if spam
2542                         spam-crm114-spam-switch
2543                       spam-crm114-ham-switch))))
2544       (when (stringp article-string)
2545         (with-temp-buffer
2546           (insert article-string)
2547
2548           (apply 'call-process-region
2549                  (point-min) (point-max)
2550                  spam-crm114-program
2551                  nil nil nil
2552                  (when db (list switch (concat "--fileprefix=" db)))))))))
2553
2554 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2555   (spam-crm114-register-with-crm114 articles t unregister))
2556
2557 (defun spam-crm114-unregister-spam-routine (articles)
2558   (spam-crm114-register-spam-routine articles t))
2559
2560 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2561   (spam-crm114-register-with-crm114 articles nil unregister))
2562
2563 (defun spam-crm114-unregister-ham-routine (articles)
2564   (spam-crm114-register-ham-routine articles t))
2565
2566 \f
2567 ;;;; Hooks
2568
2569 ;;;###autoload
2570 (defun spam-initialize (&rest symbols)
2571   "Install the spam.el hooks and do other initialization.
2572 When SYMBOLS is given, set those variables to t.  This is so you
2573 can call spam-initialize before you set spam-use-* variables on
2574 explicitly, and matters only if you need the extra headers
2575 installed through spam-necessary-extra-headers."
2576   (interactive)
2577
2578   (dolist (var symbols)
2579     (set var t))
2580
2581   (dolist (header (spam-necessary-extra-headers))
2582     (add-to-list 'nnmail-extra-headers header)
2583     (add-to-list 'gnus-extra-headers header))
2584
2585   (setq spam-install-hooks t)
2586   ;; TODO: How do we redo this every time spam-face is customized?
2587   (push '((eq mark gnus-spam-mark) . spam-face)
2588         gnus-summary-highlight)
2589   ;; Add hooks for loading and saving the spam stats
2590   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2591   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2592   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2593   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2594   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2595   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2596   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2597
2598 (defun spam-unload-hook ()
2599   "Uninstall the spam.el hooks"
2600   (interactive)
2601   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2602   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2603   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2604   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2605   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2606   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2607   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2608
2609 (when spam-install-hooks
2610   (spam-initialize))
2611
2612 (provide 'spam)
2613
2614 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2615 ;;; spam.el ends here