lisp/gnus/spam.el

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