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