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

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