git.chise.org Git - elisp/gnus.git-/blob - lisp/spam.el

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