spam.el 110 KB
Newer Older
1
;;; spam.el --- Identifying spam
2

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4
;;   Free Software Foundation, Inc.
5 6

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 8
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: network, spam, mail, bogofilter, BBDB, dspam, dig, whitelist, blacklist, gmane, hashcash, spamassassin, bsfilter, ifile, stat, crm114, spamoracle
9 10 11

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
16 17 18

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 21 22
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
24 25 26 27 28 29 30 31 32 33 34 35

;;; Commentary:

;;; This module addresses a few aspects of spam control under Gnus.  Page
;;; breaks are used for grouping declarations and documentation relating to
;;; each particular aspect.

;;; The integration with Gnus is not yet complete.  See various `FIXME'
;;; comments, below, for supplementary explanations or discussions.

;;; Several TODO items are marked as such

36
;; TODO: cross-server splitting, remote processing, training through files
37 38 39

;;; Code:

40 41
;;{{{ compilation directives and autoloads/requires

42
;; For Emacs <22.2 and XEmacs.
43 44 45
(eval-and-compile
  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))

46 47
(eval-when-compile (require 'cl))

48
(require 'message)              ;for the message-fetch-field functions
49
(require 'gnus-sum)
50
(require 'gnus-uu)                      ; because of key prefix issues
51 52
;;; for the definitions of group content classification and spam processors
(require 'gnus)
53 54 55

(eval-when-compile (require 'spam-report))
(eval-when-compile (require 'hashcash))
56 57 58 59 60

;; for nnimap-split-download-body-default
(eval-when-compile (require 'nnimap))

;; autoload query-dig
61
(autoload 'query-dig "dig")
62 63 64

;; autoload spam-report
(eval-and-compile
65 66 67 68
  (autoload 'spam-report-gmane "spam-report")
  (autoload 'spam-report-gmane-spam "spam-report")
  (autoload 'spam-report-gmane-ham "spam-report")
  (autoload 'spam-report-resend "spam-report"))
69 70

;; autoload gnus-registry
71 72 73 74
(autoload 'gnus-registry-group-count "gnus-registry")
(autoload 'gnus-registry-add-group "gnus-registry")
(autoload 'gnus-registry-store-extra-entry "gnus-registry")
(autoload 'gnus-registry-fetch-extra "gnus-registry")
75

76 77
;; autoload dns-query
(autoload 'dns-query "dns")
78

79 80 81 82 83
;;}}}

;;{{{ Main parameters.
(defvar spam-backends nil
  "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 89 90
  :version "22.1"
  :group 'mail
  :group 'news)
91

92 93
(defcustom spam-summary-exit-behavior 'default
  "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 97 98 99 100 101 102 103 104 105
  :type '(choice
          (const
           'default
           :tag "Move spam out of all groups and ham out of spam groups.")
          (const
           'move-all
           :tag "Move spam out of all groups and ham out of all groups.")
          (const
           'move-none
           :tag "Never move spam or ham out of any groups."))
106 107
  :group 'spam)

108
(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
109 110 111 112
  "Directory for spam whitelists and blacklists."
  :type 'directory
  :group 'spam)

113 114 115 116 117 118
(defcustom spam-mark-new-messages-in-spam-group-as-spam t
  "Whether new messages in a spam group should get the spam-mark."
  :type 'boolean
  ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3
  :group 'spam)

119 120 121 122 123 124 125 126 127 128 129 130
(defcustom spam-log-to-registry nil
  "Whether spam/ham processing should be logged in the registry."
  :type 'boolean
  :group 'spam)

(defcustom spam-split-symbolic-return nil
  "Whether `spam-split' should work with symbols or group names."
  :type 'boolean
  :group 'spam)

(defcustom spam-split-symbolic-return-positive nil
  "Whether `spam-split' should ALWAYS work with symbols or group names.
131
Do not set this if you use `spam-split' in a fancy split method."
132 133 134 135 136 137 138 139 140 141 142 143 144
  :type 'boolean
  :group 'spam)

(defcustom spam-mark-only-unseen-as-spam t
  "Whether only unseen articles should be marked as spam in spam groups.
When nil, all unread articles in a spam group are marked as
spam.  Set this if you want to leave an article unread in a spam group
without losing it to the automatic spam-marking process."
  :type 'boolean
  :group 'spam)

(defcustom spam-mark-ham-unread-before-move-from-spam-group nil
  "Whether ham should be marked unread before it's moved.
145
The article is moved out of a spam group according to `ham-process-destination'.
146 147 148 149 150 151
This variable is an official entry in the international Longest Variable Name
Competition."
  :type 'boolean
  :group 'spam)

(defcustom spam-disable-spam-split-during-ham-respool nil
152 153 154
  "Whether `spam-split' should be ignored while resplitting ham.
This is useful to prevent ham from ending up in the same spam
group after the resplit.  Don't set this to t if you have `spam-split' as the
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
last rule in your split configuration."
  :type 'boolean
  :group 'spam)

(defcustom spam-autodetect-recheck-messages nil
  "Should spam.el recheck all meessages when autodetecting?
Normally this is nil, so only unseen messages will be checked."
  :type 'boolean
  :group 'spam)

(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
  "The location of the whitelist.
The file format is one regular expression per line.
The regular expression is matched against the address."
  :type 'file
  :group 'spam)

(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
  "The location of the blacklist.
The file format is one regular expression per line.
The regular expression is matched against the address."
  :type 'file
  :group 'spam)

(defcustom spam-use-dig t
180
  "Whether `query-dig' should be used instead of `dns-query'."
181 182 183
  :type 'boolean
  :group 'spam)

184 185 186 187 188
(defcustom spam-use-gmane-xref nil
  "Whether the Gmane spam xref should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244
(defcustom spam-use-blacklist nil
  "Whether the blacklist should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-blacklist-ignored-regexes nil
  "Regular expressions that the blacklist should ignore."
  :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
  :group 'spam)

(defcustom spam-use-whitelist nil
  "Whether the whitelist should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-whitelist-exclusive nil
  "Whether whitelist-exclusive should be used by `spam-split'.
Exclusive whitelisting means that all messages from senders not in the whitelist
are considered spam."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-blackholes nil
  "Whether blackholes should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-hashcash nil
  "Whether hashcash payments should be detected by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-regex-headers nil
  "Whether a header regular expression match should be used by `spam-split'.
Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-regex-body nil
  "Whether a body regular expression match should be used by `spam-split'.
Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-bogofilter-headers nil
  "Whether bogofilter headers should be used by `spam-split'.
Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-bogofilter nil
  "Whether bogofilter should be invoked by `spam-split'.
Enable this if you want Gnus to invoke Bogofilter on new messages."
  :type 'boolean
  :group 'spam)

245 246 247 248 249 250 251 252 253 254 255 256
(defcustom spam-use-bsfilter-headers nil
  "Whether bsfilter headers should be used by `spam-split'.
Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-bsfilter nil
  "Whether bsfilter should be invoked by `spam-split'.
Enable this if you want Gnus to invoke Bsfilter on new messages."
  :type 'boolean
  :group 'spam)

257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
(defcustom spam-use-BBDB nil
  "Whether BBDB should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-BBDB-exclusive nil
  "Whether BBDB-exclusive should be used by `spam-split'.
Exclusive BBDB means that all messages from senders not in the BBDB are
considered spam."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-ifile nil
  "Whether ifile should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-stat nil
  "Whether `spam-stat' should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-spamoracle nil
  "Whether spamoracle should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
(defcustom spam-use-spamassassin nil
  "Whether spamassassin should be invoked by `spam-split'.
Enable this if you want Gnus to invoke SpamAssassin on new messages."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-spamassassin-headers nil
  "Whether spamassassin headers should be checked by `spam-split'.
Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
them."
  :type 'boolean
  :group 'spam)

(defcustom spam-use-crm114 nil
  "Whether the CRM114 Mailfilter should be used by `spam-split'."
  :type 'boolean
  :group 'spam)

302
(defcustom spam-install-hooks (or
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
                               spam-use-dig
                               spam-use-gmane-xref
                               spam-use-blacklist
                               spam-use-whitelist
                               spam-use-whitelist-exclusive
                               spam-use-blackholes
                               spam-use-hashcash
                               spam-use-regex-headers
                               spam-use-regex-body
                               spam-use-bogofilter
                               spam-use-bogofilter-headers
                               spam-use-spamassassin
                               spam-use-spamassassin-headers
                               spam-use-bsfilter
                               spam-use-bsfilter-headers
                               spam-use-BBDB
                               spam-use-BBDB-exclusive
                               spam-use-ifile
                               spam-use-stat
                               spam-use-spamoracle
                               spam-use-crm114)
324 325 326 327 328 329 330 331 332 333 334 335 336
  "Whether the spam hooks should be installed.
Default to t if one of the spam-use-* variables is set."
  :group 'spam
  :type 'boolean)

(defcustom spam-split-group "spam"
  "Group name where incoming spam should be put by `spam-split'."
  :type 'string
  :group 'spam)

;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
;;; not regular expressions
(defcustom spam-junk-mailgroups (cons
337 338
                                 spam-split-group
                                 '("mail.junk" "poste.pourriel"))
339 340 341 342 343
  "Mailgroups with spam contents.
All unmarked article in such group receive the spam mark on group entry."
  :type '(repeat (string :tag "Group"))
  :group 'spam)

344 345 346 347 348 349 350

(defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
  "The group where spam xrefs can be found on Gmane.
Only meaningful if you enable `spam-use-gmane-xref'."
  :type 'string
  :group 'spam)

351
(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
352
                                    "dev.null.dk" "relays.visi.com")
353 354
  "List of blackhole servers.
Only meaningful if you enable `spam-use-blackholes'."
355 356 357 358
  :type '(repeat (string :tag "Server"))
  :group 'spam)

(defcustom spam-blackhole-good-server-regex nil
359 360
  "String matching IP addresses that should not be checked in the blackholes.
Only meaningful if you enable `spam-use-blackholes'."
361
  :type '(radio (const nil) regexp)
362 363
  :group 'spam)

364
(defface spam
365 366 367 368 369 370 371 372 373
  '((((class color) (type tty) (background dark))
     (:foreground "gray80" :background "gray50"))
    (((class color) (type tty) (background light))
     (:foreground "gray50" :background "gray80"))
    (((class color) (background dark))
     (:foreground "ivory2"))
    (((class color) (background light))
     (:foreground "ivory4"))
    (t :inverse-video t))
374 375
  "Face for spam-marked articles."
  :group 'spam)
376 377
;; backward-compatibility alias
(put 'spam-face 'face-alias 'spam)
378
(put 'spam-face 'obsolete-face "22.1")
379

380
(defcustom spam-face 'spam
381 382 383 384 385
  "Face for spam-marked articles."
  :type 'face
  :group 'spam)

(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
386 387
  "Regular expression for positive header spam matches.
Only meaningful if you enable `spam-use-regex-headers'."
388 389 390 391
  :type '(repeat (regexp :tag "Regular expression to match spam header"))
  :group 'spam)

(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
392 393
  "Regular expression for positive header ham matches.
Only meaningful if you enable `spam-use-regex-headers'."
394 395 396 397
  :type '(repeat (regexp :tag "Regular expression to match ham header"))
  :group 'spam)

(defcustom spam-regex-body-spam '()
398 399
  "Regular expression for positive body spam matches.
Only meaningful if you enable `spam-use-regex-body'."
400 401 402 403
  :type '(repeat (regexp :tag "Regular expression to match spam body"))
  :group 'spam)

(defcustom spam-regex-body-ham '()
404 405
  "Regular expression for positive body ham matches.
Only meaningful if you enable `spam-use-regex-body'."
406 407 408
  :type '(repeat (regexp :tag "Regular expression to match ham body"))
  :group 'spam)

409
(defcustom spam-summary-score-preferred-header nil
410
  "Preferred header to use for `spam-summary-score'."
411
  :type '(choice :tag "Header name"
412 413 414
          (symbol :tag "SpamAssassin etc" X-Spam-Status)
          (symbol :tag "Bogofilter"       X-Bogosity)
          (const  :tag "No preference, take best guess." nil))
415 416
  :group 'spam)

417 418 419 420
(defgroup spam-ifile nil
  "Spam ifile configuration."
  :group 'spam)

421 422
(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program
                        "Gnus 5.10.9 (Emacs 22.1)")
Miles Bader's avatar
Miles Bader committed
423 424
(defcustom spam-ifile-program (executable-find "ifile")
  "Name of the ifile program."
425
  :type '(choice (file :tag "Location of ifile")
426
                 (const :tag "ifile is not installed"))
427 428
  :group 'spam-ifile)

429 430
(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database
                        "Gnus 5.10.9 (Emacs 22.1)")
Miles Bader's avatar
Miles Bader committed
431 432
(defcustom spam-ifile-database nil
  "File name of the ifile database."
433
  :type '(choice (file :tag "Location of the ifile database")
434
                 (const :tag "Use the default"))
435 436 437 438 439 440 441 442 443 444 445
  :group 'spam-ifile)

(defcustom spam-ifile-spam-category "spam"
  "Name of the spam ifile category."
  :type 'string
  :group 'spam-ifile)

(defcustom spam-ifile-ham-category nil
  "Name of the ham ifile category.
If nil, the current group name will be used."
  :type '(choice (string :tag "Use a fixed category")
446
                 (const :tag "Use the current group name"))
447 448 449 450 451 452 453 454 455 456 457 458 459
  :group 'spam-ifile)

(defcustom spam-ifile-all-categories nil
  "Whether the ifile check will return all categories, or just spam.
Set this to t if you want to use the `spam-split' invocation of ifile as
your main source of newsgroup names."
  :type 'boolean
  :group 'spam-ifile)

(defgroup spam-bogofilter nil
  "Spam bogofilter configuration."
  :group 'spam)

460 461
(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program
                        "Gnus 5.10.9 (Emacs 22.1)")
Miles Bader's avatar
Miles Bader committed
462 463
(defcustom spam-bogofilter-program (executable-find "bogofilter")
  "Name of the Bogofilter program."
464
  :type '(choice (file :tag "Location of bogofilter")
465
                 (const :tag "Bogofilter is not installed"))
466 467
  :group 'spam-bogofilter)

468 469
(defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?")

470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500
(defcustom spam-bogofilter-header "X-Bogosity"
  "The header that Bogofilter inserts in messages."
  :type 'string
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-spam-switch "-s"
  "The switch that Bogofilter uses to register spam messages."
  :type 'string
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-ham-switch "-n"
  "The switch that Bogofilter uses to register ham messages."
  :type 'string
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-spam-strong-switch "-S"
  "The switch that Bogofilter uses to unregister ham messages."
  :type 'string
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-ham-strong-switch "-N"
  "The switch that Bogofilter uses to unregister spam messages."
  :type 'string
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
  "The regex on `spam-bogofilter-header' for positive spam identification."
  :type 'regexp
  :group 'spam-bogofilter)

(defcustom spam-bogofilter-database-directory nil
Miles Bader's avatar
Miles Bader committed
501 502
  "Location of the Bogofilter database.
When nil, use the default location."
503
  :type '(choice (directory
504 505
                  :tag "Location of the Bogofilter database directory")
                 (const :tag "Use the default"))
506 507
  :group 'spam-bogofilter)

508 509 510 511
(defgroup spam-bsfilter nil
  "Spam bsfilter configuration."
  :group 'spam)

512 513
(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program
                        "Gnus 5.10.9 (Emacs 22.1)")
514 515 516
(defcustom spam-bsfilter-program (executable-find "bsfilter")
  "Name of the Bsfilter program."
  :type '(choice (file :tag "Location of bsfilter")
517
                 (const :tag "Bsfilter is not installed"))
518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-header "X-Spam-Flag"
  "The header inserted by Bsfilter to flag spam."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-probability-header "X-Spam-Probability"
  "The header that Bsfilter inserts in messages."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-spam-switch "--add-spam"
  "The switch that Bsfilter uses to register spam messages."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-ham-switch "--add-clean"
  "The switch that Bsfilter uses to register ham messages."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
  "The switch that Bsfilter uses to unregister ham messages."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
  "The switch that Bsfilter uses to unregister spam messages."
  :type 'string
  :group 'spam-bsfilter)

(defcustom spam-bsfilter-database-directory nil
  "Directory path of the Bsfilter databases."
  :type '(choice (directory
553 554
                  :tag "Location of the Bsfilter database directory")
                 (const :tag "Use the default"))
555 556
  :group 'spam-bsfilter)

557 558 559 560 561
(defgroup spam-spamoracle nil
  "Spam spamoracle configuration."
  :group 'spam)

(defcustom spam-spamoracle-database nil
Miles Bader's avatar
Miles Bader committed
562 563
  "Location of spamoracle database file.
When nil, use the default spamoracle database."
564
  :type '(choice (directory :tag "Location of spamoracle database file.")
565
                 (const :tag "Use the default"))
566 567 568 569 570
  :group 'spam-spamoracle)

(defcustom spam-spamoracle-binary (executable-find "spamoracle")
  "Location of the spamoracle binary."
  :type '(choice (directory :tag "Location of the spamoracle binary")
571
                 (const :tag "Use the default"))
572 573
  :group 'spam-spamoracle)

574 575 576 577 578
(defgroup spam-spamassassin nil
  "Spam SpamAssassin configuration."
  :group 'spam)

(make-obsolete-variable 'spam-spamassassin-path
579
  'spam-spamassassin-program "Gnus 5.10.9 (Emacs 22.1)")
580 581 582 583 584
(defcustom spam-assassin-program (executable-find "spamassassin")
  "Name of the spamassassin program.
Hint: set this to \"spamc\" if you have spamd running.  See the spamc and
spamd man pages for more information on these programs."
  :type '(choice (file :tag "Location of spamc")
585
                 (const :tag "spamassassin is not installed"))
586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609
  :group 'spam-spamassassin)

(defcustom spam-spamassassin-arguments ()
  "Arguments to pass to the spamassassin executable.
This must be a list.  For example, `(\"-C\" \"configfile\")'."
  :type '(restricted-sexp :match-alternatives (listp))
  :group 'spam-spamassassin)

(defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
  "The header inserted by SpamAssassin to flag spam."
  :type 'string
  :group 'spam-spamassassin)

(defcustom spam-spamassassin-positive-spam-flag-header "YES"
  "The regex on `spam-spamassassin-spam-flag-header' for positive spam
identification"
  :type 'string
  :group 'spam-spamassassin)

(defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
  "The header inserted by SpamAssassin, giving extended scoring information"
  :type 'string
  :group 'spam-spamassassin)

610 611
(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program
                        "Gnus 5.10.9 (Emacs 22.1)")
612 613 614
(defcustom spam-sa-learn-program (executable-find "sa-learn")
  "Name of the sa-learn program."
  :type '(choice (file :tag "Location of spamassassin")
615
                 (const :tag "spamassassin is not installed"))
616 617 618 619 620 621 622 623 624 625 626 627
  :group 'spam-spamassassin)

(defcustom spam-sa-learn-rebuild t
  "Whether sa-learn should rebuild the database every time it is called
Enable this if you want sa-learn to rebuild the database automatically.  Doing
this will slightly increase the running time of the spam registration process.
If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
order for SpamAssassin to recognize the new registered spam."
  :type 'boolean
  :group 'spam-spamassassin)

(defcustom spam-sa-learn-spam-switch "--spam"
628
  "The switch that sa-learn uses to register spam messages."
629 630 631 632
  :type 'string
  :group 'spam-spamassassin)

(defcustom spam-sa-learn-ham-switch "--ham"
633
  "The switch that sa-learn uses to register ham messages."
634 635 636 637
  :type 'string
  :group 'spam-spamassassin)

(defcustom spam-sa-learn-unregister-switch "--forget"
638
  "The switch that sa-learn uses to unregister messages messages."
639 640 641 642 643 644 645 646 647 648
  :type 'string
  :group 'spam-spamassassin)

(defgroup spam-crm114 nil
  "Spam CRM114 Mailfilter configuration."
  :group 'spam)

(defcustom spam-crm114-program (executable-find "mailfilter.crm")
  "File path of the CRM114 Mailfilter executable program."
  :type '(choice (file :tag "Location of CRM114 Mailfilter")
649
         (const :tag "CRM114 Mailfilter is not installed"))
650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666
  :group 'spam-crm114)

(defcustom spam-crm114-header "X-CRM114-Status"
  "The header that CRM114 Mailfilter inserts in messages."
  :type 'string
  :group 'spam-crm114)

(defcustom spam-crm114-spam-switch "--learnspam"
  "The switch that CRM114 Mailfilter uses to register spam messages."
  :type 'string
  :group 'spam-crm114)

(defcustom spam-crm114-ham-switch "--learnnonspam"
  "The switch that CRM114 Mailfilter uses to register ham messages."
  :type 'string
  :group 'spam-crm114)

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
667
(defcustom spam-crm114-spam-strong-switch "--unlearn"
668 669 670 671
  "The switch that CRM114 Mailfilter uses to unregister ham messages."
  :type 'string
  :group 'spam-crm114)

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
672
(defcustom spam-crm114-ham-strong-switch "--unlearn"
673 674 675 676 677 678 679 680 681 682 683 684
  "The switch that CRM114 Mailfilter uses to unregister spam messages."
  :type 'string
  :group 'spam-crm114)

(defcustom spam-crm114-positive-spam-header "^SPAM"
  "The regex on `spam-crm114-header' for positive spam identification."
  :type 'regexp
  :group 'spam-crm114)

(defcustom spam-crm114-database-directory nil
  "Directory path of the CRM114 Mailfilter databases."
  :type '(choice (directory
685 686
          :tag "Location of the CRM114 Mailfilter database directory")
         (const :tag "Use the default"))
687 688
  :group 'spam-crm114)

689 690 691
;;; Key bindings for spam control.

(gnus-define-keys gnus-summary-mode-map
692
  "St" spam-generic-score
693
  "Sx" gnus-summary-mark-as-spam
694
  "Mst" spam-generic-score
695
  "Msx" gnus-summary-mark-as-spam
696 697
  "\M-d" gnus-summary-mark-as-spam
  "$" gnus-summary-mark-as-spam)
698

699 700
(defvar spam-cache-lookups t
  "Whether spam.el will try to cache lookups using `spam-caches'.")
701

702
(defvar spam-caches (make-hash-table
703 704
                     :size 10
                     :test 'equal)
705 706 707 708
  "Cache of spam detection entries.")

(defvar spam-old-articles nil
  "List of old ham and spam articles, generated when a group is entered.")
709 710 711 712 713

(defvar spam-split-disabled nil
  "If non-nil, `spam-split' is disabled, and always returns nil.")

(defvar spam-split-last-successful-check nil
714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729
  "Internal variable.
`spam-split' will set this to nil or a spam-use-XYZ check if it
finds ham or spam.")

;; internal variables for backends
;; TODO: find a way to create these on the fly in spam-install-backend-super
(defvar spam-use-copy nil)
(defvar spam-use-move nil)
(defvar spam-use-gmane nil)
(defvar spam-use-resend nil)

;;}}}

;;{{{ convenience functions

(defun spam-clear-cache (symbol)
730
  "Clear the `spam-caches' entry for a check."
731
  (remhash symbol spam-caches))
732 733

(defun spam-xor (a b)
734
  "Logical A xor B."
735 736
  (and (or a b) (not (and a b))))

737
(defun spam-set-difference (list1 list2)
738
  "Return a set difference of LIST1 and LIST2.
739 740 741 742
When either list is nil, the other is returned."
  (if (and list1 list2)
      ;; we have two non-nil lists
      (progn
743 744 745 746 747
        (dolist (item (append list1 list2))
          (when (and (memq item list1) (memq item list2))
            (setq list1 (delq item list1))
            (setq list2 (delq item list2))))
        (append list1 list2))
748 749 750
    ;; if either of the lists was nil, return the other one
    (if list1 list1 list2)))

751
(defun spam-group-ham-mark-p (group mark &optional spam)
752
  "Checks if MARK is considered a ham mark in GROUP."
753 754
  (when (stringp group)
    (let* ((marks (spam-group-ham-marks group spam))
755 756 757
           (marks (if (symbolp mark)
                      marks
                    (mapcar 'symbol-value marks))))
758 759 760
      (memq mark marks))))

(defun spam-group-spam-mark-p (group mark)
761
  "Checks if MARK is considered a spam mark in GROUP."
762 763
  (spam-group-ham-mark-p group mark t))

764
(defun spam-group-ham-marks (group &optional spam)
765
  "In GROUP, get all the ham marks."
766
  (when (stringp group)
767
    (let* ((marks (if spam
768 769 770 771
                      (gnus-parameter-spam-marks group)
                    (gnus-parameter-ham-marks group)))
           (marks (car marks))
           (marks (if (listp (car marks)) (car marks) marks)))
772 773 774
      marks)))

(defun spam-group-spam-marks (group)
775
  "In GROUP, get all the spam marks."
776
  (spam-group-ham-marks group t))
777 778

(defun spam-group-spam-contents-p (group)
779 780
  "Is GROUP a spam group?"
  (if (and (stringp group) (< 0 (length group)))
781
      (or (member group spam-junk-mailgroups)
782 783
          (memq 'gnus-group-spam-classification-spam
                (gnus-parameter-spam-contents group)))
784 785 786
    nil))

(defun spam-group-ham-contents-p (group)
787
  "Is GROUP a ham group?"
788 789
  (if (stringp group)
      (memq 'gnus-group-spam-classification-ham
790
            (gnus-parameter-spam-contents group))
791 792
    nil))

793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818
(defun spam-classifications ()
  "Return list of valid classifications"
  '(spam ham))

(defun spam-classification-valid-p (classification)
  "Is CLASSIFICATION a valid spam/ham classification?"
  (memq classification (spam-classifications)))

(defun spam-backend-properties ()
  "Return list of valid classifications."
  '(statistical mover check hrf srf huf suf))

(defun spam-backend-property-valid-p (property)
  "Is PROPERTY a valid backend property?"
  (memq property (spam-backend-properties)))

(defun spam-backend-function-type-valid-p (type)
  (or (eq type 'registration)
      (eq type 'unregistration)))

(defun spam-process-type-valid-p (process-type)
  (or (eq process-type 'incoming)
      (eq process-type 'process)))

(defun spam-list-articles (articles classification)
  (let ((mark-check (if (eq classification 'spam)
819 820 821
                        'spam-group-spam-mark-p
                      'spam-group-ham-mark-p))
        alist mark-cache-yes mark-cache-no)
822 823
    (dolist (article articles)
      (let ((mark (gnus-summary-article-mark article)))
824 825 826 827 828 829 830 831 832
        (unless (or (memq mark mark-cache-yes)
                    (memq mark mark-cache-no))
          (if (funcall mark-check
                       gnus-newsgroup-name
                       mark)
              (push mark mark-cache-yes)
            (push mark mark-cache-no)))
        (when (memq mark mark-cache-yes)
          (push article alist))))
833 834 835 836 837 838 839 840 841 842 843 844 845 846 847
    alist))

;;}}}

;;{{{ backend installation functions and procedures

(defun spam-install-backend-super (backend &rest properties)
  "Install BACKEND for spam.el.
Accepts incoming CHECK, ham registration function HRF, spam
registration function SRF, ham unregistration function HUF, spam
unregistration function SUF, and an indication whether the
backend is STATISTICAL."
  (setq spam-backends (add-to-list 'spam-backends backend))
  (while properties
    (let ((property (pop properties))
848
          (value (pop properties)))
849
      (if (spam-backend-property-valid-p property)
850 851 852 853 854
          (put backend property value)
        (gnus-error
         5
         "spam-install-backend-super got an invalid property %s"
         property)))))
855 856 857 858 859 860 861 862

(defun spam-backend-list (&optional type)
  "Return a list of all the backend symbols, constrained by TYPE.
When TYPE is 'non-mover, only non-mover backends are returned.
When TYPE is 'mover, only mover backends are returned."
  (let (list)
    (dolist (backend spam-backends)
      (when (or
863 864 865 866 867 868 869 870 871 872
             (null type)                ;either no type was requested
             ;; or the type is 'mover and the backend is a mover
             (and
              (eq type 'mover)
              (spam-backend-mover-p backend))
             ;; or the type is 'non-mover and the backend is not a mover
             (and
              (eq type 'non-mover)
              (not (spam-backend-mover-p backend))))
        (push backend list)))
873 874 875 876 877 878 879 880 881
      list))

(defun spam-backend-check (backend)
  "Get the check function for BACKEND.
Each individual check may return nil, t, or a mailgroup name.
The value nil means that the check does not yield a decision, and
so, that further checks are needed.  The value t means that the
message is definitely not spam, and that further spam checks
should be inhibited.  Otherwise, a mailgroup name or the symbol
882
'spam (depending on `spam-split-symbolic-return') is returned where
883 884 885 886 887 888 889 890 891 892 893 894 895
the mail should go, and further checks are also inhibited.  The
usual mailgroup name is the value of `spam-split-group', meaning
that the message is definitely a spam."
  (get backend 'check))

(defun spam-backend-valid-p (backend)
  "Is BACKEND valid?"
  (member backend (spam-backend-list)))

(defun spam-backend-info (backend)
  "Return information about BACKEND."
  (if (spam-backend-valid-p backend)
      (let (info)
896 897 898 899 900 901 902 903
        (setq info (format "Backend %s has the following properties:\n"
                           backend))
        (dolist (property (spam-backend-properties))
          (setq info (format "%s%s=%s\n"
                             info
                             property
                             (get backend property))))
        info)
904
    (gnus-error 5 "spam-backend-info was asked about an invalid backend %s"
905
                backend)))
906 907 908 909 910 911 912 913

(defun spam-backend-function (backend classification type)
  "Get the BACKEND function for CLASSIFICATION and TYPE.
TYPE is 'registration or 'unregistration.
CLASSIFICATION is 'ham or 'spam."
  (if (and
       (spam-classification-valid-p classification)
       (spam-backend-function-type-valid-p type))
914
      (let ((retrieval
915 916 917 918 919
             (intern
              (format "spam-backend-%s-%s-function"
                      classification
                      type))))
        (funcall retrieval backend))
920
    (gnus-error
921 922 923 924 925 926 927
     5
     "%s was passed invalid backend %s, classification %s, or type %s"
     "spam-backend-function"
     backend
     classification
     type)))

928
(defun spam-backend-article-list-property (classification
929
                                           &optional unregister)
930 931
  "Property name of article list with CLASSIFICATION and UNREGISTER."
  (let* ((r (if unregister "unregister" "register"))
932
         (prop (format "%s-%s" classification r)))
933 934
    prop))

935
(defun spam-backend-get-article-todo-list (backend
936 937
                                           classification
                                           &optional unregister)
938
  "Get the articles to be processed for BACKEND and CLASSIFICATION.
939 940 941
With UNREGISTER, get articles to be unregistered.
This is a temporary storage function - nothing here persists."
  (get
942
   backend
943 944
   (intern (spam-backend-article-list-property classification unregister))))

945 946
(defun spam-backend-put-article-todo-list (backend classification list
                                                   &optional unregister)
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984
  "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
With UNREGISTER, set articles to be unregistered.
This is a temporary storage function - nothing here persists."
  (put
   backend
   (intern (spam-backend-article-list-property classification unregister))
   list))

(defun spam-backend-ham-registration-function (backend)
  "Get the ham registration function for BACKEND."
  (get backend 'hrf))

(defun spam-backend-spam-registration-function (backend)
  "Get the spam registration function for BACKEND."
  (get backend 'srf))

(defun spam-backend-ham-unregistration-function (backend)
  "Get the ham unregistration function for BACKEND."
  (get backend 'huf))

(defun spam-backend-spam-unregistration-function (backend)
  "Get the spam unregistration function for BACKEND."
  (get backend 'suf))

(defun spam-backend-statistical-p (backend)
  "Is BACKEND statistical?"
  (get backend 'statistical))

(defun spam-backend-mover-p (backend)
  "Is BACKEND a mover?"
  (get backend 'mover))

(defun spam-install-backend-alias (backend alias)
  "Add ALIAS to an existing BACKEND.
The previous backend settings for ALIAS are erased."

  ;; install alias with no properties at first
  (spam-install-backend-super alias)
985

986 987 988 989 990 991 992 993 994 995 996 997 998
  (dolist (property (spam-backend-properties))
    (put alias property (get backend property))))

(defun spam-install-checkonly-backend (backend check)
  "Install a BACKEND than can only CHECK for spam."
  (spam-install-backend-super backend 'check check))

(defun spam-install-mover-backend (backend hrf srf huf suf)
  "Install a BACKEND than can move articles at summary exit.
Accepts ham registration function HRF, spam registration function
SRF, ham unregistration function HUF, spam unregistration
function SUF.  The backend has no incoming check and can't be
statistical."
999 1000
  (spam-install-backend-super
   backend
1001 1002 1003 1004 1005 1006 1007 1008
   'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t))

(defun spam-install-nocheck-backend (backend hrf srf huf suf)
  "Install a BACKEND than has no check.
Accepts ham registration function HRF, spam registration function
SRF, ham unregistration function HUF, spam unregistration
function SUF.  The backend has no incoming check and can't be
statistical (it could be, but in practice that doesn't happen)."
1009
  (spam-install-backend-super
1010 1011 1012 1013 1014 1015 1016 1017
   backend
   'hrf hrf 'srf srf 'huf huf 'suf suf))

(defun spam-install-backend (backend check hrf srf huf suf)
  "Install a BACKEND.
Accepts incoming CHECK, ham registration function HRF, spam
registration function SRF, ham unregistration function HUF, spam
unregistration function SUF.  The backend won't be
1018 1019
statistical (use `spam-install-statistical-backend' for that)."
  (spam-install-backend-super
1020 1021 1022 1023 1024 1025 1026 1027
   backend
   'check check 'hrf hrf 'srf srf 'huf huf 'suf suf))

(defun spam-install-statistical-backend (backend check hrf srf huf suf)
  "Install a BACKEND.
Accepts incoming CHECK, ham registration function HRF, spam
registration function SRF, ham unregistration function HUF, spam
unregistration function SUF.  The backend will be
1028
statistical (use `spam-install-backend' for non-statistical
1029
backends)."
1030
  (spam-install-backend-super
1031 1032 1033 1034 1035
   backend
   'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf))

(defun spam-install-statistical-checkonly-backend (backend check)
  "Install a statistical BACKEND than can only CHECK for spam."
1036
  (spam-install-backend-super
1037 1038 1039 1040 1041 1042 1043
   backend
   'check check 'statistical t))

;;}}}

;;{{{ backend installations
(spam-install-checkonly-backend 'spam-use-blackholes
1044
                                'spam-check-blackholes)
1045 1046

(spam-install-checkonly-backend 'spam-use-hashcash
1047
                                'spam-check-hashcash)
1048 1049

(spam-install-checkonly-backend 'spam-use-spamassassin-headers
1050
                                'spam-check-spamassassin-headers)
1051 1052

(spam-install-checkonly-backend 'spam-use-bogofilter-headers
1053
                                'spam-check-bogofilter-headers)
1054 1055

(spam-install-checkonly-backend 'spam-use-bsfilter-headers
1056
                                'spam-check-bsfilter-headers)
1057 1058

(spam-install-checkonly-backend 'spam-use-gmane-xref
1059
                                'spam-check-gmane-xref)
1060 1061

(spam-install-checkonly-backend 'spam-use-regex-headers
1062
                                'spam-check-regex-headers)
1063 1064

(spam-install-statistical-checkonly-backend 'spam-use-regex-body
1065
                                            'spam-check-regex-body)
1066

1067
;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy)
1068
(spam-install-mover-backend 'spam-use-move
1069 1070 1071 1072
                            'spam-move-ham-routine
                            'spam-move-spam-routine
                            nil
                            nil)
1073 1074

(spam-install-nocheck-backend 'spam-use-copy
1075 1076 1077 1078
                              'spam-copy-ham-routine
                              'spam-copy-spam-routine
                              nil
                              nil)
1079 1080

(spam-install-nocheck-backend 'spam-use-gmane
1081 1082 1083 1084
                              'spam-report-gmane-unregister-routine
                              'spam-report-gmane-register-routine
                              'spam-report-gmane-register-routine
                              'spam-report-gmane-unregister-routine)
1085 1086

(spam-install-nocheck-backend 'spam-use-resend
1087 1088 1089 1090
                              'spam-report-resend-register-ham-routine
                              'spam-report-resend-register-routine
                              nil
                              nil)
1091

1092
(spam-install-backend 'spam-use-BBDB
1093 1094 1095 1096 1097
                      'spam-check-BBDB
                      'spam-BBDB-register-routine
                      nil
                      'spam-BBDB-unregister-routine
                      nil)
1098 1099 1100 1101

(spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive)

(spam-install-backend 'spam-use-blacklist
1102 1103 1104 1105 1106
                      'spam-check-blacklist
                      nil
                      'spam-blacklist-register-routine
                      nil
                      'spam-blacklist-unregister-routine)
1107 1108

(spam-install-backend 'spam-use-whitelist
1109 1110 1111 1112 1113
                      'spam-check-whitelist
                      'spam-whitelist-register-routine
                      nil
                      'spam-whitelist-unregister-routine
                      nil)
1114 1115

(spam-install-statistical-backend 'spam-use-ifile
1116 1117 1118 1119 1120
                                  'spam-check-ifile
                                  'spam-ifile-register-ham-routine
                                  'spam-ifile-register-spam-routine
                                  'spam-ifile-unregister-ham-routine
                                  'spam-ifile-unregister-spam-routine)
1121 1122

(spam-install-statistical-backend 'spam-use-spamoracle
1123 1124 1125 1126 1127
                                  'spam-check-spamoracle
                                  'spam-spamoracle-learn-ham
                                  'spam-spamoracle-learn-spam
                                  'spam-spamoracle-unlearn-ham
                                  'spam-spamoracle-unlearn-spam)
1128 1129

(spam-install-statistical-backend 'spam-use-stat
1130 1131 1132 1133 1134
                                  'spam-check-stat
                                  'spam-stat-register-ham-routine
                                  'spam-stat-register-spam-routine
                                  'spam-stat-unregister-ham-routine
                                  'spam-stat-unregister-spam-routine)
1135

1136
(spam-install-statistical-backend 'spam-use-spamassassin
1137 1138 1139 1140 1141
                                  'spam-check-spamassassin
                                  'spam-spamassassin-register-ham-routine
                                  'spam-spamassassin-register-spam-routine
                                  'spam-spamassassin-unregister-ham-routine
                                  'spam-spamassassin-unregister-spam-routine)
1142 1143

(spam-install-statistical-backend 'spam-use-bogofilter
1144 1145 1146 1147 1148
                                  'spam-check-bogofilter
                                  'spam-bogofilter-register-ham-routine
                                  'spam-bogofilter-register-spam-routine
                                  'spam-bogofilter-unregister-ham-routine
                                  'spam-bogofilter-unregister-spam-routine)
1149 1150

(spam-install-statistical-backend 'spam-use-bsfilter
1151 1152 1153 1154 1155
                                  'spam-check-bsfilter
                                  'spam-bsfilter-register-ham-routine
                                  'spam-bsfilter-register-spam-routine
                                  'spam-bsfilter-unregister-ham-routine
                                  'spam-bsfilter-unregister-spam-routine)
1156 1157

(spam-install-statistical-backend 'spam-use-crm114
1158 1159 1160 1161 1162
                                  'spam-check-crm114
                                  'spam-crm114-register-ham-routine
                                  'spam-crm114-register-spam-routine
                                  'spam-crm114-unregister-ham-routine
                                  'spam-crm114-unregister-spam-routine)
1163 1164 1165 1166 1167 1168 1169
;;}}}

;;{{{ scoring and summary formatting
(defun spam-necessary-extra-headers ()
  "Return the extra headers spam.el thinks are necessary."
  (let (list)
    (when (or spam-use-spamassassin
1170 1171
              spam-use-spamassassin-headers
              spam-use-regex-headers)
1172 1173
      (push 'X-Spam-Status list))
    (when (or spam-use-bogofilter
1174
              spam-use-regex-headers)
1175 1176
      (push 'X-Bogosity list))
    (when (or spam-use-crm114
1177
              spam-use-regex-headers)
1178 1179 1180 1181 1182 1183
      (push 'X-CRM114-Status list))
    list))

(defun spam-user-format-function-S (headers)
  (when headers
    (format "%3.2f"
1184
            (spam-summary-score headers spam-summary-score-preferred-header))))
1185 1186 1187 1188 1189 1190

(defun spam-article-sort-by-spam-status (h1 h2)
  "Sort articles by score."
  (let (result)
    (dolist (header (spam-necessary-extra-headers))
      (let ((s1 (spam-summary-score h1 header))
1191
            (s2 (spam-summary-score h2 header)))