lisp/gnus/spam.el

   1 ;;; spam.el --- Identifying spam
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: network
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; This module addresses a few aspects of spam control under Gnus.  Page
  28 ;;; breaks are used for grouping declarations and documentation relating to
  29 ;;; each particular aspect.
  30
  31 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
  32 ;;; comments, below, for supplementary explanations or discussions.
  33
  34 ;;; Several TODO items are marked as such
  35
  36 ;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
  37 ;; remote processing, training through files
  38
  39 ;;; Code:
  40
  41 (eval-when-compile (require 'cl))
  42
  43 (require 'gnus-sum)
  44
  45 (require 'gnus-uu)                      ; because of key prefix issues
  46 ;;; for the definitions of group content classification and spam processors
  47 (require 'gnus)
  48 (require 'message)              ;for the message-fetch-field functions
  49
  50 ;; for nnimap-split-download-body-default
  51 (eval-when-compile (require 'nnimap))
  52
  53 ;; autoload executable-find
  54 (eval-and-compile
  55   ;; executable-find is not autoloaded in Emacs 20
  56   (autoload 'executable-find "executable"))
  57
  58 ;; autoload query-dig
  59 (eval-and-compile
  60   (autoload 'query-dig "dig"))
  61
  62 ;; autoload spam-report
  63 (eval-and-compile
  64   (autoload 'spam-report-gmane "spam-report"))
  65
  66 ;; autoload gnus-registry
  67 (eval-and-compile
  68   (autoload 'gnus-registry-group-count "gnus-registry")
  69   (autoload 'gnus-registry-add-group "gnus-registry")
  70   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
  71   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
  72
  73 ;; autoload query-dns
  74 (eval-and-compile
  75   (autoload 'query-dns "dns"))
  76
  77 ;;; Main parameters.
  78
  79 (defgroup spam nil
  80   "Spam configuration."
  81   :version "22.1"
  82   :group 'mail
  83   :group 'news)
  84
  85 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
  86   "Directory for spam whitelists and blacklists."
  87   :type 'directory
  88   :group 'spam)
  89
  90 (defcustom spam-move-spam-nonspam-groups-only t
  91   "Whether spam should be moved in non-spam groups only.
  92 When t, only ham and unclassified groups will have their spam moved
  93 to the spam-process-destination.  When nil, spam will also be moved from
  94 spam groups."
  95   :type 'boolean
  96   :group 'spam)
  97
  98 (defcustom spam-process-ham-in-nonham-groups nil
  99   "Whether ham should be processed in non-ham groups."
 100   :type 'boolean
 101   :group 'spam)
 102
 103 (defcustom spam-mark-new-messages-in-spam-group-as-spam t
 104   "Whether new messages in a spam group should get the spam-mark."
 105   :type 'boolean
 106   ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3
 107   :group 'spam)
 108
 109 (defcustom spam-log-to-registry nil
 110   "Whether spam/ham processing should be logged in the registry."
 111   :type 'boolean
 112   :group 'spam)
 113
 114 (defcustom spam-split-symbolic-return nil
 115   "Whether `spam-split' should work with symbols or group names."
 116   :type 'boolean
 117   :group 'spam)
 118
 119 (defcustom spam-split-symbolic-return-positive nil
 120   "Whether `spam-split' should ALWAYS work with symbols or group names.
 121 Do not set this if you use `spam-split' in a fancy split
 122   method."
 123   :type 'boolean
 124   :group 'spam)
 125
 126 (defcustom spam-process-ham-in-spam-groups nil
 127   "Whether ham should be processed in spam groups."
 128   :type 'boolean
 129   :group 'spam)
 130
 131 (defcustom spam-mark-only-unseen-as-spam t
 132   "Whether only unseen articles should be marked as spam in spam groups.
 133 When nil, all unread articles in a spam group are marked as
 134 spam.  Set this if you want to leave an article unread in a spam group
 135 without losing it to the automatic spam-marking process."
 136   :type 'boolean
 137   :group 'spam)
 138
 139 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
 140   "Whether ham should be marked unread before it's moved.
 141 The article is moved out of a spam group according to ham-process-destination.
 142 This variable is an official entry in the international Longest Variable Name
 143 Competition."
 144   :type 'boolean
 145   :group 'spam)
 146
 147 (defcustom spam-disable-spam-split-during-ham-respool nil
 148   "Whether `spam-split' should be ignored while resplitting ham in a process
 149 destination.  This is useful to prevent ham from ending up in the same spam
 150 group after the resplit.  Don't set this to t if you have spam-split as the
 151 last rule in your split configuration."
 152   :type 'boolean
 153   :group 'spam)
 154
 155 (defcustom spam-autodetect-recheck-messages nil
 156   "Should spam.el recheck all meessages when autodetecting?
 157 Normally this is nil, so only unseen messages will be checked."
 158   :type 'boolean
 159   :group 'spam)
 160
 161 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
 162   "The location of the whitelist.
 163 The file format is one regular expression per line.
 164 The regular expression is matched against the address."
 165   :type 'file
 166   :group 'spam)
 167
 168 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
 169   "The location of the blacklist.
 170 The file format is one regular expression per line.
 171 The regular expression is matched against the address."
 172   :type 'file
 173   :group 'spam)
 174
 175 (defcustom spam-use-dig t
 176   "Whether `query-dig' should be used instead of `query-dns'."
 177   :type 'boolean
 178   :group 'spam)
 179
 180 (defcustom spam-use-blacklist nil
 181   "Whether the blacklist should be used by `spam-split'."
 182   :type 'boolean
 183   :group 'spam)
 184
 185 (defcustom spam-blacklist-ignored-regexes nil
 186   "Regular expressions that the blacklist should ignore."
 187   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
 188   :group 'spam)
 189
 190 (defcustom spam-use-whitelist nil
 191   "Whether the whitelist should be used by `spam-split'."
 192   :type 'boolean
 193   :group 'spam)
 194
 195 (defcustom spam-use-whitelist-exclusive nil
 196   "Whether whitelist-exclusive should be used by `spam-split'.
 197 Exclusive whitelisting means that all messages from senders not in the whitelist
 198 are considered spam."
 199   :type 'boolean
 200   :group 'spam)
 201
 202 (defcustom spam-use-blackholes nil
 203   "Whether blackholes should be used by `spam-split'."
 204   :type 'boolean
 205   :group 'spam)
 206
 207 (defcustom spam-use-hashcash nil
 208   "Whether hashcash payments should be detected by `spam-split'."
 209   :type 'boolean
 210   :group 'spam)
 211
 212 (defcustom spam-use-regex-headers nil
 213   "Whether a header regular expression match should be used by `spam-split'.
 214 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
 215   :type 'boolean
 216   :group 'spam)
 217
 218 (defcustom spam-use-regex-body nil
 219   "Whether a body regular expression match should be used by `spam-split'.
 220 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
 221   :type 'boolean
 222   :group 'spam)
 223
 224 (defcustom spam-use-bogofilter-headers nil
 225   "Whether bogofilter headers should be used by `spam-split'.
 226 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 227   :type 'boolean
 228   :group 'spam)
 229
 230 (defcustom spam-use-bogofilter nil
 231   "Whether bogofilter should be invoked by `spam-split'.
 232 Enable this if you want Gnus to invoke Bogofilter on new messages."
 233   :type 'boolean
 234   :group 'spam)
 235
 236 (defcustom spam-use-BBDB nil
 237   "Whether BBDB should be used by `spam-split'."
 238   :type 'boolean
 239   :group 'spam)
 240
 241 (defcustom spam-use-BBDB-exclusive nil
 242   "Whether BBDB-exclusive should be used by `spam-split'.
 243 Exclusive BBDB means that all messages from senders not in the BBDB are
 244 considered spam."
 245   :type 'boolean
 246   :group 'spam)
 247
 248 (defcustom spam-use-ifile nil
 249   "Whether ifile should be used by `spam-split'."
 250   :type 'boolean
 251   :group 'spam)
 252
 253 (defcustom spam-use-stat nil
 254   "Whether `spam-stat' should be used by `spam-split'."
 255   :type 'boolean
 256   :group 'spam)
 257
 258 (defcustom spam-use-spamoracle nil
 259   "Whether spamoracle should be used by `spam-split'."
 260   :type 'boolean
 261   :group 'spam)
 262
 263 (defcustom spam-install-hooks (or
 264                                spam-use-dig
 265                                spam-use-blacklist
 266                                spam-use-whitelist
 267                                spam-use-whitelist-exclusive
 268                                spam-use-blackholes
 269                                spam-use-hashcash
 270                                spam-use-regex-headers
 271                                spam-use-regex-body
 272                                spam-use-bogofilter-headers
 273                                spam-use-bogofilter
 274                                spam-use-BBDB
 275                                spam-use-BBDB-exclusive
 276                                spam-use-ifile
 277                                spam-use-stat
 278                                spam-use-spamoracle)
 279   "Whether the spam hooks should be installed.
 280 Default to t if one of the spam-use-* variables is set."
 281   :group 'spam
 282   :type 'boolean)
 283
 284 (defcustom spam-split-group "spam"
 285   "Group name where incoming spam should be put by `spam-split'."
 286   :type 'string
 287   :group 'spam)
 288
 289 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
 290 ;;; not regular expressions
 291 (defcustom spam-junk-mailgroups (cons
 292                                  spam-split-group
 293                                  '("mail.junk" "poste.pourriel"))
 294   "Mailgroups with spam contents.
 295 All unmarked article in such group receive the spam mark on group entry."
 296   :type '(repeat (string :tag "Group"))
 297   :group 'spam)
 298
 299 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 300                                     "dev.null.dk" "relays.visi.com")
 301   "List of blackhole servers."
 302   :type '(repeat (string :tag "Server"))
 303   :group 'spam)
 304
 305 (defcustom spam-blackhole-good-server-regex nil
 306   "String matching IP addresses that should not be checked in the blackholes."
 307   :type '(radio (const nil) regexp)
 308   :group 'spam)
 309
 310 (defface spam
 311   '((((class color) (type tty) (background dark))
 312      (:foreground "gray80" :background "gray50"))
 313     (((class color) (type tty) (background light))
 314      (:foreground "gray50" :background "gray80"))
 315     (((class color) (background dark))
 316      (:foreground "ivory2"))
 317     (((class color) (background light))
 318      (:foreground "ivory4"))
 319     (t :inverse-video t))
 320   "Face for spam-marked articles."
 321   :group 'spam)
 322 ;; backward-compatibility alias
 323 (put 'spam-face 'face-alias 'spam)
 324
 325 (defcustom spam-face 'spam
 326   "Face for spam-marked articles."
 327   :type 'face
 328   :group 'spam)
 329
 330 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 331   "Regular expression for positive header spam matches."
 332   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 333   :group 'spam)
 334
 335 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 336   "Regular expression for positive header ham matches."
 337   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 338   :group 'spam)
 339
 340 (defcustom spam-regex-body-spam '()
 341   "Regular expression for positive body spam matches."
 342   :type '(repeat (regexp :tag "Regular expression to match spam body"))
 343   :group 'spam)
 344
 345 (defcustom spam-regex-body-ham '()
 346   "Regular expression for positive body ham matches."
 347   :type '(repeat (regexp :tag "Regular expression to match ham body"))
 348   :group 'spam)
 349
 350 (defgroup spam-ifile nil
 351   "Spam ifile configuration."
 352   :group 'spam)
 353
 354 (defcustom spam-ifile-path (executable-find "ifile")
 355   "File path of the ifile executable program."
 356   :type '(choice (file :tag "Location of ifile")
 357                  (const :tag "ifile is not installed"))
 358   :group 'spam-ifile)
 359
 360 (defcustom spam-ifile-database-path nil
 361   "File path of the ifile database."
 362   :type '(choice (file :tag "Location of the ifile database")
 363                  (const :tag "Use the default"))
 364   :group 'spam-ifile)
 365
 366 (defcustom spam-ifile-spam-category "spam"
 367   "Name of the spam ifile category."
 368   :type 'string
 369   :group 'spam-ifile)
 370
 371 (defcustom spam-ifile-ham-category nil
 372   "Name of the ham ifile category.
 373 If nil, the current group name will be used."
 374   :type '(choice (string :tag "Use a fixed category")
 375                  (const :tag "Use the current group name"))
 376   :group 'spam-ifile)
 377
 378 (defcustom spam-ifile-all-categories nil
 379   "Whether the ifile check will return all categories, or just spam.
 380 Set this to t if you want to use the `spam-split' invocation of ifile as
 381 your main source of newsgroup names."
 382   :type 'boolean
 383   :group 'spam-ifile)
 384
 385 (defgroup spam-bogofilter nil
 386   "Spam bogofilter configuration."
 387   :group 'spam)
 388
 389 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 390   "File path of the Bogofilter executable program."
 391   :type '(choice (file :tag "Location of bogofilter")
 392                  (const :tag "Bogofilter is not installed"))
 393   :group 'spam-bogofilter)
 394
 395 (defcustom spam-bogofilter-header "X-Bogosity"
 396   "The header that Bogofilter inserts in messages."
 397   :type 'string
 398   :group 'spam-bogofilter)
 399
 400 (defcustom spam-bogofilter-spam-switch "-s"
 401   "The switch that Bogofilter uses to register spam messages."
 402   :type 'string
 403   :group 'spam-bogofilter)
 404
 405 (defcustom spam-bogofilter-ham-switch "-n"
 406   "The switch that Bogofilter uses to register ham messages."
 407   :type 'string
 408   :group 'spam-bogofilter)
 409
 410 (defcustom spam-bogofilter-spam-strong-switch "-S"
 411   "The switch that Bogofilter uses to unregister ham messages."
 412   :type 'string
 413   :group 'spam-bogofilter)
 414
 415 (defcustom spam-bogofilter-ham-strong-switch "-N"
 416   "The switch that Bogofilter uses to unregister spam messages."
 417   :type 'string
 418   :group 'spam-bogofilter)
 419
 420 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 421   "The regex on `spam-bogofilter-header' for positive spam identification."
 422   :type 'regexp
 423   :group 'spam-bogofilter)
 424
 425 (defcustom spam-bogofilter-database-directory nil
 426   "Directory path of the Bogofilter databases."
 427   :type '(choice (directory
 428                   :tag "Location of the Bogofilter database directory")
 429                  (const :tag "Use the default"))
 430   :group 'spam-bogofilter)
 431
 432 (defgroup spam-spamoracle nil
 433   "Spam spamoracle configuration."
 434   :group 'spam)
 435
 436 (defcustom spam-spamoracle-database nil
 437   "Location of spamoracle database file. When nil, use the default
 438 spamoracle database."
 439   :type '(choice (directory :tag "Location of spamoracle database file.")
 440                  (const :tag "Use the default"))
 441   :group 'spam-spamoracle)
 442
 443 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
 444   "Location of the spamoracle binary."
 445   :type '(choice (directory :tag "Location of the spamoracle binary")
 446                  (const :tag "Use the default"))
 447   :group 'spam-spamoracle)
 448
 449 ;;; Key bindings for spam control.
 450
 451 (gnus-define-keys gnus-summary-mode-map
 452   "St" spam-bogofilter-score
 453   "Sx" gnus-summary-mark-as-spam
 454   "Mst" spam-bogofilter-score
 455   "Msx" gnus-summary-mark-as-spam
 456   "\M-d" gnus-summary-mark-as-spam)
 457
 458 (defvar spam-old-ham-articles nil
 459   "List of old ham articles, generated when a group is entered.")
 460
 461 (defvar spam-old-spam-articles nil
 462   "List of old spam articles, generated when a group is entered.")
 463
 464 (defvar spam-split-disabled nil
 465   "If non-nil, `spam-split' is disabled, and always returns nil.")
 466
 467 (defvar spam-split-last-successful-check nil
 468   "`spam-split' will set this to nil or a spam-use-XYZ check if it
 469   finds ham or spam.")
 470
 471 ;; convenience functions
 472 (defun spam-xor (a b)
 473   "Logical exclusive `or'."
 474   (and (or a b) (not (and a b))))
 475
 476 (defun spam-group-ham-mark-p (group mark &optional spam)
 477   (when (stringp group)
 478     (let* ((marks (spam-group-ham-marks group spam))
 479            (marks (if (symbolp mark)
 480                       marks
 481                     (mapcar 'symbol-value marks))))
 482       (memq mark marks))))
 483
 484 (defun spam-group-spam-mark-p (group mark)
 485   (spam-group-ham-mark-p group mark t))
 486
 487 (defun spam-group-ham-marks (group &optional spam)
 488   (when (stringp group)
 489     (let* ((marks (if spam
 490                       (gnus-parameter-spam-marks group)
 491                     (gnus-parameter-ham-marks group)))
 492            (marks (car marks))
 493            (marks (if (listp (car marks)) (car marks) marks)))
 494       marks)))
 495
 496 (defun spam-group-spam-marks (group)
 497   (spam-group-ham-marks group t))
 498
 499 (defun spam-group-spam-contents-p (group)
 500   (if (stringp group)
 501       (or (member group spam-junk-mailgroups)
 502           (memq 'gnus-group-spam-classification-spam
 503                 (gnus-parameter-spam-contents group)))
 504     nil))
 505
 506 (defun spam-group-ham-contents-p (group)
 507   (if (stringp group)
 508       (memq 'gnus-group-spam-classification-ham
 509             (gnus-parameter-spam-contents group))
 510     nil))
 511
 512 (defvar spam-list-of-processors
 513   '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
 514     (gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
 515     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
 516     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
 517     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
 518     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
 519     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
 520     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
 521     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
 522     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
 523     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
 524     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
 525     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
 526   "The spam-list-of-processors list contains pairs associating a
 527 ham/spam exit processor variable with a classification and a
 528 spam-use-* variable.")
 529
 530 (defun spam-group-processor-p (group processor)
 531   (if (and (stringp group)
 532            (symbolp processor))
 533       (or (member processor (nth 0 (gnus-parameter-spam-process group)))
 534           (spam-group-processor-multiple-p
 535            group
 536            (cdr-safe (assoc processor spam-list-of-processors))))
 537     nil))
 538
 539 (defun spam-group-processor-multiple-p (group processor-info)
 540   (let* ((classification (nth 0 processor-info))
 541          (check (nth 1 processor-info))
 542          (parameters (nth 0 (gnus-parameter-spam-process group)))
 543          found)
 544     (dolist (parameter parameters)
 545       (when (and (null found)
 546                  (listp parameter)
 547                  (eq classification (nth 0 parameter))
 548                  (eq check (nth 1 parameter)))
 549         (setq found t)))
 550     found))
 551
 552 (defun spam-group-spam-processor-report-gmane-p (group)
 553   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
 554
 555 (defun spam-group-spam-processor-bogofilter-p (group)
 556   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 557
 558 (defun spam-group-spam-processor-blacklist-p (group)
 559   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 560
 561 (defun spam-group-spam-processor-ifile-p (group)
 562   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 563
 564 (defun spam-group-ham-processor-ifile-p (group)
 565   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 566
 567 (defun spam-group-spam-processor-spamoracle-p (group)
 568   (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
 569
 570 (defun spam-group-ham-processor-bogofilter-p (group)
 571   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 572
 573 (defun spam-group-spam-processor-stat-p (group)
 574   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 575
 576 (defun spam-group-ham-processor-stat-p (group)
 577   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 578
 579 (defun spam-group-ham-processor-whitelist-p (group)
 580   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 581
 582 (defun spam-group-ham-processor-BBDB-p (group)
 583   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 584
 585 (defun spam-group-ham-processor-copy-p (group)
 586   (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
 587
 588 (defun spam-group-ham-processor-spamoracle-p (group)
 589   (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
 590
 591 ;;; Summary entry and exit processing.
 592
 593 (defun spam-summary-prepare ()
 594   (setq spam-old-ham-articles
 595         (spam-list-articles gnus-newsgroup-articles 'ham))
 596   (setq spam-old-spam-articles
 597         (spam-list-articles gnus-newsgroup-articles 'spam))
 598   (spam-mark-junk-as-spam-routine))
 599
 600 ;; The spam processors are invoked for any group, spam or ham or neither
 601 (defun spam-summary-prepare-exit ()
 602   (unless gnus-group-is-exiting-without-update-p
 603     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 604
 605     ;; first of all, unregister any articles that are no longer ham or spam
 606     ;; we have to iterate over the processors, or else we'll be too slow
 607     (dolist (classification '(spam ham))
 608       (let* ((old-articles (if (eq classification 'spam)
 609                                spam-old-spam-articles
 610                              spam-old-ham-articles))
 611              (new-articles (spam-list-articles
 612                             gnus-newsgroup-articles
 613                             classification))
 614              (changed-articles (gnus-set-difference old-articles new-articles)))
 615         ;; now that we have the changed articles, we go through the processors
 616         (dolist (processor-param spam-list-of-processors)
 617           (let ((processor (nth 0 processor-param))
 618                 (processor-classification (nth 1 processor-param))
 619                 (check (nth 2 processor-param))
 620                 unregister-list)
 621             (dolist (article changed-articles)
 622               (let ((id (spam-fetch-field-message-id-fast article)))
 623                 (when (spam-log-unregistration-needed-p
 624                        id 'process classification check)
 625                   (push article unregister-list))))
 626             ;; call spam-register-routine with specific articles to unregister,
 627             ;; when there are articles to unregister and the check is enabled
 628             (when (and unregister-list (symbol-value check))
 629               (spam-register-routine classification check t unregister-list))))))
 630
 631     ;; find all the spam processors applicable to this group
 632     (dolist (processor-param spam-list-of-processors)
 633       (let ((processor (nth 0 processor-param))
 634             (classification (nth 1 processor-param))
 635             (check (nth 2 processor-param)))
 636         (when (and (eq 'spam classification)
 637                    (spam-group-processor-p gnus-newsgroup-name processor))
 638           (spam-register-routine classification check))))
 639
 640     (if spam-move-spam-nonspam-groups-only
 641         (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
 642           (spam-mark-spam-as-expired-and-move-routine
 643            (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 644       (gnus-message 5 "Marking spam as expired and moving it to %s"
 645                     gnus-newsgroup-name)
 646       (spam-mark-spam-as-expired-and-move-routine
 647        (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 648
 649     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 650     ;; expire spam, in case the above did not expire them
 651     (gnus-message 5 "Marking spam as expired without moving it")
 652     (spam-mark-spam-as-expired-and-move-routine nil)
 653
 654     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 655               (and (spam-group-spam-contents-p gnus-newsgroup-name)
 656                    spam-process-ham-in-spam-groups)
 657               spam-process-ham-in-nonham-groups)
 658       ;; find all the ham processors applicable to this group
 659       (dolist (processor-param spam-list-of-processors)
 660         (let ((processor (nth 0 processor-param))
 661               (classification (nth 1 processor-param))
 662               (check (nth 2 processor-param)))
 663           (when (and (eq 'ham classification)
 664                      (spam-group-processor-p gnus-newsgroup-name processor))
 665             (spam-register-routine classification check)))))
 666
 667     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
 668       (gnus-message 5 "Copying ham")
 669       (spam-ham-copy-routine
 670        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
 671
 672     ;; now move all ham articles out of spam groups
 673     (when (spam-group-spam-contents-p gnus-newsgroup-name)
 674       (gnus-message 5 "Moving ham messages from spam group")
 675       (spam-ham-move-routine
 676        (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 677
 678   (setq spam-old-ham-articles nil)
 679   (setq spam-old-spam-articles nil))
 680
 681 (defun spam-mark-junk-as-spam-routine ()
 682   ;; check the global list of group names spam-junk-mailgroups and the
 683   ;; group parameters
 684   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 685     (gnus-message 6 "Marking %s articles as spam"
 686                   (if spam-mark-only-unseen-as-spam
 687                       "unseen"
 688                     "unread"))
 689     (let ((articles (if spam-mark-only-unseen-as-spam
 690                         gnus-newsgroup-unseen
 691                       gnus-newsgroup-unreads)))
 692       (if spam-mark-new-messages-in-spam-group-as-spam
 693           (dolist (article articles)
 694             (gnus-summary-mark-article article gnus-spam-mark))
 695         (gnus-message 9 "Did not mark new messages as spam.")))))
 696
 697 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
 698   (if (and (car-safe groups) (listp (car-safe groups)))
 699       (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
 700     (gnus-summary-kill-process-mark)
 701     (let ((articles gnus-newsgroup-articles)
 702           (backend-supports-deletions
 703            (gnus-check-backend-function
 704             'request-move-article gnus-newsgroup-name))
 705           article tomove deletep)
 706       (dolist (article articles)
 707         (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 708           (gnus-summary-mark-article article gnus-expirable-mark)
 709           (push article tomove)))
 710
 711       ;; now do the actual copies
 712       (dolist (group groups)
 713         (when (and tomove
 714                    (stringp group))
 715           (dolist (article tomove)
 716             (gnus-summary-set-process-mark article))
 717           (when tomove
 718             (if (or (not backend-supports-deletions)
 719                     (> (length groups) 1))
 720                 (progn
 721                   (gnus-summary-copy-article nil group)
 722                   (setq deletep t))
 723               (gnus-summary-move-article nil group)))))
 724
 725       ;; now delete the articles, if there was a copy done, and the
 726       ;; backend allows it
 727       (when (and deletep backend-supports-deletions)
 728         (dolist (article tomove)
 729           (gnus-summary-set-process-mark article))
 730         (when tomove
 731           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 732             (gnus-summary-delete-article nil))))
 733
 734       (gnus-summary-yank-process-mark))))
 735
 736 (defun spam-ham-copy-or-move-routine (copy groups)
 737   (gnus-summary-kill-process-mark)
 738   (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
 739         (backend-supports-deletions
 740          (gnus-check-backend-function
 741           'request-move-article gnus-newsgroup-name))
 742         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
 743         article mark deletep respool)
 744
 745     (when (member 'respool groups)
 746       (setq respool t)                  ; boolean for later
 747       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
 748
 749     ;; now do the actual move
 750     (dolist (group groups)
 751       (when (and todo (stringp group))
 752         (dolist (article todo)
 753           (when spam-mark-ham-unread-before-move-from-spam-group
 754             (gnus-summary-mark-article article gnus-unread-mark))
 755           (gnus-summary-set-process-mark article))
 756
 757         (if respool                        ; respooling is with a "fake" group
 758             (let ((spam-split-disabled
 759                    (or spam-split-disabled
 760                        spam-disable-spam-split-during-ham-respool)))
 761               (gnus-summary-respool-article nil respool-method))
 762           (if (or (not backend-supports-deletions) ; else, we are not respooling
 763                   (> (length groups) 1))
 764               (progn                ; if copying, copy and set deletep
 765                 (gnus-summary-copy-article nil group)
 766                 (setq deletep t))
 767             (gnus-summary-move-article nil group))))) ; else move articles
 768
 769     ;; now delete the articles, unless a) copy is t, and there was a copy done
 770     ;;                                 b) a move was done to a single group
 771     ;;                                 c) backend-supports-deletions is nil
 772     (unless copy
 773       (when (and deletep backend-supports-deletions)
 774         (dolist (article todo)
 775           (gnus-summary-set-process-mark article))
 776         (when todo
 777           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 778             (gnus-summary-delete-article nil))))))
 779
 780   (gnus-summary-yank-process-mark))
 781
 782 (defun spam-ham-copy-routine (&rest groups)
 783   (if (and (car-safe groups) (listp (car-safe groups)))
 784       (apply 'spam-ham-copy-routine (car groups))
 785     (spam-ham-copy-or-move-routine t groups)))
 786
 787 (defun spam-ham-move-routine (&rest groups)
 788   (if (and (car-safe groups) (listp (car-safe groups)))
 789       (apply 'spam-ham-move-routine (car groups))
 790     (spam-ham-copy-or-move-routine nil groups)))
 791
 792 (eval-and-compile
 793   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 794                                    'point-at-eol
 795                                  'line-end-position)))
 796
 797 (defun spam-get-article-as-string (article)
 798   (let ((article-buffer (spam-get-article-as-buffer article))
 799         article-string)
 800     (when article-buffer
 801       (save-window-excursion
 802         (set-buffer article-buffer)
 803         (setq article-string (buffer-string))))
 804     article-string))
 805
 806 (defun spam-get-article-as-buffer (article)
 807   (let ((article-buffer))
 808     (when (numberp article)
 809       (save-window-excursion
 810         (gnus-summary-goto-subject article)
 811         (gnus-summary-show-article t)
 812         (setq article-buffer (get-buffer gnus-article-buffer))))
 813     article-buffer))
 814
 815 ;; disabled for now
 816 ;; (defun spam-get-article-as-filename (article)
 817 ;;   (let ((article-filename))
 818 ;;     (when (numberp article)
 819 ;;       (nnml-possibly-change-directory
 820 ;;        (gnus-group-real-name gnus-newsgroup-name))
 821 ;;       (setq article-filename (expand-file-name
 822 ;;                              (int-to-string article) nnml-current-directory)))
 823 ;;     (if (file-exists-p article-filename)
 824 ;;      article-filename
 825 ;;       nil)))
 826
 827 (defun spam-fetch-field-from-fast (article)
 828   "Fetch the `from' field quickly, using the internal gnus-data-list function"
 829   (if (and (numberp article)
 830            (assoc article (gnus-data-list nil)))
 831       (mail-header-from
 832        (gnus-data-header (assoc article (gnus-data-list nil))))
 833     nil))
 834
 835 (defun spam-fetch-field-subject-fast (article)
 836   "Fetch the `subject' field quickly, using the internal
 837   gnus-data-list function"
 838   (if (and (numberp article)
 839            (assoc article (gnus-data-list nil)))
 840       (mail-header-subject
 841        (gnus-data-header (assoc article (gnus-data-list nil))))
 842     nil))
 843
 844 (defun spam-fetch-field-message-id-fast (article)
 845   "Fetch the `Message-ID' field quickly, using the internal
 846   gnus-data-list function"
 847   (if (and (numberp article)
 848            (assoc article (gnus-data-list nil)))
 849       (mail-header-message-id
 850        (gnus-data-header (assoc article (gnus-data-list nil))))
 851     nil))
 852
 853 \f
 854 ;;;; Spam determination.
 855
 856 (defvar spam-list-of-checks
 857   '((spam-use-blacklist          . spam-check-blacklist)
 858     (spam-use-regex-headers      . spam-check-regex-headers)
 859     (spam-use-regex-body         . spam-check-regex-body)
 860     (spam-use-whitelist          . spam-check-whitelist)
 861     (spam-use-BBDB               . spam-check-BBDB)
 862     (spam-use-ifile              . spam-check-ifile)
 863     (spam-use-spamoracle         . spam-check-spamoracle)
 864     (spam-use-stat               . spam-check-stat)
 865     (spam-use-blackholes         . spam-check-blackholes)
 866     (spam-use-hashcash           . spam-check-hashcash)
 867     (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
 868     (spam-use-bogofilter         . spam-check-bogofilter))
 869   "The spam-list-of-checks list contains pairs associating a
 870 parameter variable with a spam checking function.  If the
 871 parameter variable is true, then the checking function is called,
 872 and its value decides what happens.  Each individual check may
 873 return nil, t, or a mailgroup name.  The value nil means that the
 874 check does not yield a decision, and so, that further checks are
 875 needed.  The value t means that the message is definitely not
 876 spam, and that further spam checks should be inhibited.
 877 Otherwise, a mailgroup name or the symbol 'spam (depending on
 878 spam-split-symbolic-return) is returned where the mail should go,
 879 and further checks are also inhibited.  The usual mailgroup name
 880 is the value of `spam-split-group', meaning that the message is
 881 definitely a spam.")
 882
 883 (defvar spam-list-of-statistical-checks
 884   '(spam-use-ifile
 885     spam-use-regex-body
 886     spam-use-stat
 887     spam-use-bogofilter
 888     spam-use-spamoracle)
 889   "The spam-list-of-statistical-checks list contains all the mail
 890 splitters that need to have the full message body available.")
 891
 892 ;;;TODO: modify to invoke self with each check if invoked without specifics
 893 (defun spam-split (&rest specific-checks)
 894   "Split this message into the `spam' group if it is spam.
 895 This function can be used as an entry in the variable `nnmail-split-fancy',
 896 for example like this: (: spam-split).  It can take checks as
 897 parameters.  A string as a parameter will set the
 898 spam-split-group to that string.
 899
 900 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 901   (interactive)
 902   (setq spam-split-last-successful-check nil)
 903   (unless spam-split-disabled
 904     (let ((spam-split-group-choice spam-split-group))
 905       (dolist (check specific-checks)
 906         (when (stringp check)
 907           (setq spam-split-group-choice check)
 908           (setq specific-checks (delq check specific-checks))))
 909
 910       (let ((spam-split-group spam-split-group-choice))
 911         (save-excursion
 912           (save-restriction
 913             (dolist (check spam-list-of-statistical-checks)
 914               (when (and (symbolp check) (symbol-value check))
 915                 (widen)
 916                 (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
 917                               (symbol-name check))
 918                 (return)))
 919             ;;   (progn (widen) (debug (buffer-string)))
 920             (let ((list-of-checks spam-list-of-checks)
 921                   decision)
 922               (while (and list-of-checks (not decision))
 923                 (let ((pair (pop list-of-checks)))
 924                   (when (and (symbol-value (car pair))
 925                              (or (null specific-checks)
 926                                  (memq (car pair) specific-checks)))
 927                     (gnus-message 5 "spam-split: calling the %s function"
 928                                   (symbol-name (cdr pair)))
 929                     (setq decision (funcall (cdr pair)))
 930                     ;; if we got a decision at all, save the current check
 931                     (when decision
 932                       (setq spam-split-last-successful-check (car pair)))
 933
 934                     (when (eq decision 'spam)
 935                       (if spam-split-symbolic-return
 936                           (setq decision spam-split-group)
 937                         (gnus-error
 938                          5
 939                          (format "spam-split got %s but %s is nil"
 940                                  (symbol-name decision)
 941                                  (symbol-name spam-split-symbolic-return))))))))
 942               (if (eq decision t)
 943                   (if spam-split-symbolic-return-positive 'ham nil)
 944                 decision))))))))
 945
 946 (defun spam-find-spam ()
 947   "This function will detect spam in the current newsgroup using spam-split."
 948   (interactive)
 949
 950   (let* ((group gnus-newsgroup-name)
 951          (autodetect (gnus-parameter-spam-autodetect group))
 952          (methods (gnus-parameter-spam-autodetect-methods group))
 953          (first-method (nth 0 methods)))
 954   (when (and autodetect
 955              (not (equal first-method 'none)))
 956     (mapcar
 957      (lambda (article)
 958        (let ((id (spam-fetch-field-message-id-fast article))
 959              (subject (spam-fetch-field-subject-fast article))
 960              (sender (spam-fetch-field-from-fast article)))
 961          (unless (and spam-log-to-registry
 962                       (spam-log-registered-p id 'incoming))
 963            (let* ((spam-split-symbolic-return t)
 964                   (spam-split-symbolic-return-positive t)
 965                   (split-return
 966                    (with-temp-buffer
 967                      (gnus-request-article-this-buffer
 968                       article
 969                       group)
 970                      (if (or (null first-method)
 971                              (equal first-method 'default))
 972                          (spam-split)
 973                        (apply 'spam-split methods)))))
 974              (if (equal split-return 'spam)
 975                  (gnus-summary-mark-article article gnus-spam-mark))
 976
 977              (when (and split-return spam-log-to-registry)
 978                (when (zerop (gnus-registry-group-count id))
 979                  (gnus-registry-add-group
 980                   id group subject sender))
 981
 982                (spam-log-processing-to-registry
 983                 id
 984                 'incoming
 985                 split-return
 986                 spam-split-last-successful-check
 987                 group))))))
 988      (if spam-autodetect-recheck-messages
 989          gnus-newsgroup-articles
 990        gnus-newsgroup-unseen)))))
 991
 992 (defvar spam-registration-functions
 993   ;; first the ham register, second the spam register function
 994   ;; third the ham unregister, fourth the spam unregister function
 995   '((spam-use-blacklist  nil
 996                          spam-blacklist-register-routine
 997                          nil
 998                          spam-blacklist-unregister-routine)
 999     (spam-use-whitelist  spam-whitelist-register-routine
1000                          nil
1001                          spam-whitelist-unregister-routine
1002                          nil)
1003     (spam-use-BBDB       spam-BBDB-register-routine
1004                          nil
1005                          spam-BBDB-unregister-routine
1006                          nil)
1007     (spam-use-ifile      spam-ifile-register-ham-routine
1008                          spam-ifile-register-spam-routine
1009                          spam-ifile-unregister-ham-routine
1010                          spam-ifile-unregister-spam-routine)
1011     (spam-use-spamoracle spam-spamoracle-learn-ham
1012                          spam-spamoracle-learn-spam
1013                          spam-spamoracle-unlearn-ham
1014                          spam-spamoracle-unlearn-spam)
1015     (spam-use-stat       spam-stat-register-ham-routine
1016                          spam-stat-register-spam-routine
1017                          spam-stat-unregister-ham-routine
1018                          spam-stat-unregister-spam-routine)
1019     ;; note that spam-use-gmane is not a legitimate check
1020     (spam-use-gmane      nil
1021                          spam-report-gmane-register-routine
1022                          ;; does Gmane support unregistration?
1023                          nil
1024                          nil)
1025     (spam-use-bogofilter spam-bogofilter-register-ham-routine
1026                          spam-bogofilter-register-spam-routine
1027                          spam-bogofilter-unregister-ham-routine
1028                          spam-bogofilter-unregister-spam-routine))
1029   "The spam-registration-functions list contains pairs
1030 associating a parameter variable with the ham and spam
1031 registration functions, and the ham and spam unregistration
1032 functions")
1033
1034 (defun spam-classification-valid-p (classification)
1035   (or  (eq classification 'spam)
1036        (eq classification 'ham)))
1037
1038 (defun spam-process-type-valid-p (process-type)
1039   (or  (eq process-type 'incoming)
1040        (eq process-type 'process)))
1041
1042 (defun spam-registration-check-valid-p (check)
1043   (assoc check spam-registration-functions))
1044
1045 (defun spam-unregistration-check-valid-p (check)
1046   (assoc check spam-registration-functions))
1047
1048 (defun spam-registration-function (classification check)
1049   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1050     (if (eq classification 'spam)
1051         (nth 1 flist)
1052       (nth 0 flist))))
1053
1054 (defun spam-unregistration-function (classification check)
1055   (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1056     (if (eq classification 'spam)
1057         (nth 3 flist)
1058       (nth 2 flist))))
1059
1060 (defun spam-list-articles (articles classification)
1061   (let ((mark-check (if (eq classification 'spam)
1062                         'spam-group-spam-mark-p
1063                       'spam-group-ham-mark-p))
1064         list mark-cache-yes mark-cache-no)
1065     (dolist (article articles)
1066       (let ((mark (gnus-summary-article-mark article)))
1067         (unless (memq mark mark-cache-no)
1068           (if (memq mark mark-cache-yes)
1069               (push article list)
1070             ;; else, we have to actually check the mark
1071             (if (funcall mark-check
1072                          gnus-newsgroup-name
1073                          mark)
1074                 (progn
1075                   (push article list)
1076                   (push mark mark-cache-yes))
1077               (push mark mark-cache-no))))))
1078     list))
1079
1080 (defun spam-register-routine (classification
1081                               check
1082                               &optional unregister
1083                               specific-articles)
1084   (when (and (spam-classification-valid-p classification)
1085              (spam-registration-check-valid-p check))
1086     (let* ((register-function
1087             (spam-registration-function classification check))
1088            (unregister-function
1089             (spam-unregistration-function classification check))
1090            (run-function (if unregister
1091                              unregister-function
1092                            register-function))
1093            (log-function (if unregister
1094                              'spam-log-undo-registration
1095                            'spam-log-processing-to-registry))
1096            article articles)
1097
1098       (when run-function
1099         ;; make list of articles, using specific-articles if given
1100         (setq articles (or specific-articles
1101                            (spam-list-articles
1102                             gnus-newsgroup-articles
1103                             classification)))
1104         ;; process them
1105         (gnus-message 5 "%s %d %s articles with classification %s, check %s"
1106                       (if unregister "Unregistering" "Registering")
1107                       (length articles)
1108                       (if specific-articles "specific" "")
1109                       (symbol-name classification)
1110                       (symbol-name check))
1111         (funcall run-function articles)
1112         ;; now log all the registrations (or undo them, depending on unregister)
1113         (dolist (article articles)
1114           (funcall log-function
1115                    (spam-fetch-field-message-id-fast article)
1116                    'process
1117                    classification
1118                    check
1119                    gnus-newsgroup-name))))))
1120
1121 ;;; log a ham- or spam-processor invocation to the registry
1122 (defun spam-log-processing-to-registry (id type classification check group)
1123   (when spam-log-to-registry
1124     (if (and (stringp id)
1125              (stringp group)
1126              (spam-process-type-valid-p type)
1127              (spam-classification-valid-p classification)
1128              (spam-registration-check-valid-p check))
1129         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1130               (cell (list classification check group)))
1131           (push cell cell-list)
1132           (gnus-registry-store-extra-entry
1133            id
1134            type
1135            cell-list))
1136
1137       (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group"
1138                               "spam-log-processing-to-registry")))))
1139
1140 ;;; check if a ham- or spam-processor registration has been done
1141 (defun spam-log-registered-p (id type)
1142   (when spam-log-to-registry
1143     (if (and (stringp id)
1144              (spam-process-type-valid-p type))
1145         (cdr-safe (gnus-registry-fetch-extra id type))
1146       (progn
1147         (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
1148                                 "spam-log-registered-p"))
1149         nil))))
1150
1151 ;;; check if a ham- or spam-processor registration needs to be undone
1152 (defun spam-log-unregistration-needed-p (id type classification check)
1153   (when spam-log-to-registry
1154     (if (and (stringp id)
1155              (spam-process-type-valid-p type)
1156              (spam-classification-valid-p classification)
1157              (spam-registration-check-valid-p check))
1158         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1159               found)
1160           (dolist (cell cell-list)
1161             (unless found
1162               (when (and (eq classification (nth 0 cell))
1163                          (eq check (nth 1 cell)))
1164                 (setq found t))))
1165           found)
1166       (progn
1167         (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
1168                                 "spam-log-unregistration-needed-p"))
1169         nil))))
1170
1171
1172 ;;; undo a ham- or spam-processor registration (the group is not used)
1173 (defun spam-log-undo-registration (id type classification check &optional group)
1174   (when (and spam-log-to-registry
1175              (spam-log-unregistration-needed-p id type classification check))
1176     (if (and (stringp id)
1177              (spam-process-type-valid-p type)
1178              (spam-classification-valid-p classification)
1179              (spam-registration-check-valid-p check))
1180         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1181               new-cell-list found)
1182           (dolist (cell cell-list)
1183             (unless (and (eq classification (nth 0 cell))
1184                          (eq check (nth 1 cell)))
1185               (push cell new-cell-list)))
1186           (gnus-registry-store-extra-entry
1187            id
1188            type
1189            new-cell-list))
1190       (progn
1191         (gnus-message 5 (format "%s called with bad ID, type, check, or group"
1192                                 "spam-log-undo-registration"))
1193         nil))))
1194
1195 ;;; set up IMAP widening if it's necessary
1196 (defun spam-setup-widening ()
1197   (dolist (check spam-list-of-statistical-checks)
1198     (when (symbol-value check)
1199       (setq nnimap-split-download-body-default t))))
1200
1201 \f
1202 ;;;; Regex body
1203
1204 (defun spam-check-regex-body ()
1205   (let ((spam-regex-headers-ham spam-regex-body-ham)
1206         (spam-regex-headers-spam spam-regex-body-spam))
1207     (spam-check-regex-headers t)))
1208
1209 \f
1210 ;;;; Regex headers
1211
1212 (defun spam-check-regex-headers (&optional body)
1213   (let ((type (if body "body" "header"))
1214         (spam-split-group (if spam-split-symbolic-return
1215                               'spam
1216                             spam-split-group))
1217         ret found)
1218     (dolist (h-regex spam-regex-headers-ham)
1219       (unless found
1220         (goto-char (point-min))
1221         (when (re-search-forward h-regex nil t)
1222           (message "Ham regex %s search positive." type)
1223           (setq found t))))
1224     (dolist (s-regex spam-regex-headers-spam)
1225       (unless found
1226         (goto-char (point-min))
1227         (when (re-search-forward s-regex nil t)
1228           (message "Spam regex %s search positive." type)
1229           (setq found t)
1230           (setq ret spam-split-group))))
1231     ret))
1232
1233 \f
1234 ;;;; Blackholes.
1235
1236 (defun spam-reverse-ip-string (ip)
1237   (when (stringp ip)
1238     (mapconcat 'identity
1239                (nreverse (split-string ip "\\."))
1240                ".")))
1241
1242 (defun spam-check-blackholes ()
1243   "Check the Received headers for blackholed relays."
1244   (let ((headers (nnmail-fetch-field "received"))
1245         (spam-split-group (if spam-split-symbolic-return
1246                               'spam
1247                             spam-split-group))
1248         ips matches)
1249     (when headers
1250       (with-temp-buffer
1251         (insert headers)
1252         (goto-char (point-min))
1253         (gnus-message 5 "Checking headers for relay addresses")
1254         (while (re-search-forward
1255                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1256           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1257           (push (spam-reverse-ip-string (match-string 1))
1258                 ips)))
1259       (dolist (server spam-blackhole-servers)
1260         (dolist (ip ips)
1261           (unless (and spam-blackhole-good-server-regex
1262                        ;; match the good-server-regex against the reversed (again) IP string
1263                        (string-match
1264                         spam-blackhole-good-server-regex
1265                         (spam-reverse-ip-string ip)))
1266             (unless matches
1267               (let ((query-string (concat ip "." server)))
1268                 (if spam-use-dig
1269                     (let ((query-result (query-dig query-string)))
1270                       (when query-result
1271                         (gnus-message 5 "(DIG): positive blackhole check '%s'"
1272                                       query-result)
1273                         (push (list ip server query-result)
1274                               matches)))
1275                   ;; else, if not using dig.el
1276                   (when (query-dns query-string)
1277                     (gnus-message 5 "positive blackhole check")
1278                     (push (list ip server (query-dns query-string 'TXT))
1279                           matches)))))))))
1280     (when matches
1281       spam-split-group)))
1282 \f
1283 ;;;; Hashcash.
1284
1285 (eval-when-compile
1286   (autoload 'mail-check-payment "hashcash"))
1287
1288 (condition-case nil
1289     (progn
1290       (require 'hashcash)
1291
1292       (defun spam-check-hashcash ()
1293         "Check the headers for hashcash payments."
1294         (mail-check-payment)))   ;mail-check-payment returns a boolean
1295
1296   (file-error))
1297 \f
1298 ;;;; BBDB
1299
1300 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
1301 ;;; <sacha@giotto.sj.ru>
1302
1303 ;; all this is done inside a condition-case to trap errors
1304
1305 (eval-when-compile
1306   (autoload 'bbdb-buffer "bbdb")
1307   (autoload 'bbdb-create-internal "bbdb")
1308   (autoload 'bbdb-search-simple "bbdb"))
1309
1310 (eval-and-compile
1311   (when (condition-case nil
1312             (progn
1313               (require 'bbdb)
1314               (require 'bbdb-com))
1315           (file-error
1316            (defalias 'spam-BBDB-register-routine 'ignore)
1317            (defalias 'spam-enter-ham-BBDB 'ignore)
1318            nil))
1319
1320     (defun spam-enter-ham-BBDB (addresses &optional remove)
1321       "Enter an address into the BBDB; implies ham (non-spam) sender"
1322       (dolist (from addresses)
1323         (when (stringp from)
1324           (let* ((parsed-address (gnus-extract-address-components from))
1325                  (name (or (nth 0 parsed-address) "Ham Sender"))
1326                  (remove-function (if remove
1327                                       'bbdb-delete-record-internal
1328                                     'ignore))
1329                  (net-address (nth 1 parsed-address))
1330                  (record (and net-address
1331                               (bbdb-search-simple nil net-address))))
1332             (when net-address
1333               (gnus-message 5 "%s address %s %s BBDB"
1334                             (if remove "Deleting" "Adding")
1335                             from
1336                             (if remove "from" "to"))
1337               (if record
1338                   (funcall remove-function record)
1339                 (bbdb-create-internal name nil net-address nil nil
1340                                       "ham sender added by spam.el")))))))
1341
1342     (defun spam-BBDB-register-routine (articles &optional unregister)
1343       (let (addresses)
1344         (dolist (article articles)
1345           (when (stringp (spam-fetch-field-from-fast article))
1346             (push (spam-fetch-field-from-fast article) addresses)))
1347         ;; now do the register/unregister action
1348         (spam-enter-ham-BBDB addresses unregister)))
1349
1350     (defun spam-BBDB-unregister-routine (articles)
1351       (spam-BBDB-register-routine articles t))
1352
1353     (defun spam-check-BBDB ()
1354       "Mail from people in the BBDB is classified as ham or non-spam"
1355       (let ((who (nnmail-fetch-field "from"))
1356             (spam-split-group (if spam-split-symbolic-return
1357                                   'spam
1358                                 spam-split-group)))
1359         (when who
1360           (setq who (nth 1 (gnus-extract-address-components who)))
1361           (if (bbdb-search-simple nil who)
1362               t
1363             (if spam-use-BBDB-exclusive
1364                 spam-split-group
1365               nil)))))))
1366
1367 \f
1368 ;;;; ifile
1369
1370 ;;; check the ifile backend; return nil if the mail was NOT classified
1371 ;;; as spam
1372
1373 (defun spam-get-ifile-database-parameter ()
1374   "Get the command-line parameter for ifile's database from
1375   spam-ifile-database-path."
1376   (if spam-ifile-database-path
1377       (format "--db-file=%s" spam-ifile-database-path)
1378     nil))
1379
1380 (defun spam-check-ifile ()
1381   "Check the ifile backend for the classification of this message."
1382   (let ((article-buffer-name (buffer-name))
1383         (spam-split-group (if spam-split-symbolic-return
1384                               'spam
1385                             spam-split-group))
1386         category return)
1387     (with-temp-buffer
1388       (let ((temp-buffer-name (buffer-name))
1389             (db-param (spam-get-ifile-database-parameter)))
1390         (save-excursion
1391           (set-buffer article-buffer-name)
1392           (apply 'call-process-region
1393                  (point-min) (point-max) spam-ifile-path
1394                  nil temp-buffer-name nil "-c"
1395                  (if db-param `(,db-param "-q") `("-q"))))
1396         ;; check the return now (we're back in the temp buffer)
1397         (goto-char (point-min))
1398         (if (not (eobp))
1399             (setq category (buffer-substring (point) (spam-point-at-eol))))
1400         (when (not (zerop (length category))) ; we need a category here
1401           (if spam-ifile-all-categories
1402               (setq return category)
1403             ;; else, if spam-ifile-all-categories is not set...
1404             (when (string-equal spam-ifile-spam-category category)
1405               (setq return spam-split-group)))))) ; note return is nil otherwise
1406     return))
1407
1408 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
1409   "Register an article, given as a string, with a category.
1410 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1411   (let ((category (or category gnus-newsgroup-name))
1412         (add-or-delete-option (if unregister "-d" "-i"))
1413         (db (spam-get-ifile-database-parameter))
1414         parameters)
1415     (with-temp-buffer
1416       (dolist (article articles)
1417         (let ((article-string (spam-get-article-as-string article)))
1418           (when (stringp article-string)
1419             (insert article-string))))
1420       (apply 'call-process-region
1421              (point-min) (point-max) spam-ifile-path
1422              nil nil nil
1423              add-or-delete-option category
1424              (if db `(,db "-h") `("-h"))))))
1425
1426 (defun spam-ifile-register-spam-routine (articles &optional unregister)
1427   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
1428
1429 (defun spam-ifile-unregister-spam-routine (articles)
1430   (spam-ifile-register-spam-routine articles t))
1431
1432 (defun spam-ifile-register-ham-routine (articles &optional unregister)
1433   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
1434
1435 (defun spam-ifile-unregister-ham-routine (articles)
1436   (spam-ifile-register-ham-routine articles t))
1437
1438 \f
1439 ;;;; spam-stat
1440
1441 (eval-when-compile
1442   (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
1443   (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
1444   (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
1445   (autoload 'spam-stat-buffer-is-spam "spam-stat")
1446   (autoload 'spam-stat-load "spam-stat")
1447   (autoload 'spam-stat-save "spam-stat")
1448   (autoload 'spam-stat-split-fancy "spam-stat"))
1449
1450 (eval-and-compile
1451   (when (condition-case nil
1452             (let ((spam-stat-install-hooks nil))
1453               (require 'spam-stat))
1454           (file-error
1455            (defalias 'spam-stat-register-ham-routine 'ignore)
1456            (defalias 'spam-stat-register-spam-routine 'ignore)
1457            nil))
1458
1459     (defun spam-check-stat ()
1460       "Check the spam-stat backend for the classification of this message"
1461       (let ((spam-split-group (if spam-split-symbolic-return
1462                                   'spam
1463                                 spam-split-group))
1464             (spam-stat-split-fancy-spam-group spam-split-group) ; override
1465             (spam-stat-buffer (buffer-name)) ; stat the current buffer
1466             category return)
1467         (spam-stat-split-fancy)))
1468
1469     (defun spam-stat-register-spam-routine (articles &optional unregister)
1470       (dolist (article articles)
1471         (let ((article-string (spam-get-article-as-string article)))
1472           (with-temp-buffer
1473             (insert article-string)
1474             (if unregister
1475                 (spam-stat-buffer-change-to-non-spam)
1476               (spam-stat-buffer-is-spam))))))
1477
1478     (defun spam-stat-unregister-spam-routine (articles)
1479       (spam-stat-register-spam-routine articles t))
1480
1481     (defun spam-stat-register-ham-routine (articles &optional unregister)
1482       (dolist (article articles)
1483         (let ((article-string (spam-get-article-as-string article)))
1484           (with-temp-buffer
1485             (insert article-string)
1486             (if unregister
1487                 (spam-stat-buffer-change-to-spam)
1488               (spam-stat-buffer-is-non-spam))))))
1489
1490     (defun spam-stat-unregister-ham-routine (articles)
1491       (spam-stat-register-ham-routine articles t))
1492
1493     (defun spam-maybe-spam-stat-load ()
1494       (when spam-use-stat (spam-stat-load)))
1495
1496     (defun spam-maybe-spam-stat-save ()
1497       (when spam-use-stat (spam-stat-save)))))
1498
1499 \f
1500
1501 ;;;; Blacklists and whitelists.
1502
1503 (defvar spam-whitelist-cache nil)
1504 (defvar spam-blacklist-cache nil)
1505
1506 (defun spam-kill-whole-line ()
1507   (beginning-of-line)
1508   (let ((kill-whole-line t))
1509     (kill-line)))
1510
1511 ;;; address can be a list, too
1512 (defun spam-enter-whitelist (address &optional remove)
1513   "Enter ADDRESS (list or single) into the whitelist.
1514 With a non-nil REMOVE, remove them."
1515   (interactive "sAddress: ")
1516   (spam-enter-list address spam-whitelist remove)
1517   (setq spam-whitelist-cache nil))
1518
1519 ;;; address can be a list, too
1520 (defun spam-enter-blacklist (address &optional remove)
1521   "Enter ADDRESS (list or single) into the blacklist.
1522 With a non-nil REMOVE, remove them."
1523   (interactive "sAddress: ")
1524   (spam-enter-list address spam-blacklist remove)
1525   (setq spam-blacklist-cache nil))
1526
1527 (defun spam-enter-list (addresses file &optional remove)
1528   "Enter ADDRESSES into the given FILE.
1529 Either the whitelist or the blacklist files can be used.  With
1530 REMOVE not nil, remove the ADDRESSES."
1531   (if (stringp addresses)
1532       (spam-enter-list (list addresses) file remove)
1533     ;; else, we have a list of addresses here
1534     (unless (file-exists-p (file-name-directory file))
1535       (make-directory (file-name-directory file) t))
1536     (save-excursion
1537       (set-buffer
1538        (find-file-noselect file))
1539       (dolist (a addresses)
1540         (when (stringp a)
1541           (goto-char (point-min))
1542           (if (re-search-forward (regexp-quote a) nil t)
1543               ;; found the address
1544               (when remove
1545                 (spam-kill-whole-line))
1546             ;; else, the address was not found
1547             (unless remove
1548               (goto-char (point-max))
1549               (unless (bobp)
1550                 (insert "\n"))
1551               (insert a "\n")))))
1552       (save-buffer))))
1553
1554 ;;; returns t if the sender is in the whitelist, nil or
1555 ;;; spam-split-group otherwise
1556 (defun spam-check-whitelist ()
1557   ;; FIXME!  Should it detect when file timestamps change?
1558   (let ((spam-split-group (if spam-split-symbolic-return
1559                               'spam
1560                             spam-split-group)))
1561     (unless spam-whitelist-cache
1562       (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
1563     (if (spam-from-listed-p spam-whitelist-cache)
1564         t
1565       (if spam-use-whitelist-exclusive
1566           spam-split-group
1567         nil))))
1568
1569 (defun spam-check-blacklist ()
1570   ;; FIXME!  Should it detect when file timestamps change?
1571   (let ((spam-split-group (if spam-split-symbolic-return
1572                               'spam
1573                             spam-split-group)))
1574     (unless spam-blacklist-cache
1575       (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1576     (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)))
1577
1578 (defun spam-parse-list (file)
1579   (when (file-readable-p file)
1580     (let (contents address)
1581       (with-temp-buffer
1582         (insert-file-contents file)
1583         (while (not (eobp))
1584           (setq address (buffer-substring (point) (spam-point-at-eol)))
1585           (forward-line 1)
1586           ;; insert the e-mail address if detected, otherwise the raw data
1587           (unless (zerop (length address))
1588             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
1589               (push (or pure-address address) contents)))))
1590       (nreverse contents))))
1591
1592 (defun spam-from-listed-p (cache)
1593   (let ((from (nnmail-fetch-field "from"))
1594         found)
1595     (while cache
1596       (let ((address (pop cache)))
1597         (unless (zerop (length address)) ; 0 for a nil address too
1598           (setq address (regexp-quote address))
1599           ;; fix regexp-quote's treatment of user-intended regexes
1600           (while (string-match "\\\\\\*" address)
1601             (setq address (replace-match ".*" t t address))))
1602         (when (and address (string-match address from))
1603           (setq found t
1604                 cache nil))))
1605     found))
1606
1607 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
1608   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
1609         (declassification (if blacklist 'ham 'spam))
1610         (enter-function
1611          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
1612         (remove-function
1613          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
1614         from addresses unregister-list)
1615     (dolist (article articles)
1616       (let ((from (spam-fetch-field-from-fast article))
1617             (id (spam-fetch-field-message-id-fast article))
1618             sender-ignored)
1619         (when (stringp from)
1620           (dolist (ignore-regex spam-blacklist-ignored-regexes)
1621             (when (and (not sender-ignored)
1622                        (stringp ignore-regex)
1623                        (string-match ignore-regex from))
1624               (setq sender-ignored t)))
1625           ;; remember the messages we need to unregister, unless remove is set
1626           (when (and
1627                  (null unregister)
1628                  (spam-log-unregistration-needed-p
1629                   id 'process declassification de-symbol))
1630             (push from unregister-list))
1631           (unless sender-ignored
1632             (push from addresses)))))
1633
1634     (if unregister
1635         (funcall enter-function addresses t) ; unregister all these addresses
1636       ;; else, register normally and unregister what we need to
1637       (funcall remove-function unregister-list t)
1638       (dolist (article unregister-list)
1639         (spam-log-undo-registration
1640          (spam-fetch-field-message-id-fast article)
1641          'process
1642          declassification
1643          de-symbol))
1644       (funcall enter-function addresses nil))))
1645
1646 (defun spam-blacklist-unregister-routine (articles)
1647   (spam-blacklist-register-routine articles t))
1648
1649 (defun spam-blacklist-register-routine (articles &optional unregister)
1650   (spam-filelist-register-routine articles t unregister))
1651
1652 (defun spam-whitelist-unregister-routine (articles)
1653   (spam-whitelist-register-routine articles t))
1654
1655 (defun spam-whitelist-register-routine (articles &optional unregister)
1656   (spam-filelist-register-routine articles nil unregister))
1657
1658 \f
1659 ;;;; Spam-report glue
1660 (defun spam-report-gmane-register-routine (articles)
1661   (when articles
1662     (apply 'spam-report-gmane articles)))
1663
1664 \f
1665 ;;;; Bogofilter
1666 (defun spam-check-bogofilter-headers (&optional score)
1667   (let ((header (nnmail-fetch-field spam-bogofilter-header))
1668         (spam-split-group (if spam-split-symbolic-return
1669                               'spam
1670                             spam-split-group)))
1671     (when header                        ; return nil when no header
1672       (if score                         ; scoring mode
1673           (if (string-match "spamicity=\\([0-9.]+\\)" header)
1674               (match-string 1 header)
1675             "0")
1676         ;; spam detection mode
1677         (when (string-match spam-bogofilter-bogosity-positive-spam-header
1678                             header)
1679           spam-split-group)))))
1680
1681 ;; return something sensible if the score can't be determined
1682 (defun spam-bogofilter-score ()
1683   "Get the Bogofilter spamicity score"
1684   (interactive)
1685   (save-window-excursion
1686     (gnus-summary-show-article t)
1687     (set-buffer gnus-article-buffer)
1688     (let ((score (or (spam-check-bogofilter-headers t)
1689                      (spam-check-bogofilter t))))
1690       (message "Spamicity score %s" score)
1691       (or score "0"))
1692     (gnus-summary-show-article)))
1693
1694 (defun spam-check-bogofilter (&optional score)
1695   "Check the Bogofilter backend for the classification of this message"
1696   (let ((article-buffer-name (buffer-name))
1697         (db spam-bogofilter-database-directory)
1698         return)
1699     (with-temp-buffer
1700       (let ((temp-buffer-name (buffer-name)))
1701         (save-excursion
1702           (set-buffer article-buffer-name)
1703           (apply 'call-process-region
1704                  (point-min) (point-max)
1705                  spam-bogofilter-path
1706                  nil temp-buffer-name nil
1707                  (if db `("-d" ,db "-v") `("-v"))))
1708         (setq return (spam-check-bogofilter-headers score))))
1709     return))
1710
1711 (defun spam-bogofilter-register-with-bogofilter (articles
1712                                                  spam
1713                                                  &optional unregister)
1714   "Register an article, given as a string, as spam or non-spam."
1715   (dolist (article articles)
1716     (let ((article-string (spam-get-article-as-string article))
1717           (db spam-bogofilter-database-directory)
1718           (switch (if unregister
1719                       (if spam
1720                           spam-bogofilter-spam-strong-switch
1721                         spam-bogofilter-ham-strong-switch)
1722                     (if spam
1723                         spam-bogofilter-spam-switch
1724                       spam-bogofilter-ham-switch))))
1725       (when (stringp article-string)
1726         (with-temp-buffer
1727           (insert article-string)
1728
1729           (apply 'call-process-region
1730                  (point-min) (point-max)
1731                  spam-bogofilter-path
1732                  nil nil nil switch
1733                  (if db `("-d" ,db "-v") `("-v"))))))))
1734
1735 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
1736   (spam-bogofilter-register-with-bogofilter articles t unregister))
1737
1738 (defun spam-bogofilter-unregister-spam-routine (articles)
1739   (spam-bogofilter-register-spam-routine articles t))
1740
1741 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
1742   (spam-bogofilter-register-with-bogofilter articles nil unregister))
1743
1744 (defun spam-bogofilter-unregister-ham-routine (articles)
1745   (spam-bogofilter-register-ham-routine articles t))
1746
1747
1748 \f
1749 ;;;; spamoracle
1750 (defun spam-check-spamoracle ()
1751   "Run spamoracle on an article to determine whether it's spam."
1752   (let ((article-buffer-name (buffer-name))
1753         (spam-split-group (if spam-split-symbolic-return
1754                               'spam
1755                             spam-split-group)))
1756     (with-temp-buffer
1757       (let ((temp-buffer-name (buffer-name)))
1758         (save-excursion
1759           (set-buffer article-buffer-name)
1760           (let ((status
1761                  (apply 'call-process-region
1762                         (point-min) (point-max)
1763                         spam-spamoracle-binary
1764                         nil temp-buffer-name nil
1765                         (if spam-spamoracle-database
1766                             `("-f" ,spam-spamoracle-database "mark")
1767                           '("mark")))))
1768             (if (eq 0 status)
1769                 (progn
1770                   (set-buffer temp-buffer-name)
1771                   (goto-char (point-min))
1772                   (when (re-search-forward "^X-Spam: yes;" nil t)
1773                     spam-split-group))
1774               (error "Error running spamoracle: %s" status))))))))
1775
1776 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
1777   "Run spamoracle in training mode."
1778   (with-temp-buffer
1779     (let ((temp-buffer-name (buffer-name)))
1780       (save-excursion
1781         (goto-char (point-min))
1782         (dolist (article articles)
1783           (insert (spam-get-article-as-string article)))
1784         (let* ((arg (if (spam-xor unregister article-is-spam-p)
1785                         "-spam"
1786                       "-good"))
1787                (status
1788                 (apply 'call-process-region
1789                        (point-min) (point-max)
1790                        spam-spamoracle-binary
1791                        nil temp-buffer-name nil
1792                        (if spam-spamoracle-database
1793                            `("-f" ,spam-spamoracle-database
1794                              "add" ,arg)
1795                          `("add" ,arg)))))
1796           (unless (eq 0 status)
1797             (error "Error running spamoracle: %s" status)))))))
1798
1799 (defun spam-spamoracle-learn-ham (articles &optional unregister)
1800   (spam-spamoracle-learn articles nil unregister))
1801
1802 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
1803   (spam-spamoracle-learn-ham articles t))
1804
1805 (defun spam-spamoracle-learn-spam (articles &optional unregister)
1806   (spam-spamoracle-learn articles t unregister))
1807
1808 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
1809   (spam-spamoracle-learn-spam articles t))
1810
1811 \f
1812 ;;;; Hooks
1813
1814 ;;;###autoload
1815 (defun spam-initialize ()
1816   "Install the spam.el hooks and do other initialization"
1817   (interactive)
1818   (setq spam-install-hooks t)
1819   ;; TODO: How do we redo this every time the `spam' face is customized?
1820   (push '((eq mark gnus-spam-mark) . spam)
1821         gnus-summary-highlight)
1822   ;; Add hooks for loading and saving the spam stats
1823   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1824   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1825   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
1826   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1827   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1828   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
1829   (add-hook 'gnus-summary-prepare-hook 'spam-find-spam))
1830
1831 (defun spam-unload-hook ()
1832   "Uninstall the spam.el hooks"
1833   (interactive)
1834   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1835   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1836   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
1837   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1838   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1839   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
1840   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
1841
1842 (add-hook 'spam-unload-hook 'spam-unload-hook)
1843
1844 (when spam-install-hooks
1845   (spam-initialize))
1846
1847 (provide 'spam)
1848
1849 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
1850 ;;; spam.el ends here