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

3
;; Copyright (C) 2002-2011  Free Software Foundation, Inc.
4 5

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

;; This file is part of GNU Emacs.

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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17

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

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

;;; 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

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

;;; Code:

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

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

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

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

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

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

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

;; autoload spam-report
(eval-and-compile
64 65 66 67
  (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"))
68 69

;; autoload gnus-registry
70
(autoload 'gnus-registry-group-count "gnus-registry")
71 72 73
(autoload 'gnus-registry-get-id-key "gnus-registry")
(autoload 'gnus-registry-set-id-key "gnus-registry")
(autoload 'gnus-registry-handle-action "gnus-registry")
74

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

78 79 80 81 82
;;}}}

;;{{{ Main parameters.
(defvar spam-backends nil
  "List of spam.el backends with all the pertinent data.
83
Populated by `spam-install-backend-super'.")
84 85

(defgroup spam nil
86
  "Spam configuration."
87 88 89
  :version "22.1"
  :group 'mail
  :group 'news)
90

91 92
(defcustom spam-summary-exit-behavior 'default
  "Exit behavior at the time of summary exit.
93
Note that setting the `spam-use-move' or `spam-use-copy' backends on
94
a group through group/topic parameters overrides this mechanism."
95 96 97 98 99 100 101 102 103 104
  :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."))
105 106
  :group 'spam)

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

112 113 114 115 116 117
(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)

118 119 120 121 122 123 124 125 126 127 128 129
(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.
130
Do not set this if you use `spam-split' in a fancy split method."
131 132 133 134 135 136 137 138 139 140 141 142 143
  :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.
144
The article is moved out of a spam group according to `ham-process-destination'.
145 146 147 148 149 150
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
151 152 153
  "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
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
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
179
  "Whether `query-dig' should be used instead of `dns-query'."
180 181 182
  :type 'boolean
  :group 'spam)

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

188 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
(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)

244 245 246 247 248 249 250 251 252 253 254 255
(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)

256 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
(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)

283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300
(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)

301
(defcustom spam-install-hooks (or
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
                               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)
323 324 325 326 327 328 329 330 331 332 333 334 335
  "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
336 337
                                 spam-split-group
                                 '("mail.junk" "poste.pourriel"))
338 339 340 341 342
  "Mailgroups with spam contents.
All unmarked article in such group receive the spam mark on group entry."
  :type '(repeat (string :tag "Group"))
  :group 'spam)

343 344 345 346 347 348 349

(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)

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

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

363
(defface spam
364 365 366 367 368 369 370 371 372
  '((((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))
373 374
  "Face for spam-marked articles."
  :group 'spam)
375 376
;; backward-compatibility alias
(put 'spam-face 'face-alias 'spam)
377
(put 'spam-face 'obsolete-face "22.1")
378

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

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

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

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

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

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

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

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

428 429
(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database
                        "Gnus 5.10.9 (Emacs 22.1)")
Miles Bader's avatar
Miles Bader committed
430 431
(defcustom spam-ifile-database nil
  "File name of the ifile database."
432
  :type '(choice (file :tag "Location of the ifile database")
433
                 (const :tag "Use the default"))
434 435 436 437 438 439 440 441 442 443 444
  :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")
445
                 (const :tag "Use the current group name"))
446 447 448 449 450 451 452 453 454 455 456 457 458
  :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)

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

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

469 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
(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
500 501
  "Location of the Bogofilter database.
When nil, use the default location."
502
  :type '(choice (directory
503 504
                  :tag "Location of the Bogofilter database directory")
                 (const :tag "Use the default"))
505 506
  :group 'spam-bogofilter)

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

511 512
(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program
                        "Gnus 5.10.9 (Emacs 22.1)")
513 514 515
(defcustom spam-bsfilter-program (executable-find "bsfilter")
  "Name of the Bsfilter program."
  :type '(choice (file :tag "Location of bsfilter")
516
                 (const :tag "Bsfilter is not installed"))
517 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
  :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
552 553
                  :tag "Location of the Bsfilter database directory")
                 (const :tag "Use the default"))
554 555
  :group 'spam-bsfilter)

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

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

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

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

(make-obsolete-variable 'spam-spamassassin-path
578
  'spam-spamassassin-program "Gnus 5.10.9 (Emacs 22.1)")
579 580 581 582 583
(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")
584
                 (const :tag "spamassassin is not installed"))
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608
  :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)

609 610
(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program
                        "Gnus 5.10.9 (Emacs 22.1)")
611 612 613
(defcustom spam-sa-learn-program (executable-find "sa-learn")
  "Name of the sa-learn program."
  :type '(choice (file :tag "Location of spamassassin")
614
                 (const :tag "spamassassin is not installed"))
615 616 617 618 619 620 621 622 623 624 625 626
  :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"
627
  "The switch that sa-learn uses to register spam messages."
628 629 630 631
  :type 'string
  :group 'spam-spamassassin)

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

(defcustom spam-sa-learn-unregister-switch "--forget"
637
  "The switch that sa-learn uses to unregister messages messages."
638 639 640 641 642 643 644 645 646 647
  :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")
648
         (const :tag "CRM114 Mailfilter is not installed"))
649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665
  :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
666
(defcustom spam-crm114-spam-strong-switch "--unlearn"
667 668 669 670
  "The switch that CRM114 Mailfilter uses to unregister ham messages."
  :type 'string
  :group 'spam-crm114)

Katsumi Yamaoka's avatar
Katsumi Yamaoka committed
671
(defcustom spam-crm114-ham-strong-switch "--unlearn"
672 673 674 675 676 677 678 679 680 681 682 683
  "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
684 685
          :tag "Location of the CRM114 Mailfilter database directory")
         (const :tag "Use the default"))
686 687
  :group 'spam-crm114)

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

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

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

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

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

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

(defvar spam-split-last-successful-check nil
713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728
  "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)
729
  "Clear the `spam-caches' entry for a check."
730
  (remhash symbol spam-caches))
731 732

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

736
(defun spam-set-difference (list1 list2)
737
  "Return a set difference of LIST1 and LIST2.
738 739 740 741
When either list is nil, the other is returned."
  (if (and list1 list2)
      ;; we have two non-nil lists
      (progn
742 743 744 745 746
        (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))
747 748 749
    ;; if either of the lists was nil, return the other one
    (if list1 list1 list2)))

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

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

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

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

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

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

792 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
(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)
818 819 820
                        'spam-group-spam-mark-p
                      'spam-group-ham-mark-p))
        alist mark-cache-yes mark-cache-no)
821 822
    (dolist (article articles)
      (let ((mark (gnus-summary-article-mark article)))
823 824 825 826 827 828 829 830 831
        (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))))
832 833 834 835 836 837 838 839 840 841 842 843 844 845 846
    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))
847
          (value (pop properties)))
848
      (if (spam-backend-property-valid-p property)
849 850 851 852 853
          (put backend property value)
        (gnus-error
         5
         "spam-install-backend-super got an invalid property %s"
         property)))))
854 855 856 857 858 859 860 861

(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
862 863 864 865 866 867 868 869 870 871
             (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)))
872 873 874 875 876 877 878 879 880
      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
881
'spam (depending on `spam-split-symbolic-return') is returned where
882 883 884 885 886 887 888 889 890 891 892 893 894
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)
895 896 897 898 899 900 901 902
        (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)
903
    (gnus-error 5 "spam-backend-info was asked about an invalid backend %s"
904
                backend)))
905 906 907 908 909 910 911 912

(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))
913
      (let ((retrieval
914 915 916 917 918
             (intern
              (format "spam-backend-%s-%s-function"
                      classification
                      type))))
        (funcall retrieval backend))
919
    (gnus-error
920 921 922 923 924 925 926
     5
     "%s was passed invalid backend %s, classification %s, or type %s"
     "spam-backend-function"
     backend
     classification
     type)))

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

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

944 945
(defun spam-backend-put-article-todo-list (backend classification list
                                                   &optional unregister)
946 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
  "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)
984

985 986 987 988 989 990 991 992 993 994 995 996 997
  (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."
998 999
  (spam-install-backend-super
   backend
1000 1001 1002 1003 1004 1005 1006 1007
   '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)."
1008
  (spam-install-backend-super
1009 1010 1011 1012 1013 1014 1015 1016
   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
1017 1018
statistical (use `spam-install-statistical-backend' for that)."
  (spam-install-backend-super
1019 1020 1021 1022 1023 1024 1025 1026
   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
1027
statistical (use `spam-install-backend' for non-statistical
1028
backends)."
1029
  (spam-install-backend-super
1030 1031 1032 1033 1034
   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."
1035
  (spam-install-backend-super
1036 1037 1038 1039 1040 1041 1042
   backend
   'check check 'statistical t))

;;}}}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

;;{{{ 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
1169 1170
              spam-use-spamassassin-headers
              spam-use-regex-headers)
1171 1172
      (push 'X-Spam-Status list))
    (when (or spam-use-bogofilter
1173
              spam-use-regex-headers)
1174 1175
      (push 'X-Bogosity list))
    (when (or spam-use-crm114
1176
              spam-use-regex-headers)
1177 1178 1179 1180 1181 1182
      (push 'X-CRM114-Status list))
    list))

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

(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))
1190
            (s2 (spam-summary-score h2 header)))