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

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