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 ;; "score" for Spamassassin 3.0 or later:
1186 ;; X-Spam-Status: Yes, score=13.1 required=5.0 tests=DNS_FROM_RFC_ABUSE,
1187 ;;      [...],UNDISC_RECIPS autolearn=disabled version=3.0.3
1188
1189
1190 (defun spam-extra-header-to-number (header headers)
1191   "Transform an extra HEADER to a number, using list of HEADERS.
1192 Note this has to be fast."
1193   (let ((header-content (gnus-extra-header header headers)))
1194     (if header-content
1195         (cond
1196          ((eq header 'X-Spam-Status)
1197           (string-to-number (gnus-replace-in-string
1198                              header-content
1199                              spam-spamassassin-score-regexp
1200                              "\\1")))
1201          ;; for CRM checking, it's probably faster to just do the string match
1202          ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header-content))
1203           (string-to-number (match-string 1 header-content)))
1204          ((eq header 'X-Bogosity)
1205           (string-to-number (gnus-replace-in-string
1206                              (gnus-replace-in-string
1207                               header-content
1208                               ".*spamicity=" "")
1209                              ",.*" "")))
1210          (t nil))
1211       nil)))
1212
1213 (defun spam-summary-score (headers &optional specific-header)
1214   "Score an article for the summary buffer, as fast as possible.
1215 With SPECIFIC-HEADER, returns only that header's score.
1216 Will not return a nil score."
1217   (let (score)
1218     (dolist (header
1219              (if specific-header
1220                  (list specific-header)
1221                (spam-necessary-extra-headers)))
1222       (setq score
1223             (spam-extra-header-to-number header headers))
1224       (when score
1225         (return)))
1226     (or score 0)))
1227
1228 (defun spam-generic-score (&optional recheck)
1229   "Invoke whatever scoring method we can."
1230   (interactive "P")
1231   (cond
1232    ((or spam-use-spamassassin spam-use-spamassassin-headers)
1233     (spam-spamassassin-score recheck))
1234    ((or spam-use-bsfilter spam-use-bsfilter-headers)
1235     (spam-bsfilter-score recheck))
1236    (spam-use-crm114
1237     (spam-crm114-score))
1238    (t (spam-bogofilter-score recheck))))
1239 ;;}}}
1240
1241 ;;{{{ set up widening, processor checks
1242
1243 ;;; set up IMAP widening if it's necessary
1244 (defun spam-setup-widening ()
1245   (when (spam-widening-needed-p)
1246     (setq nnimap-split-download-body-default t)))
1247
1248 (defun spam-widening-needed-p (&optional force-symbols)
1249   (let (found)
1250     (dolist (backend (spam-backend-list))
1251       (when (and (spam-backend-statistical-p backend)
1252                  (or (symbol-value backend)
1253                      (memq backend force-symbols)))
1254         (setq found backend)))
1255     found))
1256
1257 (defvar spam-list-of-processors
1258   ;; note the nil processors are not defined in gnus.el
1259   '((gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
1260     (gnus-group-spam-exit-processor-bsfilter     spam spam-use-bsfilter)
1261     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
1262     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
1263     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
1264     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
1265     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
1266     (gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) ;; Buggy?
1267     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
1268     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
1269     (gnus-group-ham-exit-processor-bsfilter      ham spam-use-bsfilter)
1270     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
1271     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
1272     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
1273     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
1274     (gnus-group-ham-exit-processor-spamassassin  ham spam-use-spamassassin)
1275     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
1276   "The OBSOLETE `spam-list-of-processors' list.
1277 This list contains pairs associating the obsolete ham/spam exit
1278 processor variables with a classification and a spam-use-*
1279 variable.  When the processor variable is nil, just the
1280 classification and spam-use-* check variable are used.  This is
1281 superceded by the new spam backend code, so it's only consulted
1282 for backwards compatibility.")
1283
1284 (defun spam-group-processor-p (group backend &optional classification)
1285   "Checks if GROUP has a BACKEND with CLASSIFICATION registered.
1286 Also accepts the obsolete processors, which can be found in
1287 gnus.el and in spam-list-of-processors.  In the case of mover
1288 backends, checks the setting of spam-summary-exit-behavior in
1289 addition to the set values for the group."
1290   (if (and (stringp group)
1291            (symbolp backend))
1292       (let ((old-style (assq backend spam-list-of-processors))
1293             (parameters (nth 0 (gnus-parameter-spam-process group)))
1294             found)
1295         (if old-style  ; old-style processor
1296             (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style))
1297           ;; now search for the parameter
1298           (dolist (parameter parameters)
1299             (when (and (null found)
1300                        (listp parameter)
1301                        (eq classification (nth 0 parameter))
1302                        (eq backend (nth 1 parameter)))
1303               (setq found t)))
1304
1305           ;; now, if the parameter was not found, do the
1306           ;; spam-summary-exit-behavior-logic for mover backends
1307           (unless found
1308             (when (spam-backend-mover-p backend)
1309               (setq
1310                found
1311                (cond
1312                 ((eq spam-summary-exit-behavior 'move-all) t)
1313                 ((eq spam-summary-exit-behavior 'move-none) nil)
1314                 ((eq spam-summary-exit-behavior 'default)
1315                  (or (eq classification 'spam) ;move spam out of all groups
1316                      ;; move ham out of spam groups
1317                      (and (eq classification 'ham)
1318                           (spam-group-spam-contents-p group))))
1319                 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s"
1320                                spam-summary-exit-behavior))))))
1321
1322           found))
1323     nil))
1324
1325 ;;}}}
1326
1327 ;;{{{ Summary entry and exit processing.
1328
1329 (defun spam-mark-junk-as-spam-routine ()
1330   ;; check the global list of group names spam-junk-mailgroups and the
1331   ;; group parameters
1332   (when (spam-group-spam-contents-p gnus-newsgroup-name)
1333     (gnus-message 6 "Marking %s articles as spam"
1334                   (if spam-mark-only-unseen-as-spam
1335                       "unseen"
1336                     "unread"))
1337     (let ((articles (if spam-mark-only-unseen-as-spam
1338                         gnus-newsgroup-unseen
1339                       gnus-newsgroup-unreads)))
1340       (if spam-mark-new-messages-in-spam-group-as-spam
1341           (dolist (article articles)
1342             (gnus-summary-mark-article article gnus-spam-mark))
1343         (gnus-message 9 "Did not mark new messages as spam.")))))
1344
1345 (defun spam-summary-prepare ()
1346   (setq spam-old-articles
1347         (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham))
1348               (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam))))
1349   (spam-mark-junk-as-spam-routine))
1350
1351 ;; The spam processors are invoked for any group, spam or ham or neither
1352 (defun spam-summary-prepare-exit ()
1353   (unless gnus-group-is-exiting-without-update-p
1354     (gnus-message 6 "Exiting summary buffer and applying spam rules")
1355
1356     ;; before we begin, remove any article limits
1357 ;    (ignore-errors
1358 ;      (gnus-summary-pop-limit t))
1359
1360     ;; first of all, unregister any articles that are no longer ham or spam
1361     ;; we have to iterate over the processors, or else we'll be too slow
1362     (dolist (classification (spam-classifications))
1363       (let* ((old-articles (cdr-safe (assq classification spam-old-articles)))
1364              (new-articles (spam-list-articles
1365                             gnus-newsgroup-articles
1366                             classification))
1367              (changed-articles (spam-set-difference new-articles old-articles)))
1368         ;; now that we have the changed articles, we go through the processors
1369         (dolist (backend (spam-backend-list))
1370           (let (unregister-list)
1371             (dolist (article changed-articles)
1372               (let ((id (spam-fetch-field-message-id-fast article)))
1373                 (when (spam-log-unregistration-needed-p
1374                        id 'process classification backend)
1375                   (push article unregister-list))))
1376             ;; call spam-register-routine with specific articles to unregister,
1377             ;; when there are articles to unregister and the check is enabled
1378             (when (and unregister-list (symbol-value backend))
1379               (spam-backend-put-article-todo-list backend
1380                                                   classification
1381                                                   unregister-list
1382                                                   t))))))
1383
1384     ;; do the non-moving backends first, then the moving ones
1385     (dolist (backend-type '(non-mover mover))
1386       (dolist (classification (spam-classifications))
1387         (dolist (backend (spam-backend-list backend-type))
1388           (when (spam-group-processor-p
1389                  gnus-newsgroup-name
1390                  backend
1391                  classification)
1392             (spam-backend-put-article-todo-list backend
1393                                                 classification
1394                                                 (spam-list-articles
1395                                                  gnus-newsgroup-articles
1396                                                  classification))))))
1397
1398     (spam-resolve-registrations-routine) ; do the registrations now
1399
1400     ;; we mark all the leftover spam articles as expired at the end
1401     (dolist (article (spam-list-articles
1402                       gnus-newsgroup-articles
1403                       'spam))
1404       (gnus-summary-mark-article article gnus-expirable-mark)))
1405
1406   (setq spam-old-articles nil))
1407
1408 ;;}}}
1409
1410 ;;{{{ spam-use-move and spam-use-copy backend support functions
1411
1412 (defun spam-copy-or-move-routine (copy groups articles classification)
1413
1414   (when (and (car-safe groups) (listp (car-safe groups)))
1415     (setq groups (pop groups)))
1416
1417   (unless (listp groups)
1418     (setq groups (list groups)))
1419
1420     ;; remove the current process mark
1421   (gnus-summary-kill-process-mark)
1422
1423   (let ((backend-supports-deletions
1424          (gnus-check-backend-function
1425           'request-move-article gnus-newsgroup-name))
1426         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
1427         article mark deletep respool)
1428
1429     (when (member 'respool groups)
1430       (setq respool t)                  ; boolean for later
1431       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
1432
1433     ;; now do the actual move
1434     (dolist (group groups)
1435       (when (and articles (stringp group))
1436
1437         ;; first, mark the article with the process mark and, if needed,
1438         ;; the unread or expired mark (for ham and spam respectively)
1439         (dolist (article articles)
1440           (when (and (eq classification 'ham)
1441                      spam-mark-ham-unread-before-move-from-spam-group)
1442             (gnus-message 9 "Marking ham article %d unread before move"
1443                           article)
1444             (gnus-summary-mark-article article gnus-unread-mark))
1445           (when (and (eq classification 'spam)
1446                      (not copy))
1447             (gnus-message 9 "Marking spam article %d expirable before move"
1448                           article)
1449             (gnus-summary-mark-article article gnus-expirable-mark))
1450           (gnus-summary-set-process-mark article)
1451
1452           (if respool              ; respooling is with a "fake" group
1453               (let ((spam-split-disabled
1454                      (or spam-split-disabled
1455                          (and (eq classification 'ham)
1456                               spam-disable-spam-split-during-ham-respool))))
1457                 (gnus-message 9 "Respooling article %d with method %s"
1458                               article respool-method)
1459                 (gnus-summary-respool-article nil respool-method))
1460             (if (or (not backend-supports-deletions) ; else, we are not respooling
1461                     (> (length groups) 1))
1462                 (progn              ; if copying, copy and set deletep
1463                   (gnus-message 9 "Copying article %d to group %s"
1464                                 article group)
1465                   (gnus-summary-copy-article nil group)
1466                   (setq deletep t))
1467               (gnus-message 9 "Moving article %d to group %s"
1468                             article group)
1469               (gnus-summary-move-article nil group))))) ; else move articles
1470
1471       ;; now delete the articles, unless a) copy is t, and there was a copy done
1472       ;;                                 b) a move was done to a single group
1473       ;;                                 c) backend-supports-deletions is nil
1474       (unless copy
1475         (when (and deletep backend-supports-deletions)
1476           (dolist (article articles)
1477               (gnus-summary-set-process-mark article)
1478               (gnus-message 9 "Deleting article %d" article))
1479           (when articles
1480             (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1481               (gnus-summary-delete-article nil)))))
1482
1483       (gnus-summary-yank-process-mark)
1484       (length articles))))
1485
1486 (defun spam-copy-spam-routine (articles)
1487   (spam-copy-or-move-routine
1488    t
1489    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1490    articles
1491    'spam))
1492
1493 (defun spam-move-spam-routine (articles)
1494   (spam-copy-or-move-routine
1495    nil
1496    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1497    articles
1498    'spam))
1499
1500 (defun spam-copy-ham-routine (articles)
1501   (spam-copy-or-move-routine
1502    t
1503    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1504    articles
1505    'ham))
1506
1507 (defun spam-move-ham-routine (articles)
1508   (spam-copy-or-move-routine
1509    nil
1510    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1511    articles
1512    'ham))
1513
1514 ;;}}}
1515
1516 ;;{{{ article and field retrieval code
1517 (defun spam-get-article-as-string (article)
1518   (when (numberp article)
1519     (with-temp-buffer
1520       (gnus-request-article-this-buffer
1521        article
1522        gnus-newsgroup-name)
1523       (buffer-string))))
1524
1525 ;; disabled for now
1526 ;; (defun spam-get-article-as-filename (article)
1527 ;;   (let ((article-filename))
1528 ;;     (when (numberp article)
1529 ;;       (nnml-possibly-change-directory
1530 ;;        (gnus-group-real-name gnus-newsgroup-name))
1531 ;;       (setq article-filename (expand-file-name
1532 ;;                              (int-to-string article) nnml-current-directory)))
1533 ;;     (if (file-exists-p article-filename)
1534 ;;      article-filename
1535 ;;       nil)))
1536
1537 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
1538   "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function.
1539 When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
1540 When FIELD is 'number, ARTICLE can be any number (since we want
1541 to find it out)."
1542   (when (numberp article)
1543     (let* ((data-header (or prepared-data-header
1544                             (spam-fetch-article-header article))))
1545       (if (arrayp data-header)
1546         (cond
1547          ((equal field 'number)
1548           (mail-header-number data-header))
1549          ((equal field 'from)
1550           (mail-header-from data-header))
1551          ((equal field 'message-id)
1552           (mail-header-message-id data-header))
1553          ((equal field 'subject)
1554           (mail-header-subject data-header))
1555          ((equal field 'references)
1556           (mail-header-references data-header))
1557          ((equal field 'date)
1558           (mail-header-date data-header))
1559          ((equal field 'xref)
1560           (mail-header-xref data-header))
1561          ((equal field 'extra)
1562           (mail-header-extra data-header))
1563          (t
1564           (gnus-error
1565            5
1566            "spam-fetch-field-fast: unknown field %s requested"
1567            field)
1568           nil))
1569         (gnus-message 6 "Article %d has a nil data header" article)))))
1570
1571 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1572   (spam-fetch-field-fast article 'from prepared-data-header))
1573
1574 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1575   (spam-fetch-field-fast article 'subject prepared-data-header))
1576
1577 (defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1578   (spam-fetch-field-fast article 'message-id prepared-data-header))
1579
1580 (defun spam-generate-fake-headers (article)
1581   (let ((dh (spam-fetch-article-header article)))
1582     (if dh
1583         (concat
1584          (format
1585           ;; 80-character limit makes for strange constructs
1586           (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1587                   "Date: %s\nReferences: %s\nXref: %s\n")
1588           (spam-fetch-field-fast article 'from dh)
1589           (spam-fetch-field-fast article 'subject dh)
1590           (spam-fetch-field-fast article 'message-id dh)
1591           (spam-fetch-field-fast article 'date dh)
1592           (spam-fetch-field-fast article 'references dh)
1593           (spam-fetch-field-fast article 'xref dh))
1594          (when (spam-fetch-field-fast article 'extra dh)
1595            (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1596       (gnus-message
1597        5
1598        "spam-generate-fake-headers: article %d didn't have a valid header"
1599        article))))
1600
1601 (defun spam-fetch-article-header (article)
1602   (save-excursion
1603     (set-buffer gnus-summary-buffer)
1604     (gnus-read-header article)
1605     (nth 3 (assq article gnus-newsgroup-data))))
1606 ;;}}}
1607
1608 ;;{{{ Spam determination.
1609
1610 (defun spam-split (&rest specific-checks)
1611   "Split this message into the `spam' group if it is spam.
1612 This function can be used as an entry in the variable `nnmail-split-fancy',
1613 for example like this: (: spam-split).  It can take checks as
1614 parameters.  A string as a parameter will set the
1615 spam-split-group to that string.
1616
1617 See the Info node `(gnus)Fancy Mail Splitting' for more details."
1618   (interactive)
1619   (setq spam-split-last-successful-check nil)
1620   (unless spam-split-disabled
1621     (let ((spam-split-group-choice spam-split-group))
1622       (dolist (check specific-checks)
1623         (when (stringp check)
1624           (setq spam-split-group-choice check)
1625           (setq specific-checks (delq check specific-checks))))
1626
1627       (let ((spam-split-group spam-split-group-choice)
1628             (widening-needed-check (spam-widening-needed-p specific-checks)))
1629         (save-excursion
1630           (save-restriction
1631             (when widening-needed-check
1632               (widen)
1633               (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
1634                             widening-needed-check))
1635             (let ((backends (spam-backend-list))
1636                   decision)
1637               (while (and backends (not decision))
1638                 (let* ((backend (pop backends))
1639                        (check-function (spam-backend-check backend))
1640                        (spam-split-group (if spam-split-symbolic-return
1641                                              'spam
1642                                            spam-split-group)))
1643                   (when (or
1644                          ;; either, given specific checks, this is one of them
1645                          (memq backend specific-checks)
1646                          ;; or, given no specific checks, spam-use-CHECK is set
1647                          (and (null specific-checks) (symbol-value backend)))
1648                     (gnus-message 6 "spam-split: calling the %s function"
1649                                   check-function)
1650                     (setq decision (funcall check-function))
1651                     ;; if we got a decision at all, save the current check
1652                     (when decision
1653                       (setq spam-split-last-successful-check backend))
1654
1655                     (when (eq decision 'spam)
1656                       (unless spam-split-symbolic-return
1657                         (gnus-error
1658                          5
1659                          (format "spam-split got %s but %s is nil"
1660                                  decision
1661                                  spam-split-symbolic-return)))))))
1662               (if (eq decision t)
1663                   (if spam-split-symbolic-return-positive 'ham nil)
1664                 decision))))))))
1665
1666 (defun spam-find-spam ()
1667   "This function will detect spam in the current newsgroup using spam-split."
1668   (interactive)
1669
1670   (let* ((group gnus-newsgroup-name)
1671          (autodetect (gnus-parameter-spam-autodetect group))
1672          (methods (gnus-parameter-spam-autodetect-methods group))
1673          (first-method (nth 0 methods))
1674          (articles (if spam-autodetect-recheck-messages
1675                        gnus-newsgroup-articles
1676                      gnus-newsgroup-unseen))
1677          article-cannot-be-faked)
1678
1679
1680     (dolist (backend methods)
1681       (when (spam-backend-statistical-p backend)
1682         (setq article-cannot-be-faked t)
1683         (return)))
1684
1685     (when (memq 'default methods)
1686       (setq article-cannot-be-faked t))
1687
1688     (when (and autodetect
1689                (not (equal first-method 'none)))
1690       (mapcar
1691        (lambda (article)
1692          (let ((id (spam-fetch-field-message-id-fast article))
1693                (subject (spam-fetch-field-subject-fast article))
1694                (sender (spam-fetch-field-from-fast article))
1695                registry-lookup)
1696
1697            (unless id
1698              (gnus-message 6 "Article %d has no message ID!" article))
1699
1700            (when (and id spam-log-to-registry)
1701              (setq registry-lookup (spam-log-registration-type id 'incoming))
1702              (when registry-lookup
1703                (gnus-message
1704                 9
1705                 "spam-find-spam: message %s was already registered incoming"
1706                 id)))
1707
1708            (let* ((spam-split-symbolic-return t)
1709                   (spam-split-symbolic-return-positive t)
1710                   (fake-headers (spam-generate-fake-headers article))
1711                   (split-return
1712                    (or registry-lookup
1713                        (with-temp-buffer
1714                          (if article-cannot-be-faked
1715                              (gnus-request-article-this-buffer
1716                               article
1717                               group)
1718                            ;; else, we fake the article
1719                            (when fake-headers (insert fake-headers)))
1720                          (if (or (null first-method)
1721                                  (equal first-method 'default))
1722                              (spam-split)
1723                            (apply 'spam-split methods))))))
1724              (if (equal split-return 'spam)
1725                  (gnus-summary-mark-article article gnus-spam-mark))
1726
1727              (when (and id split-return spam-log-to-registry)
1728                (when (zerop (gnus-registry-group-count id))
1729                  (gnus-registry-add-group
1730                   id group subject sender))
1731
1732                (unless registry-lookup
1733                  (spam-log-processing-to-registry
1734                   id
1735                   'incoming
1736                   split-return
1737                   spam-split-last-successful-check
1738                   group))))))
1739        articles))))
1740
1741 ;;}}}
1742
1743 ;;{{{ registration/unregistration functions
1744
1745 (defun spam-resolve-registrations-routine ()
1746   "Go through the backends and register or unregister articles as needed."
1747   (dolist (backend-type '(non-mover mover))
1748     (dolist (classification (spam-classifications))
1749       (dolist (backend (spam-backend-list backend-type))
1750         (let ((rlist (spam-backend-get-article-todo-list
1751                       backend classification))
1752               (ulist (spam-backend-get-article-todo-list
1753                       backend classification t))
1754               (delcount 0))
1755
1756           ;; clear the old lists right away
1757           (spam-backend-put-article-todo-list backend
1758                                               classification
1759                                               nil
1760                                               nil)
1761           (spam-backend-put-article-todo-list backend
1762                                               classification
1763                                               nil
1764                                               t)
1765
1766           ;; eliminate duplicates
1767           (dolist (article (copy-sequence ulist))
1768             (when (memq article rlist)
1769               (incf delcount)
1770               (setq rlist (delq article rlist))
1771               (setq ulist (delq article ulist))))
1772
1773           (unless (zerop delcount)
1774             (gnus-message
1775              9
1776              "%d messages were saved the trouble of unregistering and then registering"
1777              delcount))
1778
1779           ;; unregister articles
1780           (unless (zerop (length ulist))
1781             (let ((num (spam-unregister-routine classification backend ulist)))
1782               (when (> num 0)
1783                 (gnus-message
1784                  6
1785                  "%d %s messages were unregistered by backend %s."
1786                  num
1787                  classification
1788                  backend))))
1789
1790             ;; register articles
1791             (unless (zerop (length rlist))
1792               (let ((num (spam-register-routine classification backend rlist)))
1793                 (when (> num 0)
1794                   (gnus-message
1795                    6
1796                    "%d %s messages were registered by backend %s."
1797                    num
1798                    classification
1799                    backend)))))))))
1800
1801 (defun spam-unregister-routine (classification
1802                                 backend
1803                                 specific-articles)
1804   (spam-register-routine classification backend specific-articles t))
1805
1806 (defun spam-register-routine (classification
1807                               backend
1808                               specific-articles
1809                               &optional unregister)
1810   (when (and (spam-classification-valid-p classification)
1811              (spam-backend-valid-p backend))
1812     (let* ((register-function
1813             (spam-backend-function backend classification 'registration))
1814            (unregister-function
1815             (spam-backend-function backend classification 'unregistration))
1816            (run-function (if unregister
1817                              unregister-function
1818                            register-function))
1819            (log-function (if unregister
1820                              'spam-log-undo-registration
1821                            'spam-log-processing-to-registry))
1822            article articles)
1823
1824       (when run-function
1825         ;; make list of articles, using specific-articles if given
1826         (setq articles (or specific-articles
1827                            (spam-list-articles
1828                             gnus-newsgroup-articles
1829                             classification)))
1830         ;; process them
1831         (when (> (length articles) 0)
1832           (gnus-message 5 "%s %d %s articles as %s using backend %s"
1833                         (if unregister "Unregistering" "Registering")
1834                         (length articles)
1835                         (if specific-articles "specific" "")
1836                         classification
1837                         backend)
1838           (funcall run-function articles)
1839           ;; now log all the registrations (or undo them, depending on
1840           ;; unregister)
1841           (dolist (article articles)
1842             (funcall log-function
1843                      (spam-fetch-field-message-id-fast article)
1844                      'process
1845                      classification
1846                      backend
1847                      gnus-newsgroup-name))))
1848       ;; return the number of articles processed
1849       (length articles))))
1850
1851 ;;; log a ham- or spam-processor invocation to the registry
1852 (defun spam-log-processing-to-registry (id type classification backend group)
1853   (when spam-log-to-registry
1854     (if (and (stringp id)
1855              (stringp group)
1856              (spam-process-type-valid-p type)
1857              (spam-classification-valid-p classification)
1858              (spam-backend-valid-p backend))
1859         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1860               (cell (list classification backend group)))
1861           (push cell cell-list)
1862           (gnus-registry-store-extra-entry
1863            id
1864            type
1865            cell-list))
1866
1867       (gnus-error
1868        7
1869        (format "%s call with bad ID, type, classification, spam-backend, or group"
1870                "spam-log-processing-to-registry")))))
1871
1872 ;;; check if a ham- or spam-processor registration has been done
1873 (defun spam-log-registered-p (id type)
1874   (when spam-log-to-registry
1875     (if (and (stringp id)
1876              (spam-process-type-valid-p type))
1877         (cdr-safe (gnus-registry-fetch-extra id type))
1878       (progn
1879         (gnus-error
1880          7
1881          (format "%s called with bad ID, type, classification, or spam-backend"
1882                  "spam-log-registered-p"))
1883         nil))))
1884
1885 ;;; check what a ham- or spam-processor registration says
1886 ;;; returns nil if conflicting registrations are found
1887 (defun spam-log-registration-type (id type)
1888   (let ((count 0)
1889         decision)
1890     (dolist (reg (spam-log-registered-p id type))
1891       (let ((classification (nth 0 reg)))
1892         (when (spam-classification-valid-p classification)
1893           (when (and decision
1894                      (not (eq classification decision)))
1895             (setq count (+ 1 count)))
1896           (setq decision classification))))
1897     (if (< 0 count)
1898         nil
1899       decision)))
1900
1901
1902 ;;; check if a ham- or spam-processor registration needs to be undone
1903 (defun spam-log-unregistration-needed-p (id type classification backend)
1904   (when spam-log-to-registry
1905     (if (and (stringp id)
1906              (spam-process-type-valid-p type)
1907              (spam-classification-valid-p classification)
1908              (spam-backend-valid-p backend))
1909         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1910               found)
1911           (dolist (cell cell-list)
1912             (unless found
1913               (when (and (eq classification (nth 0 cell))
1914                          (eq backend (nth 1 cell)))
1915                 (setq found t))))
1916           found)
1917       (progn
1918         (gnus-error
1919          7
1920          (format "%s called with bad ID, type, classification, or spam-backend"
1921                  "spam-log-unregistration-needed-p"))
1922         nil))))
1923
1924
1925 ;;; undo a ham- or spam-processor registration (the group is not used)
1926 (defun spam-log-undo-registration (id type classification backend &optional group)
1927   (when (and spam-log-to-registry
1928              (spam-log-unregistration-needed-p id type classification backend))
1929     (if (and (stringp id)
1930              (spam-process-type-valid-p type)
1931              (spam-classification-valid-p classification)
1932              (spam-backend-valid-p backend))
1933         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1934               new-cell-list found)
1935           (dolist (cell cell-list)
1936             (unless (and (eq classification (nth 0 cell))
1937                          (eq backend (nth 1 cell)))
1938               (push cell new-cell-list)))
1939           (gnus-registry-store-extra-entry
1940            id
1941            type
1942            new-cell-list))
1943       (progn
1944         (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group"
1945                               "spam-log-undo-registration"))
1946         nil))))
1947
1948 ;;}}}
1949
1950 ;;{{{ backend functions
1951
1952 ;;{{{ Gmane xrefs
1953 (defun spam-check-gmane-xref ()
1954   (let ((header (or
1955                  (message-fetch-field "Xref")
1956                  (message-fetch-field "Newsgroups"))))
1957     (when header                        ; return nil when no header
1958       (when (string-match spam-gmane-xref-spam-group
1959                           header)
1960           spam-split-group))))
1961
1962 ;;}}}
1963
1964 ;;{{{ Regex body
1965
1966 (defun spam-check-regex-body ()
1967   (let ((spam-regex-headers-ham spam-regex-body-ham)
1968         (spam-regex-headers-spam spam-regex-body-spam))
1969     (spam-check-regex-headers t)))
1970
1971 ;;}}}
1972
1973 ;;{{{ Regex headers
1974
1975 (defun spam-check-regex-headers (&optional body)
1976   (let ((type (if body "body" "header"))
1977         ret found)
1978     (dolist (h-regex spam-regex-headers-ham)
1979       (unless found
1980         (goto-char (point-min))
1981         (when (re-search-forward h-regex nil t)
1982           (message "Ham regex %s search positive." type)
1983           (setq found t))))
1984     (dolist (s-regex spam-regex-headers-spam)
1985       (unless found
1986         (goto-char (point-min))
1987         (when (re-search-forward s-regex nil t)
1988           (message "Spam regex %s search positive." type)
1989           (setq found t)
1990           (setq ret spam-split-group))))
1991     ret))
1992
1993 ;;}}}
1994
1995 ;;{{{ Blackholes.
1996
1997 (defun spam-reverse-ip-string (ip)
1998   (when (stringp ip)
1999     (mapconcat 'identity
2000                (nreverse (split-string ip "\\."))
2001                ".")))
2002
2003 (defun spam-check-blackholes ()
2004   "Check the Received headers for blackholed relays."
2005   (let ((headers (message-fetch-field "received"))
2006         ips matches)
2007     (when headers
2008       (with-temp-buffer
2009         (insert headers)
2010         (goto-char (point-min))
2011         (gnus-message 6 "Checking headers for relay addresses")
2012         (while (re-search-forward
2013                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
2014           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
2015           (push (spam-reverse-ip-string (match-string 1))
2016                 ips)))
2017       (dolist (server spam-blackhole-servers)
2018         (dolist (ip ips)
2019           (unless (and spam-blackhole-good-server-regex
2020                        ;; match the good-server-regex against the reversed (again) IP string
2021                        (string-match
2022                         spam-blackhole-good-server-regex
2023                         (spam-reverse-ip-string ip)))
2024             (unless matches
2025               (let ((query-string (concat ip "." server)))
2026                 (if spam-use-dig
2027                     (let ((query-result (query-dig query-string)))
2028                       (when query-result
2029                         (gnus-message 6 "(DIG): positive blackhole check '%s'"
2030                                       query-result)
2031                         (push (list ip server query-result)
2032                               matches)))
2033                   ;; else, if not using dig.el
2034                   (when (query-dns query-string)
2035                     (gnus-message 6 "positive blackhole check")
2036                     (push (list ip server (query-dns query-string 'TXT))
2037                           matches)))))))))
2038     (when matches
2039       spam-split-group)))
2040 ;;}}}
2041
2042 ;;{{{ Hashcash.
2043
2044 (defun spam-check-hashcash ()
2045   "Check the headers for hashcash payments."
2046   (ignore-errors (mail-check-payment)))  ;mail-check-payment returns a boolean
2047
2048 ;;}}}
2049
2050 ;;{{{ BBDB
2051
2052 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
2053 ;;; <sacha@giotto.sj.ru>
2054
2055 ;; all this is done inside a condition-case to trap errors
2056
2057 (eval-when-compile
2058   (autoload 'bbdb-buffer "bbdb")
2059   (autoload 'bbdb-create-internal "bbdb")
2060   (autoload 'bbdb-search-simple "bbdb"))
2061
2062 (eval-and-compile
2063   (when (condition-case nil
2064             (progn
2065               (require 'bbdb)
2066               (require 'bbdb-com))
2067           (file-error
2068            ;; `bbdb-records' should not be bound as an autoload function
2069            ;; before loading bbdb because of `bbdb-hashtable-size'.
2070            (defalias 'bbdb-records 'ignore)
2071            (defalias 'spam-BBDB-register-routine 'ignore)
2072            (defalias 'spam-enter-ham-BBDB 'ignore)
2073            nil))
2074
2075     ;; when the BBDB changes, we want to clear out our cache
2076     (defun spam-clear-cache-BBDB (&rest immaterial)
2077       (spam-clear-cache 'spam-use-BBDB))
2078
2079     (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2080
2081     (defun spam-enter-ham-BBDB (addresses &optional remove)
2082       "Enter an address into the BBDB; implies ham (non-spam) sender"
2083       (dolist (from addresses)
2084         (when (stringp from)
2085           (let* ((parsed-address (gnus-extract-address-components from))
2086                  (name (or (nth 0 parsed-address) "Ham Sender"))
2087                  (remove-function (if remove
2088                                       'bbdb-delete-record-internal
2089                                     'ignore))
2090                  (net-address (nth 1 parsed-address))
2091                  (record (and net-address
2092                               (bbdb-search-simple nil net-address))))
2093             (when net-address
2094               (gnus-message 6 "%s address %s %s BBDB"
2095                             (if remove "Deleting" "Adding")
2096                             from
2097                             (if remove "from" "to"))
2098               (if record
2099                   (funcall remove-function record)
2100                 (bbdb-create-internal name nil net-address nil nil
2101                                       "ham sender added by spam.el")))))))
2102
2103     (defun spam-BBDB-register-routine (articles &optional unregister)
2104       (let (addresses)
2105         (dolist (article articles)
2106           (when (stringp (spam-fetch-field-from-fast article))
2107             (push (spam-fetch-field-from-fast article) addresses)))
2108         ;; now do the register/unregister action
2109         (spam-enter-ham-BBDB addresses unregister)))
2110
2111     (defun spam-BBDB-unregister-routine (articles)
2112       (spam-BBDB-register-routine articles t))
2113
2114     (defun spam-check-BBDB ()
2115       "Mail from people in the BBDB is classified as ham or non-spam"
2116       (let ((who (message-fetch-field "from"))
2117             bbdb-cache bbdb-hashtable)
2118         (when spam-cache-lookups
2119           (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2120           (unless bbdb-cache
2121             (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value
2122             ;; this is based on the expanded (bbdb-hashtable) macro
2123             ;; without the debugging support
2124             (with-current-buffer (bbdb-buffer)
2125               (save-excursion
2126                 (save-window-excursion
2127                   (bbdb-records nil t)
2128                   (mapatoms
2129                    (lambda (symbol)
2130                      (intern (downcase (symbol-name symbol)) bbdb-cache))
2131                    bbdb-hashtable))))
2132             (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2133         (when who
2134           (setq who (nth 1 (gnus-extract-address-components who)))
2135           (if
2136               (if spam-cache-lookups
2137                   (intern-soft (downcase who) bbdb-cache)
2138                 (bbdb-search-simple nil who))
2139               t
2140             (if spam-use-BBDB-exclusive
2141                 spam-split-group
2142               nil)))))))
2143
2144 ;;}}}
2145
2146 ;;{{{ ifile
2147
2148 ;;; check the ifile backend; return nil if the mail was NOT classified
2149 ;;; as spam
2150
2151 (defun spam-get-ifile-database-parameter ()
2152   "Get the command-line parameter for ifile's database from
2153   spam-ifile-database-path."
2154   (if spam-ifile-database-path
2155       (format "--db-file=%s" spam-ifile-database-path)
2156     nil))
2157
2158 (defun spam-check-ifile ()
2159   "Check the ifile backend for the classification of this message."
2160   (let ((article-buffer-name (buffer-name))
2161         category return)
2162     (with-temp-buffer
2163       (let ((temp-buffer-name (buffer-name))
2164             (db-param (spam-get-ifile-database-parameter)))
2165         (save-excursion
2166           (set-buffer article-buffer-name)
2167           (apply 'call-process-region
2168                  (point-min) (point-max) spam-ifile-path
2169                  nil temp-buffer-name nil "-c"
2170                  (if db-param `(,db-param "-q") `("-q"))))
2171         ;; check the return now (we're back in the temp buffer)
2172         (goto-char (point-min))
2173         (if (not (eobp))
2174             (setq category (buffer-substring (point) (point-at-eol))))
2175         (when (not (zerop (length category))) ; we need a category here
2176           (if spam-ifile-all-categories
2177               (setq return category)
2178             ;; else, if spam-ifile-all-categories is not set...
2179             (when (string-equal spam-ifile-spam-category category)
2180               (setq return spam-split-group)))))) ; note return is nil otherwise
2181     return))
2182
2183 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2184   "Register an article, given as a string, with a category.
2185 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2186   (let ((category (or category gnus-newsgroup-name))
2187         (add-or-delete-option (if unregister "-d" "-i"))
2188         (db (spam-get-ifile-database-parameter))
2189         parameters)
2190     (with-temp-buffer
2191       (dolist (article articles)
2192         (let ((article-string (spam-get-article-as-string article)))
2193           (when (stringp article-string)
2194             (insert article-string))))
2195       (apply 'call-process-region
2196              (point-min) (point-max) spam-ifile-path
2197              nil nil nil
2198              add-or-delete-option category
2199              (if db `(,db "-h") `("-h"))))))
2200
2201 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2202   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2203
2204 (defun spam-ifile-unregister-spam-routine (articles)
2205   (spam-ifile-register-spam-routine articles t))
2206
2207 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2208   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2209
2210 (defun spam-ifile-unregister-ham-routine (articles)
2211   (spam-ifile-register-ham-routine articles t))
2212
2213 ;;}}}
2214
2215 ;;{{{ spam-stat
2216
2217 (eval-when-compile
2218   (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
2219   (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
2220   (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
2221   (autoload 'spam-stat-buffer-is-spam "spam-stat")
2222   (autoload 'spam-stat-load "spam-stat")
2223   (autoload 'spam-stat-save "spam-stat")
2224   (autoload 'spam-stat-split-fancy "spam-stat"))
2225
2226 (eval-and-compile
2227   (when (condition-case nil
2228             (let ((spam-stat-install-hooks nil))
2229               (require 'spam-stat))
2230           (file-error
2231            (defalias 'spam-stat-register-ham-routine 'ignore)
2232            (defalias 'spam-stat-register-spam-routine 'ignore)
2233            nil))
2234
2235     (defun spam-check-stat ()
2236       "Check the spam-stat backend for the classification of this message"
2237       (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2238             (spam-stat-buffer (buffer-name)) ; stat the current buffer
2239             category return)
2240         (spam-stat-split-fancy)))
2241
2242     (defun spam-stat-register-spam-routine (articles &optional unregister)
2243       (dolist (article articles)
2244         (let ((article-string (spam-get-article-as-string article)))
2245           (with-temp-buffer
2246             (insert article-string)
2247             (if unregister
2248                 (spam-stat-buffer-change-to-non-spam)
2249               (spam-stat-buffer-is-spam))))))
2250
2251     (defun spam-stat-unregister-spam-routine (articles)
2252       (spam-stat-register-spam-routine articles t))
2253
2254     (defun spam-stat-register-ham-routine (articles &optional unregister)
2255       (dolist (article articles)
2256         (let ((article-string (spam-get-article-as-string article)))
2257           (with-temp-buffer
2258             (insert article-string)
2259             (if unregister
2260                 (spam-stat-buffer-change-to-spam)
2261               (spam-stat-buffer-is-non-spam))))))
2262
2263     (defun spam-stat-unregister-ham-routine (articles)
2264       (spam-stat-register-ham-routine articles t))
2265
2266     (defun spam-maybe-spam-stat-load ()
2267       (when spam-use-stat (spam-stat-load)))
2268
2269     (defun spam-maybe-spam-stat-save ()
2270       (when spam-use-stat (spam-stat-save)))))
2271
2272 ;;}}}
2273
2274 ;;{{{ Blacklists and whitelists.
2275
2276 (defvar spam-whitelist-cache nil)
2277 (defvar spam-blacklist-cache nil)
2278
2279 (defun spam-kill-whole-line ()
2280   (beginning-of-line)
2281   (let ((kill-whole-line t))
2282     (kill-line)))
2283
2284 ;;; address can be a list, too
2285 (defun spam-enter-whitelist (address &optional remove)
2286   "Enter ADDRESS (list or single) into the whitelist.
2287 With a non-nil REMOVE, remove them."
2288   (interactive "sAddress: ")
2289   (spam-enter-list address spam-whitelist remove)
2290   (setq spam-whitelist-cache nil)
2291   (spam-clear-cache 'spam-use-whitelist))
2292
2293 ;;; address can be a list, too
2294 (defun spam-enter-blacklist (address &optional remove)
2295   "Enter ADDRESS (list or single) into the blacklist.
2296 With a non-nil REMOVE, remove them."
2297   (interactive "sAddress: ")
2298   (spam-enter-list address spam-blacklist remove)
2299   (setq spam-blacklist-cache nil)
2300   (spam-clear-cache 'spam-use-whitelist))
2301
2302 (defun spam-enter-list (addresses file &optional remove)
2303   "Enter ADDRESSES into the given FILE.
2304 Either the whitelist or the blacklist files can be used.  With
2305 REMOVE not nil, remove the ADDRESSES."
2306   (if (stringp addresses)
2307       (spam-enter-list (list addresses) file remove)
2308     ;; else, we have a list of addresses here
2309     (unless (file-exists-p (file-name-directory file))
2310       (make-directory (file-name-directory file) t))
2311     (save-excursion
2312       (set-buffer
2313        (find-file-noselect file))
2314       (dolist (a addresses)
2315         (when (stringp a)
2316           (goto-char (point-min))
2317           (if (re-search-forward (regexp-quote a) nil t)
2318               ;; found the address
2319               (when remove
2320                 (spam-kill-whole-line))
2321             ;; else, the address was not found
2322             (unless remove
2323               (goto-char (point-max))
2324               (unless (bobp)
2325                 (insert "\n"))
2326               (insert a "\n")))))
2327       (save-buffer))))
2328
2329 (defun spam-filelist-build-cache (type)
2330   (let ((cache (if (eq type 'spam-use-blacklist)
2331                    spam-blacklist-cache
2332                  spam-whitelist-cache))
2333         parsed-cache)
2334     (unless (gethash type spam-caches)
2335       (while cache
2336         (let ((address (pop cache)))
2337           (unless (zerop (length address)) ; 0 for a nil address too
2338             (setq address (regexp-quote address))
2339             ;; fix regexp-quote's treatment of user-intended regexes
2340             (while (string-match "\\\\\\*" address)
2341               (setq address (replace-match ".*" t t address))))
2342           (push address parsed-cache)))
2343       (puthash type parsed-cache spam-caches))))
2344
2345 (defun spam-filelist-check-cache (type from)
2346   (when (stringp from)
2347     (spam-filelist-build-cache type)
2348     (let (found)
2349       (dolist (address (gethash type spam-caches))
2350         (when (and address (string-match address from))
2351           (setq found t)
2352           (return)))
2353       found)))
2354
2355 ;;; returns t if the sender is in the whitelist, nil or
2356 ;;; spam-split-group otherwise
2357 (defun spam-check-whitelist ()
2358   ;; FIXME!  Should it detect when file timestamps change?
2359   (unless spam-whitelist-cache
2360     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2361   (if (spam-from-listed-p 'spam-use-whitelist)
2362       t
2363     (if spam-use-whitelist-exclusive
2364         spam-split-group
2365       nil)))
2366
2367 (defun spam-check-blacklist ()
2368   ;; FIXME!  Should it detect when file timestamps change?
2369   (unless spam-blacklist-cache
2370     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2371   (and (spam-from-listed-p 'spam-use-blacklist)
2372        spam-split-group))
2373
2374 (defun spam-parse-list (file)
2375   (when (file-readable-p file)
2376     (let (contents address)
2377       (with-temp-buffer
2378         (insert-file-contents file)
2379         (while (not (eobp))
2380           (setq address (buffer-substring (point) (point-at-eol)))
2381           (forward-line 1)
2382           ;; insert the e-mail address if detected, otherwise the raw data
2383           (unless (zerop (length address))
2384             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2385               (push (or pure-address address) contents)))))
2386       (nreverse contents))))
2387
2388 (defun spam-from-listed-p (type)
2389   (let ((from (message-fetch-field "from"))
2390         found)
2391     (spam-filelist-check-cache type from)))
2392
2393 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2394   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2395         (declassification (if blacklist 'ham 'spam))
2396         (enter-function
2397          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2398         (remove-function
2399          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2400         from addresses unregister-list article-unregister-list)
2401     (dolist (article articles)
2402       (let ((from (spam-fetch-field-from-fast article))
2403             (id (spam-fetch-field-message-id-fast article))
2404             sender-ignored)
2405         (when (stringp from)
2406           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2407             (when (and (not sender-ignored)
2408                        (stringp ignore-regex)
2409                        (string-match ignore-regex from))
2410               (setq sender-ignored t)))
2411           ;; remember the messages we need to unregister, unless remove is set
2412           (when (and
2413                  (null unregister)
2414                  (spam-log-unregistration-needed-p
2415                   id 'process declassification de-symbol))
2416             (push article article-unregister-list)
2417             (push from unregister-list))
2418           (unless sender-ignored
2419             (push from addresses)))))
2420
2421     (if unregister
2422         (funcall enter-function addresses t) ; unregister all these addresses
2423       ;; else, register normally and unregister what we need to
2424       (funcall remove-function unregister-list t)
2425       (dolist (article article-unregister-list)
2426         (spam-log-undo-registration
2427          (spam-fetch-field-message-id-fast article)
2428          'process
2429          declassification
2430          de-symbol))
2431       (funcall enter-function addresses nil))))
2432
2433 (defun spam-blacklist-unregister-routine (articles)
2434   (spam-blacklist-register-routine articles t))
2435
2436 (defun spam-blacklist-register-routine (articles &optional unregister)
2437   (spam-filelist-register-routine articles t unregister))
2438
2439 (defun spam-whitelist-unregister-routine (articles)
2440   (spam-whitelist-register-routine articles t))
2441
2442 (defun spam-whitelist-register-routine (articles &optional unregister)
2443   (spam-filelist-register-routine articles nil unregister))
2444
2445 ;;}}}
2446
2447 ;;{{{ Spam-report glue (gmane and resend reporting)
2448 (defun spam-report-gmane-register-routine (articles)
2449   (when articles
2450     (apply 'spam-report-gmane-spam articles)))
2451
2452 (defun spam-report-gmane-unregister-routine (articles)
2453   (when articles
2454     (apply 'spam-report-gmane-ham articles)))
2455
2456 (defun spam-report-resend-register-ham-routine (articles)
2457   (spam-report-resend-register-routine articles t))
2458
2459 (defun spam-report-resend-register-routine (articles &optional ham)
2460   (let* ((resend-to-gp
2461           (if ham
2462               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2463             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2464          (spam-report-resend-to (or (car-safe resend-to-gp)
2465                                     spam-report-resend-to)))
2466     (spam-report-resend articles ham)))
2467
2468 ;;}}}
2469
2470 ;;{{{ Bogofilter
2471 (defun spam-check-bogofilter-headers (&optional score)
2472   (let ((header (message-fetch-field spam-bogofilter-header)))
2473     (when header                        ; return nil when no header
2474       (if score                         ; scoring mode
2475           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2476               (match-string 1 header)
2477             "0")
2478         ;; spam detection mode
2479         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2480                             header)
2481           spam-split-group)))))
2482
2483 ;; return something sensible if the score can't be determined
2484 (defun spam-bogofilter-score (&optional recheck)
2485   "Get the Bogofilter spamicity score"
2486   (interactive "P")
2487   (save-window-excursion
2488     (gnus-summary-show-article t)
2489     (set-buffer gnus-article-buffer)
2490     (let ((score (or (unless recheck
2491                        (spam-check-bogofilter-headers t))
2492                      (spam-check-bogofilter t))))
2493       (gnus-summary-show-article)
2494       (message "Spamicity score %s" score)
2495       (or score "0"))))
2496
2497 (defun spam-verify-bogofilter ()
2498   "Verify the Bogofilter version is sufficient."
2499   (when (eq spam-bogofilter-valid 'unknown)
2500     (setq spam-bogofilter-valid
2501           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2502                              (shell-command-to-string
2503                               (format "%s -V" spam-bogofilter-path))))))
2504   spam-bogofilter-valid)
2505
2506 (defun spam-check-bogofilter (&optional score)
2507   "Check the Bogofilter backend for the classification of this message."
2508   (if (spam-verify-bogofilter)
2509       (let ((article-buffer-name (buffer-name))
2510             (db spam-bogofilter-database-directory)
2511             return)
2512         (with-temp-buffer
2513           (let ((temp-buffer-name (buffer-name)))
2514             (save-excursion
2515               (set-buffer article-buffer-name)
2516               (apply 'call-process-region
2517                      (point-min) (point-max)
2518                      spam-bogofilter-path
2519                      nil temp-buffer-name nil
2520                      (if db `("-d" ,db "-v") `("-v"))))
2521             (setq return (spam-check-bogofilter-headers score))))
2522         return)
2523     (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
2524
2525 (defun spam-bogofilter-register-with-bogofilter (articles
2526                                                  spam
2527                                                  &optional unregister)
2528   "Register an article, given as a string, as spam or non-spam."
2529   (if (spam-verify-bogofilter)
2530       (dolist (article articles)
2531         (let ((article-string (spam-get-article-as-string article))
2532               (db spam-bogofilter-database-directory)
2533               (switch (if unregister
2534                           (if spam
2535                               spam-bogofilter-spam-strong-switch
2536                             spam-bogofilter-ham-strong-switch)
2537                         (if spam
2538                             spam-bogofilter-spam-switch
2539                           spam-bogofilter-ham-switch))))
2540           (when (stringp article-string)
2541             (with-temp-buffer
2542               (insert article-string)
2543
2544               (apply 'call-process-region
2545                      (point-min) (point-max)
2546                      spam-bogofilter-path
2547                      nil nil nil switch
2548                      (if db `("-d" ,db "-v") `("-v")))))))
2549     (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
2550
2551 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2552   (spam-bogofilter-register-with-bogofilter articles t unregister))
2553
2554 (defun spam-bogofilter-unregister-spam-routine (articles)
2555   (spam-bogofilter-register-spam-routine articles t))
2556
2557 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2558   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2559
2560 (defun spam-bogofilter-unregister-ham-routine (articles)
2561   (spam-bogofilter-register-ham-routine articles t))
2562
2563
2564 ;;}}}
2565
2566 ;;{{{ spamoracle
2567 (defun spam-check-spamoracle ()
2568   "Run spamoracle on an article to determine whether it's spam."
2569   (let ((article-buffer-name (buffer-name)))
2570     (with-temp-buffer
2571       (let ((temp-buffer-name (buffer-name)))
2572         (save-excursion
2573           (set-buffer article-buffer-name)
2574           (let ((status
2575                  (apply 'call-process-region
2576                         (point-min) (point-max)
2577                         spam-spamoracle-binary
2578                         nil temp-buffer-name nil
2579                         (if spam-spamoracle-database
2580                             `("-f" ,spam-spamoracle-database "mark")
2581                           '("mark")))))
2582             (if (eq 0 status)
2583                 (progn
2584                   (set-buffer temp-buffer-name)
2585                   (goto-char (point-min))
2586                   (when (re-search-forward "^X-Spam: yes;" nil t)
2587                     spam-split-group))
2588               (error "Error running spamoracle: %s" status))))))))
2589
2590 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2591   "Run spamoracle in training mode."
2592   (with-temp-buffer
2593     (let ((temp-buffer-name (buffer-name)))
2594       (save-excursion
2595         (goto-char (point-min))
2596         (dolist (article articles)
2597           (insert (spam-get-article-as-string article)))
2598         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2599                         "-spam"
2600                       "-good"))
2601                (status
2602                 (apply 'call-process-region
2603                        (point-min) (point-max)
2604                        spam-spamoracle-binary
2605                        nil temp-buffer-name nil
2606                        (if spam-spamoracle-database
2607                            `("-f" ,spam-spamoracle-database
2608                              "add" ,arg)
2609                          `("add" ,arg)))))
2610           (unless (eq 0 status)
2611             (error "Error running spamoracle: %s" status)))))))
2612
2613 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2614   (spam-spamoracle-learn articles nil unregister))
2615
2616 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2617   (spam-spamoracle-learn-ham articles t))
2618
2619 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2620   (spam-spamoracle-learn articles t unregister))
2621
2622 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2623   (spam-spamoracle-learn-spam articles t))
2624
2625 ;;}}}
2626
2627 ;;{{{ SpamAssassin
2628 ;;; based mostly on the bogofilter code
2629 (defun spam-check-spamassassin-headers (&optional score)
2630   "Check the SpamAssassin headers for the classification of this message."
2631   (if score                             ; scoring mode
2632       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2633         (when header
2634           (if (string-match spam-spamassassin-score-regexp header)
2635               (match-string 1 header)
2636             "0")))
2637     ;; spam detection mode
2638     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2639           (when header                  ; return nil when no header
2640             (when (string-match spam-spamassassin-positive-spam-flag-header
2641                                 header)
2642               spam-split-group)))))
2643
2644 (defun spam-check-spamassassin (&optional score)
2645   "Check the SpamAssassin backend for the classification of this message."
2646   (let ((article-buffer-name (buffer-name)))
2647     (with-temp-buffer
2648       (let ((temp-buffer-name (buffer-name)))
2649         (save-excursion
2650           (set-buffer article-buffer-name)
2651           (apply 'call-process-region
2652                  (point-min) (point-max) spam-spamassassin-path
2653                  nil temp-buffer-name nil spam-spamassassin-arguments))
2654         ;; check the return now (we're back in the temp buffer)
2655         (goto-char (point-min))
2656         (spam-check-spamassassin-headers score)))))
2657
2658 ;; return something sensible if the score can't be determined
2659 (defun spam-spamassassin-score (&optional recheck)
2660   "Get the SpamAssassin score"
2661   (interactive "P")
2662   (save-window-excursion
2663     (gnus-summary-show-article t)
2664     (set-buffer gnus-article-buffer)
2665     (let ((score (or (unless recheck
2666                        (spam-check-spamassassin-headers t))
2667                      (spam-check-spamassassin t))))
2668       (gnus-summary-show-article)
2669       (message "SpamAssassin score %s" score)
2670       (or score "0"))))
2671
2672 (defun spam-spamassassin-register-with-sa-learn (articles spam
2673                                                  &optional unregister)
2674   "Register articles with spamassassin's sa-learn as spam or non-spam."
2675   (if articles
2676       (let ((action (if unregister spam-sa-learn-unregister-switch
2677                       (if spam spam-sa-learn-spam-switch
2678                         spam-sa-learn-ham-switch)))
2679             (summary-buffer-name (buffer-name)))
2680         (with-temp-buffer
2681           ;; group the articles into mbox format
2682           (dolist (article articles)
2683             (let (article-string)
2684               (save-excursion
2685                 (set-buffer summary-buffer-name)
2686                 (setq article-string (spam-get-article-as-string article)))
2687               (when (stringp article-string)
2688                 (insert "From \n") ; mbox separator (sa-learn only checks the
2689                                    ; first five chars, so we can get away with
2690                                    ; a bogus line))
2691                 (insert article-string)
2692                 (insert "\n"))))
2693           ;; call sa-learn on all messages at the same time
2694           (apply 'call-process-region
2695                  (point-min) (point-max)
2696                  spam-sa-learn-path
2697                  nil nil nil "--mbox"
2698                  (if spam-sa-learn-rebuild
2699                      (list action)
2700                    `("--no-rebuild" ,action)))))))
2701
2702 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2703   (spam-spamassassin-register-with-sa-learn articles t unregister))
2704
2705 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2706   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2707
2708 (defun spam-spamassassin-unregister-spam-routine (articles)
2709   (spam-spamassassin-register-with-sa-learn articles t t))
2710
2711 (defun spam-spamassassin-unregister-ham-routine (articles)
2712   (spam-spamassassin-register-with-sa-learn articles nil t))
2713
2714 ;;}}}
2715
2716 ;;{{{ Bsfilter
2717 ;;; based mostly on the bogofilter code
2718 (defun spam-check-bsfilter-headers (&optional score)
2719   (if score
2720       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2721           "0")
2722     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2723       (when header ; return nil when no header
2724         (when (string-match "YES" header)
2725           spam-split-group)))))
2726
2727 ;; return something sensible if the score can't be determined
2728 (defun spam-bsfilter-score (&optional recheck)
2729   "Get the Bsfilter spamicity score"
2730   (interactive "P")
2731   (save-window-excursion
2732     (gnus-summary-show-article t)
2733     (set-buffer gnus-article-buffer)
2734     (let ((score (or (unless recheck
2735                        (spam-check-bsfilter-headers t))
2736                      (spam-check-bsfilter t))))
2737       (gnus-summary-show-article)
2738       (message "Spamicity score %s" score)
2739       (or score "0"))))
2740
2741 (defun spam-check-bsfilter (&optional score)
2742   "Check the Bsfilter backend for the classification of this message"
2743   (let ((article-buffer-name (buffer-name))
2744         (dir spam-bsfilter-database-directory)
2745         return)
2746     (with-temp-buffer
2747       (let ((temp-buffer-name (buffer-name)))
2748         (save-excursion
2749           (set-buffer article-buffer-name)
2750           (apply 'call-process-region
2751                  (point-min) (point-max)
2752                  spam-bsfilter-path
2753                  nil temp-buffer-name nil
2754                  "--pipe"
2755                  "--insert-flag"
2756                  "--insert-probability"
2757                  (when dir
2758                    (list "--homedir" dir))))
2759         (setq return (spam-check-bsfilter-headers score))))
2760     return))
2761
2762 (defun spam-bsfilter-register-with-bsfilter (articles
2763                                              spam
2764                                              &optional unregister)
2765   "Register an article, given as a string, as spam or non-spam."
2766   (dolist (article articles)
2767     (let ((article-string (spam-get-article-as-string article))
2768           (switch (if unregister
2769                       (if spam
2770                           spam-bsfilter-spam-strong-switch
2771                         spam-bsfilter-ham-strong-switch)
2772                     (if spam
2773                         spam-bsfilter-spam-switch
2774                       spam-bsfilter-ham-switch))))
2775       (when (stringp article-string)
2776         (with-temp-buffer
2777           (insert article-string)
2778           (apply 'call-process-region
2779                  (point-min) (point-max)
2780                  spam-bsfilter-path
2781                  nil nil nil switch
2782                  "--update"
2783                  (when spam-bsfilter-database-directory
2784                    (list "--homedir"
2785                          spam-bsfilter-database-directory))))))))
2786
2787 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2788   (spam-bsfilter-register-with-bsfilter articles t unregister))
2789
2790 (defun spam-bsfilter-unregister-spam-routine (articles)
2791   (spam-bsfilter-register-spam-routine articles t))
2792
2793 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2794   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2795
2796 (defun spam-bsfilter-unregister-ham-routine (articles)
2797   (spam-bsfilter-register-ham-routine articles t))
2798
2799 ;;}}}
2800
2801 ;;{{{ CRM114 Mailfilter
2802 (defun spam-check-crm114-headers (&optional score)
2803   (let ((header (message-fetch-field spam-crm114-header)))
2804     (when header                        ; return nil when no header
2805       (if score                         ; scoring mode
2806           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2807               (match-string 1 header)
2808             "0")
2809         ;; spam detection mode
2810         (when (string-match spam-crm114-positive-spam-header
2811                             header)
2812           spam-split-group)))))
2813
2814 ;; return something sensible if the score can't be determined
2815 (defun spam-crm114-score ()
2816   "Get the CRM114 Mailfilter pR"
2817   (interactive)
2818   (save-window-excursion
2819     (gnus-summary-show-article t)
2820     (set-buffer gnus-article-buffer)
2821     (let ((score (or (spam-check-crm114-headers t)
2822                      (spam-check-crm114 t))))
2823       (gnus-summary-show-article)
2824       (message "pR: %s" score)
2825       (or score "0"))))
2826
2827 (defun spam-check-crm114 (&optional score)
2828   "Check the CRM114 Mailfilter backend for the classification of this message"
2829   (let ((article-buffer-name (buffer-name))
2830         (db spam-crm114-database-directory)
2831         return)
2832     (with-temp-buffer
2833       (let ((temp-buffer-name (buffer-name)))
2834         (save-excursion
2835           (set-buffer article-buffer-name)
2836           (apply 'call-process-region
2837                  (point-min) (point-max)
2838                  spam-crm114-program
2839                  nil temp-buffer-name nil
2840                  (when db (list (concat "--fileprefix=" db)))))
2841         (setq return (spam-check-crm114-headers score))))
2842     return))
2843
2844 (defun spam-crm114-register-with-crm114 (articles
2845                                          spam
2846                                          &optional unregister)
2847   "Register an article, given as a string, as spam or non-spam."
2848   (dolist (article articles)
2849     (let ((article-string (spam-get-article-as-string article))
2850           (db spam-crm114-database-directory)
2851           (switch (if unregister
2852                       (if spam
2853                           spam-crm114-spam-strong-switch
2854                         spam-crm114-ham-strong-switch)
2855                     (if spam
2856                         spam-crm114-spam-switch
2857                       spam-crm114-ham-switch))))
2858       (when (stringp article-string)
2859         (with-temp-buffer
2860           (insert article-string)
2861
2862           (apply 'call-process-region
2863                  (point-min) (point-max)
2864                  spam-crm114-program
2865                  nil nil nil
2866                  (when db (list switch (concat "--fileprefix=" db)))))))))
2867
2868 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2869   (spam-crm114-register-with-crm114 articles t unregister))
2870
2871 (defun spam-crm114-unregister-spam-routine (articles)
2872   (spam-crm114-register-spam-routine articles t))
2873
2874 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2875   (spam-crm114-register-with-crm114 articles nil unregister))
2876
2877 (defun spam-crm114-unregister-ham-routine (articles)
2878   (spam-crm114-register-ham-routine articles t))
2879
2880 ;;}}}
2881
2882 ;;}}}
2883
2884 ;;{{{ Hooks
2885
2886 ;;;###autoload
2887 (defun spam-initialize (&rest symbols)
2888   "Install the spam.el hooks and do other initialization.
2889 When SYMBOLS is given, set those variables to t.  This is so you
2890 can call spam-initialize before you set spam-use-* variables on
2891 explicitly, and matters only if you need the extra headers
2892 installed through spam-necessary-extra-headers."
2893   (interactive)
2894
2895   (dolist (var symbols)
2896     (set var t))
2897
2898   (dolist (header (spam-necessary-extra-headers))
2899     (add-to-list 'nnmail-extra-headers header)
2900     (add-to-list 'gnus-extra-headers header))
2901
2902   (setq spam-install-hooks t)
2903   ;; TODO: How do we redo this every time the `spam' face is customized?
2904   (push '((eq mark gnus-spam-mark) . spam)
2905         gnus-summary-highlight)
2906   ;; Add hooks for loading and saving the spam stats
2907   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2908   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2909   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2910   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2911   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2912   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2913   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2914
2915 (defun spam-unload-hook ()
2916   "Uninstall the spam.el hooks"
2917   (interactive)
2918   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2919   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2920   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2921   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2922   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2923   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2924   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2925
2926 (add-hook 'spam-unload-hook 'spam-unload-hook)
2927
2928 (when spam-install-hooks
2929   (spam-initialize))
2930 ;;}}}
2931
2932 (provide 'spam)
2933
2934 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2935 ;;; spam.el ends here