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