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

   1 ;;; spam.el --- Identifying spam
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
   7 ;; Keywords: network, spam, mail, bogofilter, BBDB, dspam, dig, whitelist, blacklist, gmane, hashcash, spamassassin, bsfilter, ifile, stat, crm114, spamoracle
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; This module addresses a few aspects of spam control under Gnus.  Page
  29 ;;; breaks are used for grouping declarations and documentation relating to
  30 ;;; each particular aspect.
  31
  32 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
  33 ;;; comments, below, for supplementary explanations or discussions.
  34
  35 ;;; Several TODO items are marked as such
  36
  37 ;; TODO: cross-server splitting, remote processing, training through files
  38
  39 ;;; Code:
  40
  41 ;;{{{ compilation directives and autoloads/requires
  42
  43 (eval-when-compile (require 'cl))
  44 (eval-when-compile (require 'spam-report))
  45 (eval-when-compile (require 'hashcash))
  46
  47 (require 'gnus-sum)
  48
  49 (require 'gnus-uu)                      ; because of key prefix issues
  50 ;;; for the definitions of group content classification and spam processors
  51 (require 'gnus)
  52 (require 'message)              ;for the message-fetch-field functions
  53
  54 ;; for nnimap-split-download-body-default
  55 (eval-when-compile (require 'nnimap))
  56
  57 ;; autoload query-dig
  58 (eval-and-compile
  59   (autoload 'query-dig "dig"))
  60
  61 ;; autoload spam-report
  62 (eval-and-compile
  63   (autoload 'spam-report-gmane "spam-report")
  64   (autoload 'spam-report-gmane-spam "spam-report")
  65   (autoload 'spam-report-gmane-ham "spam-report")
  66   (autoload 'spam-report-resend "spam-report"))
  67
  68 ;; autoload gnus-registry
  69 (eval-and-compile
  70   (autoload 'gnus-registry-group-count "gnus-registry")
  71   (autoload 'gnus-registry-add-group "gnus-registry")
  72   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
  73   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
  74
  75 ;; autoload query-dns
  76 (eval-and-compile
  77   (autoload 'query-dns "dns"))
  78
  79 ;;}}}
  80
  81 ;;{{{ Main parameters.
  82 (defvar spam-backends nil
  83   "List of spam.el backends with all the pertinent data.
  84 Populated by spam-install-backend-super.")
  85
  86 (defgroup spam nil
  87   "Spam configuration."
  88   :version "22.1"
  89   :group 'mail
  90   :group 'news)
  91
  92 (defcustom spam-summary-exit-behavior 'default
  93   "Exit behavior at the time of summary exit.
  94 Note that setting the spam-use-move or spam-use-copy backends on
  95 a group through group/topic parameters overrides this mechanism."
  96   :type '(choice (const 'default :tag
  97                         "Move spam out of all groups.  Move ham out of spam groups.")
  98                  (const 'move-all :tag
  99                         "Move spam out of all groups.  Move ham out of all groups.")
 100                  (const 'move-none :tag
 101                         "Never move spam or ham out of any groups."))
 102   :group 'spam)
 103
 104 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
 105   "Directory for spam whitelists and blacklists."
 106   :type 'directory
 107   :group 'spam)
 108
 109 (defcustom spam-mark-new-messages-in-spam-group-as-spam t
 110   "Whether new messages in a spam group should get the spam-mark."
 111   :type 'boolean
 112   ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3
 113   :group 'spam)
 114
 115 (defcustom spam-log-to-registry nil
 116   "Whether spam/ham processing should be logged in the registry."
 117   :type 'boolean
 118   :group 'spam)
 119
 120 (defcustom spam-split-symbolic-return nil
 121   "Whether `spam-split' should work with symbols or group names."
 122   :type 'boolean
 123   :group 'spam)
 124
 125 (defcustom spam-split-symbolic-return-positive nil
 126   "Whether `spam-split' should ALWAYS work with symbols or group names.
 127 Do not set this if you use `spam-split' in a fancy split
 128   method."
 129   :type 'boolean
 130   :group 'spam)
 131
 132 (defcustom spam-mark-only-unseen-as-spam t
 133   "Whether only unseen articles should be marked as spam in spam groups.
 134 When nil, all unread articles in a spam group are marked as
 135 spam.  Set this if you want to leave an article unread in a spam group
 136 without losing it to the automatic spam-marking process."
 137   :type 'boolean
 138   :group 'spam)
 139
 140 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
 141   "Whether ham should be marked unread before it's moved.
 142 The article is moved out of a spam group according to ham-process-destination.
 143 This variable is an official entry in the international Longest Variable Name
 144 Competition."
 145   :type 'boolean
 146   :group 'spam)
 147
 148 (defcustom spam-disable-spam-split-during-ham-respool nil
 149   "Whether `spam-split' should be ignored while resplitting ham.
 150 This is useful to prevent ham from ending up in the same spam
 151 group after the resplit.  Don't set this to t if you have `spam-split' as the
 152 last rule in your split configuration."
 153   :type 'boolean
 154   :group 'spam)
 155
 156 (defcustom spam-autodetect-recheck-messages nil
 157   "Should spam.el recheck all meessages when autodetecting?
 158 Normally this is nil, so only unseen messages will be checked."
 159   :type 'boolean
 160   :group 'spam)
 161
 162 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
 163   "The location of the whitelist.
 164 The file format is one regular expression per line.
 165 The regular expression is matched against the address."
 166   :type 'file
 167   :group 'spam)
 168
 169 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
 170   "The location of the blacklist.
 171 The file format is one regular expression per line.
 172 The regular expression is matched against the address."
 173   :type 'file
 174   :group 'spam)
 175
 176 (defcustom spam-use-dig t
 177   "Whether `query-dig' should be used instead of `query-dns'."
 178   :type 'boolean
 179   :group 'spam)
 180
 181 (defcustom spam-use-gmane-xref nil
 182   "Whether the Gmane spam xref should be used by `spam-split'."
 183   :type 'boolean
 184   :group 'spam)
 185
 186 (defcustom spam-use-blacklist nil
 187   "Whether the blacklist should be used by `spam-split'."
 188   :type 'boolean
 189   :group 'spam)
 190
 191 (defcustom spam-blacklist-ignored-regexes nil
 192   "Regular expressions that the blacklist should ignore."
 193   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
 194   :group 'spam)
 195
 196 (defcustom spam-use-whitelist nil
 197   "Whether the whitelist should be used by `spam-split'."
 198   :type 'boolean
 199   :group 'spam)
 200
 201 (defcustom spam-use-whitelist-exclusive nil
 202   "Whether whitelist-exclusive should be used by `spam-split'.
 203 Exclusive whitelisting means that all messages from senders not in the whitelist
 204 are considered spam."
 205   :type 'boolean
 206   :group 'spam)
 207
 208 (defcustom spam-use-blackholes nil
 209   "Whether blackholes should be used by `spam-split'."
 210   :type 'boolean
 211   :group 'spam)
 212
 213 (defcustom spam-use-hashcash nil
 214   "Whether hashcash payments should be detected by `spam-split'."
 215   :type 'boolean
 216   :group 'spam)
 217
 218 (defcustom spam-use-regex-headers nil
 219   "Whether a header regular expression match should be used by `spam-split'.
 220 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
 221   :type 'boolean
 222   :group 'spam)
 223
 224 (defcustom spam-use-regex-body nil
 225   "Whether a body regular expression match should be used by `spam-split'.
 226 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
 227   :type 'boolean
 228   :group 'spam)
 229
 230 (defcustom spam-use-bogofilter-headers nil
 231   "Whether bogofilter headers should be used by `spam-split'.
 232 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 233   :type 'boolean
 234   :group 'spam)
 235
 236 (defcustom spam-use-bogofilter nil
 237   "Whether bogofilter should be invoked by `spam-split'.
 238 Enable this if you want Gnus to invoke Bogofilter on new messages."
 239   :type 'boolean
 240   :group 'spam)
 241
 242 (defcustom spam-use-bsfilter-headers nil
 243   "Whether bsfilter headers should be used by `spam-split'.
 244 Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
 245   :type 'boolean
 246   :group 'spam)
 247
 248 (defcustom spam-use-bsfilter nil
 249   "Whether bsfilter should be invoked by `spam-split'.
 250 Enable this if you want Gnus to invoke Bsfilter on new messages."
 251   :type 'boolean
 252   :group 'spam)
 253
 254 (defcustom spam-use-BBDB nil
 255   "Whether BBDB should be used by `spam-split'."
 256   :type 'boolean
 257   :group 'spam)
 258
 259 (defcustom spam-use-BBDB-exclusive nil
 260   "Whether BBDB-exclusive should be used by `spam-split'.
 261 Exclusive BBDB means that all messages from senders not in the BBDB are
 262 considered spam."
 263   :type 'boolean
 264   :group 'spam)
 265
 266 (defcustom spam-use-ifile nil
 267   "Whether ifile should be used by `spam-split'."
 268   :type 'boolean
 269   :group 'spam)
 270
 271 (defcustom spam-use-stat nil
 272   "Whether `spam-stat' should be used by `spam-split'."
 273   :type 'boolean
 274   :group 'spam)
 275
 276 (defcustom spam-use-spamoracle nil
 277   "Whether spamoracle should be used by `spam-split'."
 278   :type 'boolean
 279   :group 'spam)
 280
 281 (defcustom spam-use-spamassassin nil
 282   "Whether spamassassin should be invoked by `spam-split'.
 283 Enable this if you want Gnus to invoke SpamAssassin on new messages."
 284   :type 'boolean
 285   :group 'spam)
 286
 287 (defcustom spam-use-spamassassin-headers nil
 288   "Whether spamassassin headers should be checked by `spam-split'.
 289 Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
 290 them."
 291   :type 'boolean
 292   :group 'spam)
 293
 294 (defcustom spam-use-crm114 nil
 295   "Whether the CRM114 Mailfilter should be used by `spam-split'."
 296   :type 'boolean
 297   :group 'spam)
 298
 299 (defcustom spam-install-hooks (or
 300                                spam-use-dig
 301                                spam-use-gmane-xref
 302                                spam-use-blacklist
 303                                spam-use-whitelist
 304                                spam-use-whitelist-exclusive
 305                                spam-use-blackholes
 306                                spam-use-hashcash
 307                                spam-use-regex-headers
 308                                spam-use-regex-body
 309                                spam-use-bogofilter
 310                                spam-use-bogofilter-headers
 311                                spam-use-spamassassin
 312                                spam-use-spamassassin-headers
 313                                spam-use-bsfilter
 314                                spam-use-bsfilter-headers
 315                                spam-use-BBDB
 316                                spam-use-BBDB-exclusive
 317                                spam-use-ifile
 318                                spam-use-stat
 319                                spam-use-spamoracle
 320                                spam-use-crm114)
 321   "Whether the spam hooks should be installed.
 322 Default to t if one of the spam-use-* variables is set."
 323   :group 'spam
 324   :type 'boolean)
 325
 326 (defcustom spam-split-group "spam"
 327   "Group name where incoming spam should be put by `spam-split'."
 328   :type 'string
 329   :group 'spam)
 330
 331 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
 332 ;;; not regular expressions
 333 (defcustom spam-junk-mailgroups (cons
 334                                  spam-split-group
 335                                  '("mail.junk" "poste.pourriel"))
 336   "Mailgroups with spam contents.
 337 All unmarked article in such group receive the spam mark on group entry."
 338   :type '(repeat (string :tag "Group"))
 339   :group 'spam)
 340
 341
 342 (defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
 343   "The group where spam xrefs can be found on Gmane.
 344 Only meaningful if you enable `spam-use-gmane-xref'."
 345   :type 'string
 346   :group 'spam)
 347
 348 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 349                                     "dev.null.dk" "relays.visi.com")
 350   "List of blackhole servers.
 351 Only meaningful if you enable `spam-use-blackholes'."
 352   :type '(repeat (string :tag "Server"))
 353   :group 'spam)
 354
 355 (defcustom spam-blackhole-good-server-regex nil
 356   "String matching IP addresses that should not be checked in the blackholes.
 357 Only meaningful if you enable `spam-use-blackholes'."
 358   :type '(radio (const nil) regexp)
 359   :group 'spam)
 360
 361 (defface spam
 362   '((((class color) (type tty) (background dark))
 363      (:foreground "gray80" :background "gray50"))
 364     (((class color) (type tty) (background light))
 365      (:foreground "gray50" :background "gray80"))
 366     (((class color) (background dark))
 367      (:foreground "ivory2"))
 368     (((class color) (background light))
 369      (:foreground "ivory4"))
 370     (t :inverse-video t))
 371   "Face for spam-marked articles."
 372   :group 'spam)
 373 ;; backward-compatibility alias
 374 (put 'spam-face 'face-alias 'spam)
 375
 376 (defcustom spam-face 'spam
 377   "Face for spam-marked articles."
 378   :type 'face
 379   :group 'spam)
 380
 381 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 382   "Regular expression for positive header spam matches.
 383 Only meaningful if you enable `spam-use-regex-headers'."
 384   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 385   :group 'spam)
 386
 387 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 388   "Regular expression for positive header ham matches.
 389 Only meaningful if you enable `spam-use-regex-headers'."
 390   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 391   :group 'spam)
 392
 393 (defcustom spam-regex-body-spam '()
 394   "Regular expression for positive body spam matches.
 395 Only meaningful if you enable `spam-use-regex-body'."
 396   :type '(repeat (regexp :tag "Regular expression to match spam body"))
 397   :group 'spam)
 398
 399 (defcustom spam-regex-body-ham '()
 400   "Regular expression for positive body ham matches.
 401 Only meaningful if you enable `spam-use-regex-body'."
 402   :type '(repeat (regexp :tag "Regular expression to match ham body"))
 403   :group 'spam)
 404
 405 (defcustom spam-summary-score-preferred-header nil
 406   "Preferred header to use for spam-summary-score."
 407   :type '(choice :tag "Header name"
 408           (symbol :tag "SpamAssassin etc" X-Spam-Status)
 409           (symbol :tag "Bogofilter"       X-Bogosity)
 410           (const  :tag "No preference, take best guess." nil))
 411   :group 'spam)
 412
 413 (defgroup spam-ifile nil
 414   "Spam ifile configuration."
 415   :group 'spam)
 416
 417 (make-obsolete-variable 'spam-ifile-path 'spam-ifile-program)
 418 ;; "22.1" ;; Gnus 5.10.9
 419 (defcustom spam-ifile-program (executable-find "ifile")
 420   "Name of the ifile program."
 421   :type '(choice (file :tag "Location of ifile")
 422                  (const :tag "ifile is not installed"))
 423   :group 'spam-ifile)
 424
 425 (make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database)
 426 ;; "22.1" ;; Gnus 5.10.9
 427 (defcustom spam-ifile-database nil
 428   "File name of the ifile database."
 429   :type '(choice (file :tag "Location of the ifile database")
 430                  (const :tag "Use the default"))
 431   :group 'spam-ifile)
 432
 433 (defcustom spam-ifile-spam-category "spam"
 434   "Name of the spam ifile category."
 435   :type 'string
 436   :group 'spam-ifile)
 437
 438 (defcustom spam-ifile-ham-category nil
 439   "Name of the ham ifile category.
 440 If nil, the current group name will be used."
 441   :type '(choice (string :tag "Use a fixed category")
 442                  (const :tag "Use the current group name"))
 443   :group 'spam-ifile)
 444
 445 (defcustom spam-ifile-all-categories nil
 446   "Whether the ifile check will return all categories, or just spam.
 447 Set this to t if you want to use the `spam-split' invocation of ifile as
 448 your main source of newsgroup names."
 449   :type 'boolean
 450   :group 'spam-ifile)
 451
 452 (defgroup spam-bogofilter nil
 453   "Spam bogofilter configuration."
 454   :group 'spam)
 455
 456 (make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program)
 457 ;; "22.1" ;; Gnus 5.10.9
 458 (defcustom spam-bogofilter-program (executable-find "bogofilter")
 459   "Name of the Bogofilter program."
 460   :type '(choice (file :tag "Location of bogofilter")
 461                  (const :tag "Bogofilter is not installed"))
 462   :group 'spam-bogofilter)
 463
 464 (defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?")
 465
 466 (defcustom spam-bogofilter-header "X-Bogosity"
 467   "The header that Bogofilter inserts in messages."
 468   :type 'string
 469   :group 'spam-bogofilter)
 470
 471 (defcustom spam-bogofilter-spam-switch "-s"
 472   "The switch that Bogofilter uses to register spam messages."
 473   :type 'string
 474   :group 'spam-bogofilter)
 475
 476 (defcustom spam-bogofilter-ham-switch "-n"
 477   "The switch that Bogofilter uses to register ham messages."
 478   :type 'string
 479   :group 'spam-bogofilter)
 480
 481 (defcustom spam-bogofilter-spam-strong-switch "-S"
 482   "The switch that Bogofilter uses to unregister ham messages."
 483   :type 'string
 484   :group 'spam-bogofilter)
 485
 486 (defcustom spam-bogofilter-ham-strong-switch "-N"
 487   "The switch that Bogofilter uses to unregister spam messages."
 488   :type 'string
 489   :group 'spam-bogofilter)
 490
 491 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 492   "The regex on `spam-bogofilter-header' for positive spam identification."
 493   :type 'regexp
 494   :group 'spam-bogofilter)
 495
 496 (defcustom spam-bogofilter-database-directory nil
 497   "Location of the Bogofilter database.
 498 When nil, use the default location."
 499   :type '(choice (directory
 500                   :tag "Location of the Bogofilter database directory")
 501                  (const :tag "Use the default"))
 502   :group 'spam-bogofilter)
 503
 504 (defgroup spam-bsfilter nil
 505   "Spam bsfilter configuration."
 506   :group 'spam)
 507
 508 (make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program)
 509 ;; "22.1" ;; Gnus 5.10.9
 510 (defcustom spam-bsfilter-program (executable-find "bsfilter")
 511   "Name of the Bsfilter program."
 512   :type '(choice (file :tag "Location of bsfilter")
 513                  (const :tag "Bsfilter is not installed"))
 514   :group 'spam-bsfilter)
 515
 516 (defcustom spam-bsfilter-header "X-Spam-Flag"
 517   "The header inserted by Bsfilter to flag spam."
 518   :type 'string
 519   :group 'spam-bsfilter)
 520
 521 (defcustom spam-bsfilter-probability-header "X-Spam-Probability"
 522   "The header that Bsfilter inserts in messages."
 523   :type 'string
 524   :group 'spam-bsfilter)
 525
 526 (defcustom spam-bsfilter-spam-switch "--add-spam"
 527   "The switch that Bsfilter uses to register spam messages."
 528   :type 'string
 529   :group 'spam-bsfilter)
 530
 531 (defcustom spam-bsfilter-ham-switch "--add-clean"
 532   "The switch that Bsfilter uses to register ham messages."
 533   :type 'string
 534   :group 'spam-bsfilter)
 535
 536 (defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
 537   "The switch that Bsfilter uses to unregister ham messages."
 538   :type 'string
 539   :group 'spam-bsfilter)
 540
 541 (defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
 542   "The switch that Bsfilter uses to unregister spam messages."
 543   :type 'string
 544   :group 'spam-bsfilter)
 545
 546 (defcustom spam-bsfilter-database-directory nil
 547   "Directory path of the Bsfilter databases."
 548   :type '(choice (directory
 549                   :tag "Location of the Bsfilter database directory")
 550                  (const :tag "Use the default"))
 551   :group 'spam-bsfilter)
 552
 553 (defgroup spam-spamoracle nil
 554   "Spam spamoracle configuration."
 555   :group 'spam)
 556
 557 (defcustom spam-spamoracle-database nil
 558   "Location of spamoracle database file.
 559 When nil, use the default spamoracle database."
 560   :type '(choice (directory :tag "Location of spamoracle database file.")
 561                  (const :tag "Use the default"))
 562   :group 'spam-spamoracle)
 563
 564 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
 565   "Location of the spamoracle binary."
 566   :type '(choice (directory :tag "Location of the spamoracle binary")
 567                  (const :tag "Use the default"))
 568   :group 'spam-spamoracle)
 569
 570 (defgroup spam-spamassassin nil
 571   "Spam SpamAssassin configuration."
 572   :group 'spam)
 573
 574 (make-obsolete-variable 'spam-spamassassin-path
 575   'spam-spamassassin-program) ;; "22.1" ;; Gnus 5.10.9
 576 (defcustom spam-assassin-program (executable-find "spamassassin")
 577   "Name of the spamassassin program.
 578 Hint: set this to \"spamc\" if you have spamd running.  See the spamc and
 579 spamd man pages for more information on these programs."
 580   :type '(choice (file :tag "Location of spamc")
 581                  (const :tag "spamassassin is not installed"))
 582   :group 'spam-spamassassin)
 583
 584 (defcustom spam-spamassassin-arguments ()
 585   "Arguments to pass to the spamassassin executable.
 586 This must be a list.  For example, `(\"-C\" \"configfile\")'."
 587   :type '(restricted-sexp :match-alternatives (listp))
 588   :group 'spam-spamassassin)
 589
 590 (defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
 591   "The header inserted by SpamAssassin to flag spam."
 592   :type 'string
 593   :group 'spam-spamassassin)
 594
 595 (defcustom spam-spamassassin-positive-spam-flag-header "YES"
 596   "The regex on `spam-spamassassin-spam-flag-header' for positive spam
 597 identification"
 598   :type 'string
 599   :group 'spam-spamassassin)
 600
 601 (defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
 602   "The header inserted by SpamAssassin, giving extended scoring information"
 603   :type 'string
 604   :group 'spam-spamassassin)
 605
 606 (make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program)
 607 ;; "22.1" ;; Gnus 5.10.9
 608 (defcustom spam-sa-learn-program (executable-find "sa-learn")
 609   "Name of the sa-learn program."
 610   :type '(choice (file :tag "Location of spamassassin")
 611                  (const :tag "spamassassin is not installed"))
 612   :group 'spam-spamassassin)
 613
 614 (defcustom spam-sa-learn-rebuild t
 615   "Whether sa-learn should rebuild the database every time it is called
 616 Enable this if you want sa-learn to rebuild the database automatically.  Doing
 617 this will slightly increase the running time of the spam registration process.
 618 If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
 619 order for SpamAssassin to recognize the new registered spam."
 620   :type 'boolean
 621   :group 'spam-spamassassin)
 622
 623 (defcustom spam-sa-learn-spam-switch "--spam"
 624   "The switch that sa-learn uses to register spam messages"
 625   :type 'string
 626   :group 'spam-spamassassin)
 627
 628 (defcustom spam-sa-learn-ham-switch "--ham"
 629   "The switch that sa-learn uses to register ham messages"
 630   :type 'string
 631   :group 'spam-spamassassin)
 632
 633 (defcustom spam-sa-learn-unregister-switch "--forget"
 634   "The switch that sa-learn uses to unregister messages messages"
 635   :type 'string
 636   :group 'spam-spamassassin)
 637
 638 (defgroup spam-crm114 nil
 639   "Spam CRM114 Mailfilter configuration."
 640   :group 'spam)
 641
 642 (defcustom spam-crm114-program (executable-find "mailfilter.crm")
 643   "File path of the CRM114 Mailfilter executable program."
 644   :type '(choice (file :tag "Location of CRM114 Mailfilter")
 645          (const :tag "CRM114 Mailfilter is not installed"))
 646   :group 'spam-crm114)
 647
 648 (defcustom spam-crm114-header "X-CRM114-Status"
 649   "The header that CRM114 Mailfilter inserts in messages."
 650   :type 'string
 651   :group 'spam-crm114)
 652
 653 (defcustom spam-crm114-spam-switch "--learnspam"
 654   "The switch that CRM114 Mailfilter uses to register spam messages."
 655   :type 'string
 656   :group 'spam-crm114)
 657
 658 (defcustom spam-crm114-ham-switch "--learnnonspam"
 659   "The switch that CRM114 Mailfilter uses to register ham messages."
 660   :type 'string
 661   :group 'spam-crm114)
 662
 663 (defcustom spam-crm114-spam-strong-switch "--UNKNOWN"
 664   "The switch that CRM114 Mailfilter uses to unregister ham messages."
 665   :type 'string
 666   :group 'spam-crm114)
 667
 668 (defcustom spam-crm114-ham-strong-switch "--UNKNOWN"
 669   "The switch that CRM114 Mailfilter uses to unregister spam messages."
 670   :type 'string
 671   :group 'spam-crm114)
 672
 673 (defcustom spam-crm114-positive-spam-header "^SPAM"
 674   "The regex on `spam-crm114-header' for positive spam identification."
 675   :type 'regexp
 676   :group 'spam-crm114)
 677
 678 (defcustom spam-crm114-database-directory nil
 679   "Directory path of the CRM114 Mailfilter databases."
 680   :type '(choice (directory
 681           :tag "Location of the CRM114 Mailfilter database directory")
 682          (const :tag "Use the default"))
 683   :group 'spam-crm114)
 684
 685 ;;; Key bindings for spam control.
 686
 687 (gnus-define-keys gnus-summary-mode-map
 688   "St" spam-generic-score
 689   "Sx" gnus-summary-mark-as-spam
 690   "Mst" spam-generic-score
 691   "Msx" gnus-summary-mark-as-spam
 692   "\M-d" gnus-summary-mark-as-spam)
 693
 694 (defvar spam-cache-lookups t
 695   "Whether spam.el will try to cache lookups using `spam-caches'.")
 696
 697 (defvar spam-caches (make-hash-table
 698                      :size 10
 699                      :test 'equal)
 700   "Cache of spam detection entries.")
 701
 702 (defvar spam-old-articles nil
 703   "List of old ham and spam articles, generated when a group is entered.")
 704
 705 (defvar spam-split-disabled nil
 706   "If non-nil, `spam-split' is disabled, and always returns nil.")
 707
 708 (defvar spam-split-last-successful-check nil
 709   "Internal variable.
 710 `spam-split' will set this to nil or a spam-use-XYZ check if it
 711 finds ham or spam.")
 712
 713 ;; internal variables for backends
 714 ;; TODO: find a way to create these on the fly in spam-install-backend-super
 715 (defvar spam-use-copy nil)
 716 (defvar spam-use-move nil)
 717 (defvar spam-use-gmane nil)
 718 (defvar spam-use-resend nil)
 719
 720 ;;}}}
 721
 722 ;;{{{ convenience functions
 723
 724 (defun spam-clear-cache (symbol)
 725   "Clear the spam-caches entry for a check."
 726   (remhash symbol spam-caches))
 727
 728 (defun spam-xor (a b)
 729   "Logical A xor B."
 730   (and (or a b) (not (and a b))))
 731
 732 (defun spam-set-difference (list1 list2)
 733   "Return a set difference of LIST1 and LIST2.
 734 When either list is nil, the other is returned."
 735   (if (and list1 list2)
 736       ;; we have two non-nil lists
 737       (progn
 738         (dolist (item (append list1 list2))
 739           (when (and (memq item list1) (memq item list2))
 740             (setq list1 (delq item list1))
 741             (setq list2 (delq item list2))))
 742         (append list1 list2))
 743     ;; if either of the lists was nil, return the other one
 744     (if list1 list1 list2)))
 745
 746 (defun spam-group-ham-mark-p (group mark &optional spam)
 747   "Checks if MARK is considered a ham mark in GROUP."
 748   (when (stringp group)
 749     (let* ((marks (spam-group-ham-marks group spam))
 750            (marks (if (symbolp mark)
 751                       marks
 752                     (mapcar 'symbol-value marks))))
 753       (memq mark marks))))
 754
 755 (defun spam-group-spam-mark-p (group mark)
 756   "Checks if MARK is considered a spam mark in GROUP."
 757   (spam-group-ham-mark-p group mark t))
 758
 759 (defun spam-group-ham-marks (group &optional spam)
 760   "In GROUP, get all the ham marks."
 761   (when (stringp group)
 762     (let* ((marks (if spam
 763                       (gnus-parameter-spam-marks group)
 764                     (gnus-parameter-ham-marks group)))
 765            (marks (car marks))
 766            (marks (if (listp (car marks)) (car marks) marks)))
 767       marks)))
 768
 769 (defun spam-group-spam-marks (group)
 770   "In GROUP, get all the spam marks."
 771   (spam-group-ham-marks group t))
 772
 773 (defun spam-group-spam-contents-p (group)
 774   "Is GROUP a spam group?"
 775   (if (and (stringp group) (< 0 (length group)))
 776       (or (member group spam-junk-mailgroups)
 777           (memq 'gnus-group-spam-classification-spam
 778                 (gnus-parameter-spam-contents group)))
 779     nil))
 780
 781 (defun spam-group-ham-contents-p (group)
 782   "Is GROUP a ham group?"
 783   (if (stringp group)
 784       (memq 'gnus-group-spam-classification-ham
 785             (gnus-parameter-spam-contents group))
 786     nil))
 787
 788 (defun spam-classifications ()
 789   "Return list of valid classifications"
 790   '(spam ham))
 791
 792 (defun spam-classification-valid-p (classification)
 793   "Is CLASSIFICATION a valid spam/ham classification?"
 794   (memq classification (spam-classifications)))
 795
 796 (defun spam-backend-properties ()
 797   "Return list of valid classifications."
 798   '(statistical mover check hrf srf huf suf))
 799
 800 (defun spam-backend-property-valid-p (property)
 801   "Is PROPERTY a valid backend property?"
 802   (memq property (spam-backend-properties)))
 803
 804 (defun spam-backend-function-type-valid-p (type)
 805   (or (eq type 'registration)
 806       (eq type 'unregistration)))
 807
 808 (defun spam-process-type-valid-p (process-type)
 809   (or (eq process-type 'incoming)
 810       (eq process-type 'process)))
 811
 812 (defun spam-list-articles (articles classification)
 813   (let ((mark-check (if (eq classification 'spam)
 814                         'spam-group-spam-mark-p
 815                       'spam-group-ham-mark-p))
 816         alist mark-cache-yes mark-cache-no)
 817     (dolist (article articles)
 818       (let ((mark (gnus-summary-article-mark article)))
 819         (unless (or (memq mark mark-cache-yes)
 820                     (memq mark mark-cache-no))
 821           (if (funcall mark-check
 822                        gnus-newsgroup-name
 823                        mark)
 824               (push mark mark-cache-yes)
 825             (push mark mark-cache-no)))
 826         (when (memq mark mark-cache-yes)
 827           (push article alist))))
 828     alist))
 829
 830 ;;}}}
 831
 832 ;;{{{ backend installation functions and procedures
 833
 834 (defun spam-install-backend-super (backend &rest properties)
 835   "Install BACKEND for spam.el.
 836 Accepts incoming CHECK, ham registration function HRF, spam
 837 registration function SRF, ham unregistration function HUF, spam
 838 unregistration function SUF, and an indication whether the
 839 backend is STATISTICAL."
 840
 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 superceded 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   "This function will 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 (eval-and-compile
2072   (when (condition-case nil
2073             (progn
2074               (require 'bbdb)
2075               (require 'bbdb-com))
2076           (file-error
2077            ;; `bbdb-records' should not be bound as an autoload function
2078            ;; before loading bbdb because of `bbdb-hashtable-size'.
2079            (defalias 'bbdb-records 'ignore)
2080            (defalias 'spam-BBDB-register-routine 'ignore)
2081            (defalias 'spam-enter-ham-BBDB 'ignore)
2082            nil))
2083
2084     ;; when the BBDB changes, we want to clear out our cache
2085     (defun spam-clear-cache-BBDB (&rest immaterial)
2086       (spam-clear-cache 'spam-use-BBDB))
2087
2088     (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2089
2090     (defun spam-enter-ham-BBDB (addresses &optional remove)
2091       "Enter an address into the BBDB; implies ham (non-spam) sender"
2092       (dolist (from addresses)
2093         (when (stringp from)
2094           (let* ((parsed-address (gnus-extract-address-components from))
2095                  (name (or (nth 0 parsed-address) "Ham Sender"))
2096                  (remove-function (if remove
2097                                       'bbdb-delete-record-internal
2098                                     'ignore))
2099                  (net-address (nth 1 parsed-address))
2100                  (record (and net-address
2101                               (bbdb-search-simple nil net-address))))
2102             (when net-address
2103               (gnus-message 6 "%s address %s %s BBDB"
2104                             (if remove "Deleting" "Adding")
2105                             from
2106                             (if remove "from" "to"))
2107               (if record
2108                   (funcall remove-function record)
2109                 (bbdb-create-internal name nil net-address nil nil
2110                                       "ham sender added by spam.el")))))))
2111
2112     (defun spam-BBDB-register-routine (articles &optional unregister)
2113       (let (addresses)
2114         (dolist (article articles)
2115           (when (stringp (spam-fetch-field-from-fast article))
2116             (push (spam-fetch-field-from-fast article) addresses)))
2117         ;; now do the register/unregister action
2118         (spam-enter-ham-BBDB addresses unregister)))
2119
2120     (defun spam-BBDB-unregister-routine (articles)
2121       (spam-BBDB-register-routine articles t))
2122
2123     (defun spam-check-BBDB ()
2124       "Mail from people in the BBDB is classified as ham or non-spam"
2125       (let ((who (message-fetch-field "from"))
2126             bbdb-cache bbdb-hashtable)
2127         (when spam-cache-lookups
2128           (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2129           (unless bbdb-cache
2130             (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value
2131             ;; this is based on the expanded (bbdb-hashtable) macro
2132             ;; without the debugging support
2133             (with-current-buffer (bbdb-buffer)
2134               (save-excursion
2135                 (save-window-excursion
2136                   (bbdb-records nil t)
2137                   (mapatoms
2138                    (lambda (symbol)
2139                      (intern (downcase (symbol-name symbol)) bbdb-cache))
2140                    bbdb-hashtable))))
2141             (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2142         (when who
2143           (setq who (nth 1 (gnus-extract-address-components who)))
2144           (if
2145               (if spam-cache-lookups
2146                   (intern-soft (downcase who) bbdb-cache)
2147                 (bbdb-search-simple nil who))
2148               t
2149             (if spam-use-BBDB-exclusive
2150                 spam-split-group
2151               nil)))))))
2152
2153 ;;}}}
2154
2155 ;;{{{ ifile
2156
2157 ;;; check the ifile backend; return nil if the mail was NOT classified
2158 ;;; as spam
2159
2160
2161 (defun spam-get-ifile-database-parameter ()
2162   "Return the command-line parameter for ifile's database.
2163 See `spam-ifile-database'."
2164   (if spam-ifile-database
2165       (format "--db-file=%s" spam-ifile-database)
2166     nil))
2167
2168 (defun spam-check-ifile ()
2169   "Check the ifile backend for the classification of this message."
2170   (let ((article-buffer-name (buffer-name))
2171         category return)
2172     (with-temp-buffer
2173       (let ((temp-buffer-name (buffer-name))
2174             (db-param (spam-get-ifile-database-parameter)))
2175         (save-excursion
2176           (set-buffer article-buffer-name)
2177           (apply 'call-process-region
2178                  (point-min) (point-max) spam-ifile-program
2179                  nil temp-buffer-name nil "-c"
2180                  (if db-param `(,db-param "-q") `("-q"))))
2181         ;; check the return now (we're back in the temp buffer)
2182         (goto-char (point-min))
2183         (if (not (eobp))
2184             (setq category (buffer-substring (point) (point-at-eol))))
2185         (when (not (zerop (length category))) ; we need a category here
2186           (if spam-ifile-all-categories
2187               (setq return category)
2188             ;; else, if spam-ifile-all-categories is not set...
2189             (when (string-equal spam-ifile-spam-category category)
2190               (setq return spam-split-group)))))) ; note return is nil otherwise
2191     return))
2192
2193 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2194   "Register an article, given as a string, with a category.
2195 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2196   (let ((category (or category gnus-newsgroup-name))
2197         (add-or-delete-option (if unregister "-d" "-i"))
2198         (db (spam-get-ifile-database-parameter))
2199         parameters)
2200     (with-temp-buffer
2201       (dolist (article articles)
2202         (let ((article-string (spam-get-article-as-string article)))
2203           (when (stringp article-string)
2204             (insert article-string))))
2205       (apply 'call-process-region
2206              (point-min) (point-max) spam-ifile-program
2207              nil nil nil
2208              add-or-delete-option category
2209              (if db `(,db "-h") `("-h"))))))
2210
2211 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2212   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2213
2214 (defun spam-ifile-unregister-spam-routine (articles)
2215   (spam-ifile-register-spam-routine articles t))
2216
2217 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2218   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2219
2220 (defun spam-ifile-unregister-ham-routine (articles)
2221   (spam-ifile-register-ham-routine articles t))
2222
2223 ;;}}}
2224
2225 ;;{{{ spam-stat
2226
2227 (eval-when-compile
2228   (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
2229   (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
2230   (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
2231   (autoload 'spam-stat-buffer-is-spam "spam-stat")
2232   (autoload 'spam-stat-load "spam-stat")
2233   (autoload 'spam-stat-save "spam-stat")
2234   (autoload 'spam-stat-split-fancy "spam-stat"))
2235
2236 (eval-and-compile
2237   (when (condition-case nil
2238             (let ((spam-stat-install-hooks nil))
2239               (require 'spam-stat))
2240           (file-error
2241            (defalias 'spam-stat-register-ham-routine 'ignore)
2242            (defalias 'spam-stat-register-spam-routine 'ignore)
2243            nil))
2244
2245     (defun spam-check-stat ()
2246       "Check the spam-stat backend for the classification of this message"
2247       (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2248             (spam-stat-buffer (buffer-name)) ; stat the current buffer
2249             category return)
2250         (spam-stat-split-fancy)))
2251
2252     (defun spam-stat-register-spam-routine (articles &optional unregister)
2253       (dolist (article articles)
2254         (let ((article-string (spam-get-article-as-string article)))
2255           (with-temp-buffer
2256             (insert article-string)
2257             (if unregister
2258                 (spam-stat-buffer-change-to-non-spam)
2259               (spam-stat-buffer-is-spam))))))
2260
2261     (defun spam-stat-unregister-spam-routine (articles)
2262       (spam-stat-register-spam-routine articles t))
2263
2264     (defun spam-stat-register-ham-routine (articles &optional unregister)
2265       (dolist (article articles)
2266         (let ((article-string (spam-get-article-as-string article)))
2267           (with-temp-buffer
2268             (insert article-string)
2269             (if unregister
2270                 (spam-stat-buffer-change-to-spam)
2271               (spam-stat-buffer-is-non-spam))))))
2272
2273     (defun spam-stat-unregister-ham-routine (articles)
2274       (spam-stat-register-ham-routine articles t))
2275
2276     (defun spam-maybe-spam-stat-load ()
2277       (when spam-use-stat (spam-stat-load)))
2278
2279     (defun spam-maybe-spam-stat-save ()
2280       (when spam-use-stat (spam-stat-save)))))
2281
2282 ;;}}}
2283
2284 ;;{{{ Blacklists and whitelists.
2285
2286 (defvar spam-whitelist-cache nil)
2287 (defvar spam-blacklist-cache nil)
2288
2289 (defun spam-kill-whole-line ()
2290   (beginning-of-line)
2291   (let ((kill-whole-line t))
2292     (kill-line)))
2293
2294 ;;; address can be a list, too
2295 (defun spam-enter-whitelist (address &optional remove)
2296   "Enter ADDRESS (list or single) into the whitelist.
2297 With a non-nil REMOVE, remove them."
2298   (interactive "sAddress: ")
2299   (spam-enter-list address spam-whitelist remove)
2300   (setq spam-whitelist-cache nil)
2301   (spam-clear-cache 'spam-use-whitelist))
2302
2303 ;;; address can be a list, too
2304 (defun spam-enter-blacklist (address &optional remove)
2305   "Enter ADDRESS (list or single) into the blacklist.
2306 With a non-nil REMOVE, remove them."
2307   (interactive "sAddress: ")
2308   (spam-enter-list address spam-blacklist remove)
2309   (setq spam-blacklist-cache nil)
2310   (spam-clear-cache 'spam-use-whitelist))
2311
2312 (defun spam-enter-list (addresses file &optional remove)
2313   "Enter ADDRESSES into the given FILE.
2314 Either the whitelist or the blacklist files can be used.  With
2315 REMOVE not nil, remove the ADDRESSES."
2316   (if (stringp addresses)
2317       (spam-enter-list (list addresses) file remove)
2318     ;; else, we have a list of addresses here
2319     (unless (file-exists-p (file-name-directory file))
2320       (make-directory (file-name-directory file) t))
2321     (save-excursion
2322       (set-buffer
2323        (find-file-noselect file))
2324       (dolist (a addresses)
2325         (when (stringp a)
2326           (goto-char (point-min))
2327           (if (re-search-forward (regexp-quote a) nil t)
2328               ;; found the address
2329               (when remove
2330                 (spam-kill-whole-line))
2331             ;; else, the address was not found
2332             (unless remove
2333               (goto-char (point-max))
2334               (unless (bobp)
2335                 (insert "\n"))
2336               (insert a "\n")))))
2337       (save-buffer))))
2338
2339 (defun spam-filelist-build-cache (type)
2340   (let ((cache (if (eq type 'spam-use-blacklist)
2341                    spam-blacklist-cache
2342                  spam-whitelist-cache))
2343         parsed-cache)
2344     (unless (gethash type spam-caches)
2345       (while cache
2346         (let ((address (pop cache)))
2347           (unless (zerop (length address)) ; 0 for a nil address too
2348             (setq address (regexp-quote address))
2349             ;; fix regexp-quote's treatment of user-intended regexes
2350             (while (string-match "\\\\\\*" address)
2351               (setq address (replace-match ".*" t t address))))
2352           (push address parsed-cache)))
2353       (puthash type parsed-cache spam-caches))))
2354
2355 (defun spam-filelist-check-cache (type from)
2356   (when (stringp from)
2357     (spam-filelist-build-cache type)
2358     (let (found)
2359       (dolist (address (gethash type spam-caches))
2360         (when (and address (string-match address from))
2361           (setq found t)
2362           (return)))
2363       found)))
2364
2365 ;;; returns t if the sender is in the whitelist, nil or
2366 ;;; spam-split-group otherwise
2367 (defun spam-check-whitelist ()
2368   ;; FIXME!  Should it detect when file timestamps change?
2369   (unless spam-whitelist-cache
2370     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2371   (if (spam-from-listed-p 'spam-use-whitelist)
2372       t
2373     (if spam-use-whitelist-exclusive
2374         spam-split-group
2375       nil)))
2376
2377 (defun spam-check-blacklist ()
2378   ;; FIXME!  Should it detect when file timestamps change?
2379   (unless spam-blacklist-cache
2380     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2381   (and (spam-from-listed-p 'spam-use-blacklist)
2382        spam-split-group))
2383
2384 (defun spam-parse-list (file)
2385   (when (file-readable-p file)
2386     (let (contents address)
2387       (with-temp-buffer
2388         (insert-file-contents file)
2389         (while (not (eobp))
2390           (setq address (buffer-substring (point) (point-at-eol)))
2391           (forward-line 1)
2392           ;; insert the e-mail address if detected, otherwise the raw data
2393           (unless (zerop (length address))
2394             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2395               (push (or pure-address address) contents)))))
2396       (nreverse contents))))
2397
2398 (defun spam-from-listed-p (type)
2399   (let ((from (message-fetch-field "from"))
2400         found)
2401     (spam-filelist-check-cache type from)))
2402
2403 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2404   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2405         (declassification (if blacklist 'ham 'spam))
2406         (enter-function
2407          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2408         (remove-function
2409          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2410         from addresses unregister-list article-unregister-list)
2411     (dolist (article articles)
2412       (let ((from (spam-fetch-field-from-fast article))
2413             (id (spam-fetch-field-message-id-fast article))
2414             sender-ignored)
2415         (when (stringp from)
2416           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2417             (when (and (not sender-ignored)
2418                        (stringp ignore-regex)
2419                        (string-match ignore-regex from))
2420               (setq sender-ignored t)))
2421           ;; remember the messages we need to unregister, unless remove is set
2422           (when (and
2423                  (null unregister)
2424                  (spam-log-unregistration-needed-p
2425                   id 'process declassification de-symbol))
2426             (push article article-unregister-list)
2427             (push from unregister-list))
2428           (unless sender-ignored
2429             (push from addresses)))))
2430
2431     (if unregister
2432         (funcall enter-function addresses t) ; unregister all these addresses
2433       ;; else, register normally and unregister what we need to
2434       (funcall remove-function unregister-list t)
2435       (dolist (article article-unregister-list)
2436         (spam-log-undo-registration
2437          (spam-fetch-field-message-id-fast article)
2438          'process
2439          declassification
2440          de-symbol))
2441       (funcall enter-function addresses nil))))
2442
2443 (defun spam-blacklist-unregister-routine (articles)
2444   (spam-blacklist-register-routine articles t))
2445
2446 (defun spam-blacklist-register-routine (articles &optional unregister)
2447   (spam-filelist-register-routine articles t unregister))
2448
2449 (defun spam-whitelist-unregister-routine (articles)
2450   (spam-whitelist-register-routine articles t))
2451
2452 (defun spam-whitelist-register-routine (articles &optional unregister)
2453   (spam-filelist-register-routine articles nil unregister))
2454
2455 ;;}}}
2456
2457 ;;{{{ Spam-report glue (gmane and resend reporting)
2458 (defun spam-report-gmane-register-routine (articles)
2459   (when articles
2460     (apply 'spam-report-gmane-spam articles)))
2461
2462 (defun spam-report-gmane-unregister-routine (articles)
2463   (when articles
2464     (apply 'spam-report-gmane-ham articles)))
2465
2466 (defun spam-report-resend-register-ham-routine (articles)
2467   (spam-report-resend-register-routine articles t))
2468
2469 (defun spam-report-resend-register-routine (articles &optional ham)
2470   (let* ((resend-to-gp
2471           (if ham
2472               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2473             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2474          (spam-report-resend-to (or (car-safe resend-to-gp)
2475                                     spam-report-resend-to)))
2476     (spam-report-resend articles ham)))
2477
2478 ;;}}}
2479
2480 ;;{{{ Bogofilter
2481 (defun spam-check-bogofilter-headers (&optional score)
2482   (let ((header (message-fetch-field spam-bogofilter-header)))
2483     (when header                        ; return nil when no header
2484       (if score                         ; scoring mode
2485           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2486               (match-string 1 header)
2487             "0")
2488         ;; spam detection mode
2489         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2490                             header)
2491           spam-split-group)))))
2492
2493 ;; return something sensible if the score can't be determined
2494 (defun spam-bogofilter-score (&optional recheck)
2495   "Get the Bogofilter spamicity score"
2496   (interactive "P")
2497   (save-window-excursion
2498     (gnus-summary-show-article t)
2499     (set-buffer gnus-article-buffer)
2500     (let ((score (or (unless recheck
2501                        (spam-check-bogofilter-headers t))
2502                      (spam-check-bogofilter t))))
2503       (gnus-summary-show-article)
2504       (message "Spamicity score %s" score)
2505       (or score "0"))))
2506
2507 (defun spam-verify-bogofilter ()
2508   "Verify the Bogofilter version is sufficient."
2509   (when (eq spam-bogofilter-valid 'unknown)
2510     (setq spam-bogofilter-valid
2511           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2512                              (shell-command-to-string
2513                               (format "%s -V" spam-bogofilter-program))))))
2514   spam-bogofilter-valid)
2515
2516 (defun spam-check-bogofilter (&optional score)
2517   "Check the Bogofilter backend for the classification of this message."
2518   (if (spam-verify-bogofilter)
2519       (let ((article-buffer-name (buffer-name))
2520             (db spam-bogofilter-database-directory)
2521             return)
2522         (with-temp-buffer
2523           (let ((temp-buffer-name (buffer-name)))
2524             (save-excursion
2525               (set-buffer article-buffer-name)
2526               (apply 'call-process-region
2527                      (point-min) (point-max)
2528                      spam-bogofilter-program
2529                      nil temp-buffer-name nil
2530                      (if db `("-d" ,db "-v") `("-v"))))
2531             (setq return (spam-check-bogofilter-headers score))))
2532         return)
2533     (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
2534
2535 (defun spam-bogofilter-register-with-bogofilter (articles
2536                                                  spam
2537                                                  &optional unregister)
2538   "Register an article, given as a string, as spam or non-spam."
2539   (if (spam-verify-bogofilter)
2540       (dolist (article articles)
2541         (let ((article-string (spam-get-article-as-string article))
2542               (db spam-bogofilter-database-directory)
2543               (switch (if unregister
2544                           (if spam
2545                               spam-bogofilter-spam-strong-switch
2546                             spam-bogofilter-ham-strong-switch)
2547                         (if spam
2548                             spam-bogofilter-spam-switch
2549                           spam-bogofilter-ham-switch))))
2550           (when (stringp article-string)
2551             (with-temp-buffer
2552               (insert article-string)
2553
2554               (apply 'call-process-region
2555                      (point-min) (point-max)
2556                      spam-bogofilter-program
2557                      nil nil nil switch
2558                      (if db `("-d" ,db "-v") `("-v")))))))
2559     (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
2560
2561 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2562   (spam-bogofilter-register-with-bogofilter articles t unregister))
2563
2564 (defun spam-bogofilter-unregister-spam-routine (articles)
2565   (spam-bogofilter-register-spam-routine articles t))
2566
2567 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2568   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2569
2570 (defun spam-bogofilter-unregister-ham-routine (articles)
2571   (spam-bogofilter-register-ham-routine articles t))
2572
2573
2574 ;;}}}
2575
2576 ;;{{{ spamoracle
2577 (defun spam-check-spamoracle ()
2578   "Run spamoracle on an article to determine whether it's spam."
2579   (let ((article-buffer-name (buffer-name)))
2580     (with-temp-buffer
2581       (let ((temp-buffer-name (buffer-name)))
2582         (save-excursion
2583           (set-buffer article-buffer-name)
2584           (let ((status
2585                  (apply 'call-process-region
2586                         (point-min) (point-max)
2587                         spam-spamoracle-binary
2588                         nil temp-buffer-name nil
2589                         (if spam-spamoracle-database
2590                             `("-f" ,spam-spamoracle-database "mark")
2591                           '("mark")))))
2592             (if (eq 0 status)
2593                 (progn
2594                   (set-buffer temp-buffer-name)
2595                   (goto-char (point-min))
2596                   (when (re-search-forward "^X-Spam: yes;" nil t)
2597                     spam-split-group))
2598               (error "Error running spamoracle: %s" status))))))))
2599
2600 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2601   "Run spamoracle in training mode."
2602   (with-temp-buffer
2603     (let ((temp-buffer-name (buffer-name)))
2604       (save-excursion
2605         (goto-char (point-min))
2606         (dolist (article articles)
2607           (insert (spam-get-article-as-string article)))
2608         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2609                         "-spam"
2610                       "-good"))
2611                (status
2612                 (apply 'call-process-region
2613                        (point-min) (point-max)
2614                        spam-spamoracle-binary
2615                        nil temp-buffer-name nil
2616                        (if spam-spamoracle-database
2617                            `("-f" ,spam-spamoracle-database
2618                              "add" ,arg)
2619                          `("add" ,arg)))))
2620           (unless (eq 0 status)
2621             (error "Error running spamoracle: %s" status)))))))
2622
2623 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2624   (spam-spamoracle-learn articles nil unregister))
2625
2626 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2627   (spam-spamoracle-learn-ham articles t))
2628
2629 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2630   (spam-spamoracle-learn articles t unregister))
2631
2632 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2633   (spam-spamoracle-learn-spam articles t))
2634
2635 ;;}}}
2636
2637 ;;{{{ SpamAssassin
2638 ;;; based mostly on the bogofilter code
2639 (defun spam-check-spamassassin-headers (&optional score)
2640   "Check the SpamAssassin headers for the classification of this message."
2641   (if score                             ; scoring mode
2642       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2643         (when header
2644           (if (string-match spam-spamassassin-score-regexp header)
2645               (match-string 1 header)
2646             "0")))
2647     ;; spam detection mode
2648     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2649           (when header                  ; return nil when no header
2650             (when (string-match spam-spamassassin-positive-spam-flag-header
2651                                 header)
2652               spam-split-group)))))
2653
2654 (defun spam-check-spamassassin (&optional score)
2655   "Check the SpamAssassin backend for the classification of this message."
2656   (let ((article-buffer-name (buffer-name)))
2657     (with-temp-buffer
2658       (let ((temp-buffer-name (buffer-name)))
2659         (save-excursion
2660           (set-buffer article-buffer-name)
2661           (apply 'call-process-region
2662                  (point-min) (point-max) spam-assassin-program
2663                  nil temp-buffer-name nil spam-spamassassin-arguments))
2664         ;; check the return now (we're back in the temp buffer)
2665         (goto-char (point-min))
2666         (spam-check-spamassassin-headers score)))))
2667
2668 ;; return something sensible if the score can't be determined
2669 (defun spam-spamassassin-score (&optional recheck)
2670   "Get the SpamAssassin score"
2671   (interactive "P")
2672   (save-window-excursion
2673     (gnus-summary-show-article t)
2674     (set-buffer gnus-article-buffer)
2675     (let ((score (or (unless recheck
2676                        (spam-check-spamassassin-headers t))
2677                      (spam-check-spamassassin t))))
2678       (gnus-summary-show-article)
2679       (message "SpamAssassin score %s" score)
2680       (or score "0"))))
2681
2682 (defun spam-spamassassin-register-with-sa-learn (articles spam
2683                                                  &optional unregister)
2684   "Register articles with spamassassin's sa-learn as spam or non-spam."
2685   (if articles
2686       (let ((action (if unregister spam-sa-learn-unregister-switch
2687                       (if spam spam-sa-learn-spam-switch
2688                         spam-sa-learn-ham-switch)))
2689             (summary-buffer-name (buffer-name)))
2690         (with-temp-buffer
2691           ;; group the articles into mbox format
2692           (dolist (article articles)
2693             (let (article-string)
2694               (save-excursion
2695                 (set-buffer summary-buffer-name)
2696                 (setq article-string (spam-get-article-as-string article)))
2697               (when (stringp article-string)
2698                 (insert "From \n") ; mbox separator (sa-learn only checks the
2699                                    ; first five chars, so we can get away with
2700                                    ; a bogus line))
2701                 (insert article-string)
2702                 (insert "\n"))))
2703           ;; call sa-learn on all messages at the same time
2704           (apply 'call-process-region
2705                  (point-min) (point-max)
2706                  spam-sa-learn-program
2707                  nil nil nil "--mbox"
2708                  (if spam-sa-learn-rebuild
2709                      (list action)
2710                    `("--no-rebuild" ,action)))))))
2711
2712 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2713   (spam-spamassassin-register-with-sa-learn articles t unregister))
2714
2715 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2716   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2717
2718 (defun spam-spamassassin-unregister-spam-routine (articles)
2719   (spam-spamassassin-register-with-sa-learn articles t t))
2720
2721 (defun spam-spamassassin-unregister-ham-routine (articles)
2722   (spam-spamassassin-register-with-sa-learn articles nil t))
2723
2724 ;;}}}
2725
2726 ;;{{{ Bsfilter
2727 ;;; based mostly on the bogofilter code
2728 (defun spam-check-bsfilter-headers (&optional score)
2729   (if score
2730       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2731           "0")
2732     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2733       (when header ; return nil when no header
2734         (when (string-match "YES" header)
2735           spam-split-group)))))
2736
2737 ;; return something sensible if the score can't be determined
2738 (defun spam-bsfilter-score (&optional recheck)
2739   "Get the Bsfilter spamicity score"
2740   (interactive "P")
2741   (save-window-excursion
2742     (gnus-summary-show-article t)
2743     (set-buffer gnus-article-buffer)
2744     (let ((score (or (unless recheck
2745                        (spam-check-bsfilter-headers t))
2746                      (spam-check-bsfilter t))))
2747       (gnus-summary-show-article)
2748       (message "Spamicity score %s" score)
2749       (or score "0"))))
2750
2751 (defun spam-check-bsfilter (&optional score)
2752   "Check the Bsfilter backend for the classification of this message"
2753   (let ((article-buffer-name (buffer-name))
2754         (dir spam-bsfilter-database-directory)
2755         return)
2756     (with-temp-buffer
2757       (let ((temp-buffer-name (buffer-name)))
2758         (save-excursion
2759           (set-buffer article-buffer-name)
2760           (apply 'call-process-region
2761                  (point-min) (point-max)
2762                  spam-bsfilter-program
2763                  nil temp-buffer-name nil
2764                  "--pipe"
2765                  "--insert-flag"
2766                  "--insert-probability"
2767                  (when dir
2768                    (list "--homedir" dir))))
2769         (setq return (spam-check-bsfilter-headers score))))
2770     return))
2771
2772 (defun spam-bsfilter-register-with-bsfilter (articles
2773                                              spam
2774                                              &optional unregister)
2775   "Register an article, given as a string, as spam or non-spam."
2776   (dolist (article articles)
2777     (let ((article-string (spam-get-article-as-string article))
2778           (switch (if unregister
2779                       (if spam
2780                           spam-bsfilter-spam-strong-switch
2781                         spam-bsfilter-ham-strong-switch)
2782                     (if spam
2783                         spam-bsfilter-spam-switch
2784                       spam-bsfilter-ham-switch))))
2785       (when (stringp article-string)
2786         (with-temp-buffer
2787           (insert article-string)
2788           (apply 'call-process-region
2789                  (point-min) (point-max)
2790                  spam-bsfilter-program
2791                  nil nil nil switch
2792                  "--update"
2793                  (when spam-bsfilter-database-directory
2794                    (list "--homedir"
2795                          spam-bsfilter-database-directory))))))))
2796
2797 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2798   (spam-bsfilter-register-with-bsfilter articles t unregister))
2799
2800 (defun spam-bsfilter-unregister-spam-routine (articles)
2801   (spam-bsfilter-register-spam-routine articles t))
2802
2803 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2804   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2805
2806 (defun spam-bsfilter-unregister-ham-routine (articles)
2807   (spam-bsfilter-register-ham-routine articles t))
2808
2809 ;;}}}
2810
2811 ;;{{{ CRM114 Mailfilter
2812 (defun spam-check-crm114-headers (&optional score)
2813   (let ((header (message-fetch-field spam-crm114-header)))
2814     (when header                        ; return nil when no header
2815       (if score                         ; scoring mode
2816           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2817               (match-string 1 header)
2818             "0")
2819         ;; spam detection mode
2820         (when (string-match spam-crm114-positive-spam-header
2821                             header)
2822           spam-split-group)))))
2823
2824 ;; return something sensible if the score can't be determined
2825 (defun spam-crm114-score ()
2826   "Get the CRM114 Mailfilter pR"
2827   (interactive)
2828   (save-window-excursion
2829     (gnus-summary-show-article t)
2830     (set-buffer gnus-article-buffer)
2831     (let ((score (or (spam-check-crm114-headers t)
2832                      (spam-check-crm114 t))))
2833       (gnus-summary-show-article)
2834       (message "pR: %s" score)
2835       (or score "0"))))
2836
2837 (defun spam-check-crm114 (&optional score)
2838   "Check the CRM114 Mailfilter backend for the classification of this message"
2839   (let ((article-buffer-name (buffer-name))
2840         (db spam-crm114-database-directory)
2841         return)
2842     (with-temp-buffer
2843       (let ((temp-buffer-name (buffer-name)))
2844         (save-excursion
2845           (set-buffer article-buffer-name)
2846           (apply 'call-process-region
2847                  (point-min) (point-max)
2848                  spam-crm114-program
2849                  nil temp-buffer-name nil
2850                  (when db (list (concat "--fileprefix=" db)))))
2851         (setq return (spam-check-crm114-headers score))))
2852     return))
2853
2854 (defun spam-crm114-register-with-crm114 (articles
2855                                          spam
2856                                          &optional unregister)
2857   "Register an article, given as a string, as spam or non-spam."
2858   (dolist (article articles)
2859     (let ((article-string (spam-get-article-as-string article))
2860           (db spam-crm114-database-directory)
2861           (switch (if unregister
2862                       (if spam
2863                           spam-crm114-spam-strong-switch
2864                         spam-crm114-ham-strong-switch)
2865                     (if spam
2866                         spam-crm114-spam-switch
2867                       spam-crm114-ham-switch))))
2868       (when (stringp article-string)
2869         (with-temp-buffer
2870           (insert article-string)
2871
2872           (apply 'call-process-region
2873                  (point-min) (point-max)
2874                  spam-crm114-program
2875                  nil nil nil
2876                  (when db (list switch (concat "--fileprefix=" db)))))))))
2877
2878 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2879   (spam-crm114-register-with-crm114 articles t unregister))
2880
2881 (defun spam-crm114-unregister-spam-routine (articles)
2882   (spam-crm114-register-spam-routine articles t))
2883
2884 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2885   (spam-crm114-register-with-crm114 articles nil unregister))
2886
2887 (defun spam-crm114-unregister-ham-routine (articles)
2888   (spam-crm114-register-ham-routine articles t))
2889
2890 ;;}}}
2891
2892 ;;}}}
2893
2894 ;;{{{ Hooks
2895
2896 ;;;###autoload
2897 (defun spam-initialize (&rest symbols)
2898   "Install the spam.el hooks and do other initialization.
2899 When SYMBOLS is given, set those variables to t.  This is so you
2900 can call spam-initialize before you set spam-use-* variables on
2901 explicitly, and matters only if you need the extra headers
2902 installed through spam-necessary-extra-headers."
2903   (interactive)
2904
2905   (dolist (var symbols)
2906     (set var t))
2907
2908   (dolist (header (spam-necessary-extra-headers))
2909     (add-to-list 'nnmail-extra-headers header)
2910     (add-to-list 'gnus-extra-headers header))
2911
2912   (setq spam-install-hooks t)
2913   ;; TODO: How do we redo this every time the `spam' face is customized?
2914   (push '((eq mark gnus-spam-mark) . spam)
2915         gnus-summary-highlight)
2916   ;; Add hooks for loading and saving the spam stats
2917   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2918   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2919   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2920   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2921   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2922   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2923   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2924
2925 (defun spam-unload-hook ()
2926   "Uninstall the spam.el hooks"
2927   (interactive)
2928   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2929   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2930   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2931   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2932   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2933   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2934   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2935
2936 (add-hook 'spam-unload-hook 'spam-unload-hook)
2937
2938 (when spam-install-hooks
2939   (spam-initialize))
2940 ;;}}}
2941
2942 (provide 'spam)
2943
2944 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2945 ;;; spam.el ends here