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

   1 ;;; spam.el --- Identifying spam
   2 ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: network
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; This module addresses a few aspects of spam control under Gnus.  Page
  27 ;;; breaks are used for grouping declarations and documentation relating to
  28 ;;; each particular aspect.
  29
  30 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
  31 ;;; comments, below, for supplementary explanations or discussions.
  32
  33 ;;; Several TODO items are marked as such
  34
  35 ;;; Code:
  36
  37 (require 'path-util)
  38
  39 (eval-when-compile (require 'cl))
  40
  41 (require 'gnus-sum)
  42
  43 (require 'gnus-uu)                      ; because of key prefix issues
  44 (require 'gnus) ; for the definitions of group content classification and spam processors
  45 (require 'message)                      ;for the message-fetch-field functions
  46
  47 ;; for nnimap-split-download-body-default
  48 (eval-when-compile (require 'nnimap))
  49
  50 ;; autoload query-dig
  51 (eval-and-compile
  52   (autoload 'query-dig "dig"))
  53
  54 ;; autoload spam-report
  55 (eval-and-compile
  56   (autoload 'spam-report-gmane "spam-report"))
  57
  58 ;; autoload gnus-registry
  59 (eval-and-compile
  60   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
  61   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
  62
  63 ;; autoload query-dns
  64 (eval-and-compile
  65   (autoload 'query-dns "dns"))
  66
  67 ;;; Main parameters.
  68
  69 (defgroup spam nil
  70   "Spam configuration.")
  71
  72 (defcustom spam-directory "~/News/spam/"
  73   "Directory for spam whitelists and blacklists."
  74   :type 'directory
  75   :group 'spam)
  76
  77 (defcustom spam-move-spam-nonspam-groups-only t
  78   "Whether spam should be moved in non-spam groups only.
  79 When t, only ham and unclassified groups will have their spam moved
  80 to the spam-process-destination.  When nil, spam will also be moved from
  81 spam groups."
  82   :type 'boolean
  83   :group 'spam)
  84
  85 (defcustom spam-process-ham-in-nonham-groups nil
  86   "Whether ham should be processed in non-ham groups."
  87   :type 'boolean
  88   :group 'spam)
  89
  90 (defcustom spam-log-to-registry nil
  91   "Whether spam/ham processing should be logged in the registry."
  92   :type 'boolean
  93   :group 'spam)
  94
  95 (defcustom spam-process-ham-in-spam-groups nil
  96   "Whether ham should be processed in spam groups."
  97   :type 'boolean
  98   :group 'spam)
  99
 100 (defcustom spam-mark-only-unseen-as-spam t
 101   "Whether only unseen articles should be marked as spam in spam
 102 groups.  When nil, all unread articles in a spam group are marked as
 103 spam.  Set this if you want to leave an article unread in a spam group
 104 without losing it to the automatic spam-marking process."
 105   :type 'boolean
 106   :group 'spam)
 107
 108 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
 109   "Whether ham should be marked unread before it's moved out of a spam
 110 group according to ham-process-destination.  This variable is an
 111 official entry in the international Longest Variable Name
 112 Competition."
 113   :type 'boolean
 114   :group 'spam)
 115
 116 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
 117   "The location of the whitelist.
 118 The file format is one regular expression per line.
 119 The regular expression is matched against the address."
 120   :type 'file
 121   :group 'spam)
 122
 123 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
 124   "The location of the blacklist.
 125 The file format is one regular expression per line.
 126 The regular expression is matched against the address."
 127   :type 'file
 128   :group 'spam)
 129
 130 (defcustom spam-use-dig t
 131   "Whether query-dig should be used instead of query-dns."
 132   :type 'boolean
 133   :group 'spam)
 134
 135 (defcustom spam-use-blacklist nil
 136   "Whether the blacklist should be used by spam-split."
 137   :type 'boolean
 138   :group 'spam)
 139
 140 (defcustom spam-use-whitelist nil
 141   "Whether the whitelist should be used by spam-split."
 142   :type 'boolean
 143   :group 'spam)
 144
 145 (defcustom spam-use-whitelist-exclusive nil
 146   "Whether whitelist-exclusive should be used by spam-split.
 147 Exclusive whitelisting means that all messages from senders not in the whitelist
 148 are considered spam."
 149   :type 'boolean
 150   :group 'spam)
 151
 152 (defcustom spam-use-blackholes nil
 153   "Whether blackholes should be used by spam-split."
 154   :type 'boolean
 155   :group 'spam)
 156
 157 (defcustom spam-use-hashcash nil
 158   "Whether hashcash payments should be detected by spam-split."
 159   :type 'boolean
 160   :group 'spam)
 161
 162 (defcustom spam-use-regex-headers nil
 163   "Whether a header regular expression match should be used by spam-split.
 164 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
 165   :type 'boolean
 166   :group 'spam)
 167
 168 (defcustom spam-use-regex-body nil
 169   "Whether a body regular expression match should be used by spam-split.
 170 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
 171   :type 'boolean
 172   :group 'spam)
 173
 174 (defcustom spam-use-bogofilter-headers nil
 175   "Whether bogofilter headers should be used by spam-split.
 176 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
 177   :type 'boolean
 178   :group 'spam)
 179
 180 (defcustom spam-use-bogofilter nil
 181   "Whether bogofilter should be invoked by spam-split.
 182 Enable this if you want Gnus to invoke Bogofilter on new messages."
 183   :type 'boolean
 184   :group 'spam)
 185
 186 (defcustom spam-use-BBDB nil
 187   "Whether BBDB should be used by spam-split."
 188   :type 'boolean
 189   :group 'spam)
 190
 191 (defcustom spam-use-BBDB-exclusive nil
 192   "Whether BBDB-exclusive should be used by spam-split.
 193 Exclusive BBDB means that all messages from senders not in the BBDB are
 194 considered spam."
 195   :type 'boolean
 196   :group 'spam)
 197
 198 (defcustom spam-use-ifile nil
 199   "Whether ifile should be used by spam-split."
 200   :type 'boolean
 201   :group 'spam)
 202
 203 (defcustom spam-use-stat nil
 204   "Whether spam-stat should be used by spam-split."
 205   :type 'boolean
 206   :group 'spam)
 207
 208 (defcustom spam-use-spamoracle nil
 209   "Whether spamoracle should be used by spam-split."
 210   :type 'boolean
 211   :group 'spam)
 212
 213 (defcustom spam-install-hooks (or
 214                                spam-use-dig
 215                                spam-use-blacklist
 216                                spam-use-whitelist
 217                                spam-use-whitelist-exclusive
 218                                spam-use-blackholes
 219                                spam-use-hashcash
 220                                spam-use-regex-headers
 221                                spam-use-regex-body
 222                                spam-use-bogofilter-headers
 223                                spam-use-bogofilter
 224                                spam-use-BBDB
 225                                spam-use-BBDB-exclusive
 226                                spam-use-ifile
 227                                spam-use-stat
 228                                spam-use-spamoracle)
 229   "Whether the spam hooks should be installed, default to t if one of
 230 the spam-use-* variables is set."
 231   :group 'spam
 232   :type 'boolean)
 233
 234 (defcustom spam-split-group "spam"
 235   "Group name where incoming spam should be put by spam-split."
 236   :type 'string
 237   :group 'spam)
 238
 239 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings, not regular expressions
 240 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
 241   "Mailgroups with spam contents.
 242 All unmarked article in such group receive the spam mark on group entry."
 243   :type '(repeat (string :tag "Group"))
 244   :group 'spam)
 245
 246 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 247                                     "dev.null.dk" "relays.visi.com")
 248   "List of blackhole servers."
 249   :type '(repeat (string :tag "Server"))
 250   :group 'spam)
 251
 252 (defcustom spam-blackhole-good-server-regex nil
 253   "String matching IP addresses that should not be checked in the blackholes"
 254   :type '(radio (const nil)
 255                 (regexp :format "%t: %v\n" :size 0))
 256   :group 'spam)
 257
 258 (defcustom spam-face 'gnus-splash-face
 259   "Face for spam-marked articles"
 260   :type 'face
 261   :group 'spam)
 262
 263 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
 264   "Regular expression for positive header spam matches"
 265   :type '(repeat (regexp :tag "Regular expression to match spam header"))
 266   :group 'spam)
 267
 268 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
 269   "Regular expression for positive header ham matches"
 270   :type '(repeat (regexp :tag "Regular expression to match ham header"))
 271   :group 'spam)
 272
 273 (defcustom spam-regex-body-spam '()
 274   "Regular expression for positive body spam matches"
 275   :type '(repeat (regexp :tag "Regular expression to match spam body"))
 276   :group 'spam)
 277
 278 (defcustom spam-regex-body-ham '()
 279   "Regular expression for positive body ham matches"
 280   :type '(repeat (regexp :tag "Regular expression to match ham body"))
 281   :group 'spam)
 282
 283 (defgroup spam-ifile nil
 284   "Spam ifile configuration."
 285   :group 'spam)
 286
 287 (defcustom spam-ifile-path (exec-installed-p "ifile")
 288   "File path of the ifile executable program."
 289   :type '(choice (file :tag "Location of ifile")
 290                  (const :tag "ifile is not installed"))
 291   :group 'spam-ifile)
 292
 293 (defcustom spam-ifile-database-path nil
 294   "File path of the ifile database."
 295   :type '(choice (file :tag "Location of the ifile database")
 296                  (const :tag "Use the default"))
 297   :group 'spam-ifile)
 298
 299 (defcustom spam-ifile-spam-category "spam"
 300   "Name of the spam ifile category."
 301   :type 'string
 302   :group 'spam-ifile)
 303
 304 (defcustom spam-ifile-ham-category nil
 305   "Name of the ham ifile category.  If nil, the current group name will
 306 be used."
 307   :type '(choice (string :tag "Use a fixed category")
 308                 (const :tag "Use the current group name"))
 309   :group 'spam-ifile)
 310
 311 (defcustom spam-ifile-all-categories nil
 312   "Whether the ifile check will return all categories, or just spam.
 313 Set this to t if you want to use the spam-split invocation of ifile as
 314 your main source of newsgroup names."
 315   :type 'boolean
 316   :group 'spam-ifile)
 317
 318 (defgroup spam-bogofilter nil
 319   "Spam bogofilter configuration."
 320   :group 'spam)
 321
 322 (defcustom spam-bogofilter-path (exec-installed-p "bogofilter")
 323   "File path of the Bogofilter executable program."
 324   :type '(choice (file :tag "Location of bogofilter")
 325                  (const :tag "Bogofilter is not installed"))
 326   :group 'spam-bogofilter)
 327
 328 (defcustom spam-bogofilter-header "X-Bogosity"
 329   "The header that Bogofilter inserts in messages."
 330   :type 'string
 331   :group 'spam-bogofilter)
 332
 333 (defcustom spam-bogofilter-spam-switch "-s"
 334   "The switch that Bogofilter uses to register spam messages."
 335   :type 'string
 336   :group 'spam-bogofilter)
 337
 338 (defcustom spam-bogofilter-ham-switch "-n"
 339   "The switch that Bogofilter uses to register ham messages."
 340   :type 'string
 341   :group 'spam-bogofilter)
 342
 343 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
 344   "The regex on `spam-bogofilter-header' for positive spam identification."
 345   :type 'regexp
 346   :group 'spam-bogofilter)
 347
 348 (defcustom spam-bogofilter-database-directory nil
 349   "Directory path of the Bogofilter databases."
 350   :type '(choice (directory :tag "Location of the Bogofilter database directory")
 351                  (const :tag "Use the default"))
 352   :group 'spam-ifile)
 353
 354 (defgroup spam-spamoracle nil
 355   "Spam ifile configuration."
 356   :group 'spam)
 357
 358 (defcustom spam-spamoracle-database nil
 359   "Location of spamoracle database file. When nil, use the default
 360 spamoracle database."
 361   :type '(choice (directory :tag "Location of spamoracle database file.")
 362                  (const :tag "Use the default"))
 363   :group 'spam-spamoracle)
 364
 365 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
 366   "Location of the spamoracle binary."
 367   :type '(choice (directory :tag "Location of the spamoracle binary")
 368                  (const :tag "Use the default"))
 369   :group 'spam-spamoracle)
 370
 371 ;;; Key bindings for spam control.
 372
 373 (gnus-define-keys gnus-summary-mode-map
 374   "St" spam-bogofilter-score
 375   "Sx" gnus-summary-mark-as-spam
 376   "Mst" spam-bogofilter-score
 377   "Msx" gnus-summary-mark-as-spam
 378   "\M-d" gnus-summary-mark-as-spam)
 379
 380 ;; convenience functions
 381 (defun spam-group-ham-mark-p (group mark &optional spam)
 382   (when (stringp group)
 383     (let* ((marks (spam-group-ham-marks group spam))
 384            (marks (if (symbolp mark)
 385                       marks
 386                     (mapcar 'symbol-value marks))))
 387       (memq mark marks))))
 388
 389 (defun spam-group-spam-mark-p (group mark)
 390   (spam-group-ham-mark-p group mark t))
 391
 392 (defun spam-group-ham-marks (group &optional spam)
 393   (when (stringp group)
 394     (let* ((marks (if spam
 395                      (gnus-parameter-spam-marks group)
 396                    (gnus-parameter-ham-marks group)))
 397            (marks (car marks))
 398            (marks (if (listp (car marks)) (car marks) marks)))
 399       marks)))
 400
 401 (defun spam-group-spam-marks (group)
 402   (spam-group-ham-marks group t))
 403
 404 (defun spam-group-spam-contents-p (group)
 405   (if (stringp group)
 406       (or (member group spam-junk-mailgroups)
 407           (memq 'gnus-group-spam-classification-spam
 408                 (gnus-parameter-spam-contents group)))
 409     nil))
 410
 411 (defun spam-group-ham-contents-p (group)
 412   (if (stringp group)
 413       (memq 'gnus-group-spam-classification-ham
 414             (gnus-parameter-spam-contents group))
 415     nil))
 416
 417 (defun spam-group-processor-p (group processor)
 418   (if (and (stringp group)
 419            (symbolp processor))
 420       (member processor (car (gnus-parameter-spam-process group)))
 421     nil))
 422
 423 (defun spam-group-spam-processor-report-gmane-p (group)
 424   (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
 425
 426 (defun spam-group-spam-processor-bogofilter-p (group)
 427   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 428
 429 (defun spam-group-spam-processor-blacklist-p (group)
 430   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 431
 432 (defun spam-group-spam-processor-ifile-p (group)
 433   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 434
 435 (defun spam-group-ham-processor-ifile-p (group)
 436   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 437
 438 (defun spam-group-spam-processor-spamoracle-p (group)
 439   (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
 440
 441 (defun spam-group-ham-processor-bogofilter-p (group)
 442   (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
 443
 444 (defun spam-group-spam-processor-stat-p (group)
 445   (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
 446
 447 (defun spam-group-ham-processor-stat-p (group)
 448   (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
 449
 450 (defun spam-group-ham-processor-whitelist-p (group)
 451   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 452
 453 (defun spam-group-ham-processor-BBDB-p (group)
 454   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 455
 456 (defun spam-group-ham-processor-copy-p (group)
 457   (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
 458
 459 (defun spam-group-ham-processor-spamoracle-p (group)
 460   (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
 461
 462 ;;; Summary entry and exit processing.
 463
 464 (defun spam-summary-prepare ()
 465   (spam-mark-junk-as-spam-routine))
 466
 467 ;; The spam processors are invoked for any group, spam or ham or neither
 468 (defun spam-summary-prepare-exit ()
 469   (unless gnus-group-is-exiting-without-update-p
 470     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 471     (when (and spam-bogofilter-path
 472                (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
 473       (gnus-message 5 "Registering spam with bogofilter")
 474       (spam-bogofilter-register-spam-routine))
 475
 476     (when (and spam-ifile-path
 477                (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
 478       (gnus-message 5 "Registering spam with ifile")
 479       (spam-ifile-register-spam-routine))
 480
 481     (when (spam-group-spam-processor-spamoracle-p gnus-newsgroup-name)
 482       (gnus-message 5 "Registering spam with spamoracle")
 483       (spam-spamoracle-learn-spam))
 484
 485     (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
 486       (gnus-message 5 "Registering spam with spam-stat")
 487       (spam-stat-register-spam-routine))
 488
 489     (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
 490       (gnus-message 5 "Registering spam with the blacklist")
 491       (spam-blacklist-register-routine))
 492
 493     (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
 494       (gnus-message 5 "Registering spam with the Gmane report")
 495       (spam-report-gmane-register-routine))
 496
 497     (if spam-move-spam-nonspam-groups-only
 498         (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
 499           (spam-mark-spam-as-expired-and-move-routine
 500            (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 501       (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name)
 502       (spam-mark-spam-as-expired-and-move-routine
 503        (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 504
 505     ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 506     ;; expire spam, in case the above did not expire them
 507     (gnus-message 5 "Marking spam as expired without moving it")
 508     (spam-mark-spam-as-expired-and-move-routine nil)
 509
 510     (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
 511               (and (spam-group-spam-contents-p gnus-newsgroup-name)
 512                    spam-process-ham-in-spam-groups)
 513               spam-process-ham-in-nonham-groups)
 514       (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
 515         (gnus-message 5 "Registering ham with the whitelist")
 516         (spam-whitelist-register-routine))
 517       (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
 518         (gnus-message 5 "Registering ham with ifile")
 519         (spam-ifile-register-ham-routine))
 520       (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
 521         (gnus-message 5 "Registering ham with Bogofilter")
 522         (spam-bogofilter-register-ham-routine))
 523       (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
 524         (gnus-message 5 "Registering ham with spam-stat")
 525         (spam-stat-register-ham-routine))
 526       (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
 527         (gnus-message 5 "Registering ham with the BBDB")
 528         (spam-BBDB-register-routine))
 529       (when (spam-group-ham-processor-spamoracle-p gnus-newsgroup-name)
 530         (gnus-message 5 "Registering ham with spamoracle")
 531         (spam-spamoracle-learn-ham)))
 532
 533     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
 534       (gnus-message 5 "Copying ham")
 535       (spam-ham-copy-routine
 536        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
 537
 538     ;; now move all ham articles out of spam groups
 539     (when (spam-group-spam-contents-p gnus-newsgroup-name)
 540       (gnus-message 5 "Moving ham messages from spam group")
 541       (spam-ham-move-routine
 542        (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
 543
 544 (defun spam-mark-junk-as-spam-routine ()
 545   ;; check the global list of group names spam-junk-mailgroups and the
 546   ;; group parameters
 547   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 548     (gnus-message 5 "Marking %s articles as spam"
 549                   (if spam-mark-only-unseen-as-spam
 550                       "unseen"
 551                     "unread"))
 552     (let ((articles (if spam-mark-only-unseen-as-spam
 553                         gnus-newsgroup-unseen
 554                       gnus-newsgroup-unreads)))
 555       (dolist (article articles)
 556         (gnus-summary-mark-article article gnus-spam-mark)))))
 557
 558 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
 559   (gnus-summary-kill-process-mark)
 560   (let ((articles gnus-newsgroup-articles)
 561         article tomove deletep)
 562     (dolist (article articles)
 563       (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 564         (gnus-summary-mark-article article gnus-expirable-mark)
 565         (push article tomove)))
 566
 567     ;; now do the actual copies
 568     (dolist (group groups)
 569       (when (and tomove
 570                  (stringp group))
 571         (dolist (article tomove)
 572           (gnus-summary-set-process-mark article))
 573         (when tomove
 574           (if (> (length groups) 1)
 575               (progn
 576                 (gnus-summary-copy-article nil group)
 577                 (setq deletep t))
 578             (gnus-summary-move-article nil group)))))
 579
 580     ;; now delete the articles, if there was a copy done
 581     (when deletep
 582       (dolist (article tomove)
 583         (gnus-summary-set-process-mark article))
 584       (when tomove
 585         (let ((gnus-novice-user nil))   ; don't ask me if I'm sure
 586           (gnus-summary-delete-article nil))))
 587
 588     (gnus-summary-yank-process-mark)))
 589
 590 (defun spam-ham-copy-or-move-routine (copy groups)
 591   (gnus-summary-kill-process-mark)
 592   (let ((articles gnus-newsgroup-articles)
 593         article mark todo deletep)
 594     (dolist (article articles)
 595       (when (spam-group-ham-mark-p gnus-newsgroup-name
 596                                    (gnus-summary-article-mark article))
 597         (push article todo)))
 598
 599     ;; now do the actual move
 600     (dolist (group groups)
 601       (when (and todo (stringp group))
 602         (dolist (article todo)
 603           (when spam-mark-ham-unread-before-move-from-spam-group
 604             (gnus-summary-mark-article article gnus-unread-mark))
 605           (gnus-summary-set-process-mark article))
 606
 607         (if (> (length groups) 1)
 608             (progn
 609               (gnus-summary-copy-article nil group)
 610               (setq deletep t))
 611           (gnus-summary-move-article nil group))))
 612
 613     ;; now delete the articles, unless a) copy is t, and when there was a copy done
 614     ;;                                 b) a move was done to a single group
 615     (unless copy
 616       (when deletep
 617         (dolist (article todo)
 618           (gnus-summary-set-process-mark article))
 619         (when todo
 620           (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
 621             (gnus-summary-delete-article nil))))))
 622
 623   (gnus-summary-yank-process-mark))
 624
 625 (defun spam-ham-copy-routine (&rest groups)
 626   (spam-ham-copy-or-move-routine t groups))
 627
 628 (defun spam-ham-move-routine (&rest groups)
 629   (spam-ham-copy-or-move-routine nil groups))
 630
 631 (defun spam-generic-register-routine (spam-func ham-func)
 632   (let ((articles gnus-newsgroup-articles)
 633         article mark ham-articles spam-articles)
 634
 635     (while articles
 636       (setq article (pop articles)
 637             mark (gnus-summary-article-mark article))
 638       (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
 639              (push article spam-articles))
 640             ((memq article gnus-newsgroup-saved))
 641             ((spam-group-ham-mark-p gnus-newsgroup-name mark)
 642              (push article ham-articles))))
 643
 644     (when (and ham-articles ham-func)
 645       (mapc ham-func ham-articles))     ; we use mapc because unlike
 646                                         ; mapcar it discards the
 647                                         ; return values
 648     (when (and spam-articles spam-func)
 649       (mapc spam-func spam-articles)))) ; we use mapc because unlike
 650                                         ; mapcar it discards the
 651                                         ; return values
 652
 653 (eval-and-compile
 654   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 655                                    'point-at-eol
 656                                  'line-end-position)))
 657
 658 (defun spam-get-article-as-string (article)
 659   (let ((article-buffer (spam-get-article-as-buffer article))
 660                         article-string)
 661     (when article-buffer
 662       (save-window-excursion
 663         (set-buffer article-buffer)
 664         (setq article-string (buffer-string))))
 665   article-string))
 666
 667 (defun spam-get-article-as-buffer (article)
 668   (let ((article-buffer))
 669     (when (numberp article)
 670       (save-window-excursion
 671         (gnus-summary-goto-subject article)
 672         (gnus-summary-show-article t)
 673         (setq article-buffer (get-buffer gnus-article-buffer))))
 674     article-buffer))
 675
 676 ;; disabled for now
 677 ;; (defun spam-get-article-as-filename (article)
 678 ;;   (let ((article-filename))
 679 ;;     (when (numberp article)
 680 ;;       (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name))
 681 ;;       (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory)))
 682 ;;     (if (file-exists-p article-filename)
 683 ;;      article-filename
 684 ;;       nil)))
 685
 686 (defun spam-fetch-field-from-fast (article)
 687   "Fetch the `from' field quickly, using the internal gnus-data-list function"
 688   (if (and (numberp article)
 689            (assoc article (gnus-data-list nil)))
 690       (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
 691     nil))
 692
 693 (defun spam-fetch-field-subject-fast (article)
 694   "Fetch the `subject' field quickly, using the internal gnus-data-list function"
 695   (if (and (numberp article)
 696            (assoc article (gnus-data-list nil)))
 697       (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
 698     nil))
 699
 700 (defun spam-fetch-field-message-id-fast (article)
 701   "Fetch the `subject' field quickly, using the internal gnus-data-list function"
 702   (if (and (numberp article)
 703            (assoc article (gnus-data-list nil)))
 704       (mail-header-message-id (gnus-data-header (assoc article (gnus-data-list nil))))
 705     nil))
 706
 707 \f
 708 ;;;; Spam determination.
 709
 710 (defvar spam-list-of-checks
 711   '((spam-use-blacklist                 .       spam-check-blacklist)
 712     (spam-use-regex-headers             .       spam-check-regex-headers)
 713     (spam-use-regex-body                .       spam-check-regex-body)
 714     (spam-use-whitelist                 .       spam-check-whitelist)
 715     (spam-use-BBDB                      .       spam-check-BBDB)
 716     (spam-use-ifile                     .       spam-check-ifile)
 717     (spam-use-spamoracle                .       spam-check-spamoracle)
 718     (spam-use-stat                      .       spam-check-stat)
 719     (spam-use-blackholes                .       spam-check-blackholes)
 720     (spam-use-hashcash                  .       spam-check-hashcash)
 721     (spam-use-bogofilter-headers        .       spam-check-bogofilter-headers)
 722     (spam-use-bogofilter                .       spam-check-bogofilter))
 723 "The spam-list-of-checks list contains pairs associating a parameter
 724 variable with a spam checking function.  If the parameter variable is
 725 true, then the checking function is called, and its value decides what
 726 happens.  Each individual check may return nil, t, or a mailgroup
 727 name.  The value nil means that the check does not yield a decision,
 728 and so, that further checks are needed.  The value t means that the
 729 message is definitely not spam, and that further spam checks should be
 730 inhibited.  Otherwise, a mailgroup name is returned where the mail
 731 should go, and further checks are also inhibited.  The usual mailgroup
 732 name is the value of `spam-split-group', meaning that the message is
 733 definitely a spam.")
 734
 735 (defvar spam-list-of-statistical-checks
 736   '(spam-use-ifile spam-use-regex-body spam-use-stat spam-use-bogofilter spam-use-spamoracle)
 737 "The spam-list-of-statistical-checks list contains all the mail
 738 splitters that need to have the full message body available.")
 739
 740 ;;;TODO: modify to invoke self with each specific check if invoked without specific checks
 741 (defun spam-split (&rest specific-checks)
 742   "Split this message into the `spam' group if it is spam.
 743 This function can be used as an entry in `nnmail-split-fancy',
 744 for example like this: (: spam-split).  It can take checks as
 745 parameters.  A string as a parameter will set the
 746 spam-split-group to that string.
 747
 748 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 749   (interactive)
 750   (let ((spam-split-group-choice spam-split-group))
 751     (dolist (check specific-checks)
 752       (when (stringp check)
 753         (setq spam-split-group-choice check)
 754         (setq specific-checks (delq check specific-checks))))
 755
 756     (let ((spam-split-group spam-split-group-choice))
 757       (save-excursion
 758         (save-restriction
 759           (dolist (check spam-list-of-statistical-checks)
 760             (when (and (symbolp check) (symbol-value check))
 761               (widen)
 762               (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
 763                             (symbol-name check))
 764               (return)))
 765           ;;   (progn (widen) (debug (buffer-string)))
 766           (let ((list-of-checks spam-list-of-checks)
 767                 decision)
 768             (while (and list-of-checks (not decision))
 769               (let ((pair (pop list-of-checks)))
 770                 (when (and (symbol-value (car pair))
 771                            (or (null specific-checks)
 772                                (memq (car pair) specific-checks)))
 773                   (gnus-message 5 "spam-split: calling the %s function"
 774                                 (symbol-name (cdr pair)))
 775                   (setq decision (funcall (cdr pair))))))
 776             (if (eq decision t)
 777                 nil
 778               decision)))))))
 779
 780 ;;; log a spam-processor invocation to the registry
 781 (defun spam-log-processing-to-registry (id type classification check group)
 782   (when spam-log-to-registry
 783     (if (and (stringp id)
 784              (stringp group)
 785              (or (eq type 'incoming)
 786                  (eq type 'process))
 787              (or (eq classification 'spam)
 788                  (eq classification 'ham))
 789              (assoc check spam-list-of-checks))
 790         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
 791                (cell (list classification check group)))
 792           (push cell cell-list)
 793           (gnus-registry-store-extra-entry
 794            id
 795            type
 796            cell-list))
 797
 798       (gnus-message 5 "spam-log-processing-to-registry called with bad ID, type, check, or group"))))
 799
 800 ;;; set up IMAP widening if it's necessary
 801 (defun spam-setup-widening ()
 802   (dolist (check spam-list-of-statistical-checks)
 803     (when (symbol-value check)
 804       (setq nnimap-split-download-body-default t))))
 805
 806 \f
 807 ;;;; Regex body
 808
 809 (defun spam-check-regex-body ()
 810   (let ((spam-regex-headers-ham spam-regex-body-ham)
 811         (spam-regex-headers-spam spam-regex-body-spam))
 812     (spam-check-regex-headers t)))
 813
 814 \f
 815 ;;;; Regex headers
 816
 817 (defun spam-check-regex-headers (&optional body)
 818   (let ((type (if body "body" "header"))
 819          ret found)
 820     (dolist (h-regex spam-regex-headers-ham)
 821       (unless found
 822         (goto-char (point-min))
 823         (when (re-search-forward h-regex nil t)
 824           (message "Ham regex %s search positive." type)
 825           (setq found t))))
 826     (dolist (s-regex spam-regex-headers-spam)
 827       (unless found
 828         (goto-char (point-min))
 829         (when (re-search-forward s-regex nil t)
 830           (message "Spam regex %s search positive." type)
 831           (setq found t)
 832           (setq ret spam-split-group))))
 833     ret))
 834
 835 \f
 836 ;;;; Blackholes.
 837
 838 (defun spam-reverse-ip-string (ip)
 839   (when (stringp ip)
 840     (mapconcat 'identity
 841                (nreverse (split-string ip "\\."))
 842                ".")))
 843
 844 (defun spam-check-blackholes ()
 845   "Check the Received headers for blackholed relays."
 846   (let ((headers (nnmail-fetch-field "received"))
 847         ips matches)
 848     (when headers
 849       (with-temp-buffer
 850         (insert headers)
 851         (goto-char (point-min))
 852         (gnus-message 5 "Checking headers for relay addresses")
 853         (while (re-search-forward
 854                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
 855           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
 856           (push (spam-reverse-ip-string (match-string 1))
 857                 ips)))
 858       (dolist (server spam-blackhole-servers)
 859         (dolist (ip ips)
 860           (unless (and spam-blackhole-good-server-regex
 861                        ;; match the good-server-regex against the reversed (again) IP string
 862                        (string-match
 863                         spam-blackhole-good-server-regex
 864                         (spam-reverse-ip-string ip)))
 865             (unless matches
 866               (let ((query-string (concat ip "." server)))
 867                 (if spam-use-dig
 868                     (let ((query-result (query-dig query-string)))
 869                       (when query-result
 870                         (gnus-message 5 "(DIG): positive blackhole check '%s'"
 871                                       query-result)
 872                         (push (list ip server query-result)
 873                               matches)))
 874                   ;; else, if not using dig.el
 875                   (when (query-dns query-string)
 876                     (gnus-message 5 "positive blackhole check")
 877                     (push (list ip server (query-dns query-string 'TXT))
 878                           matches)))))))))
 879     (when matches
 880       spam-split-group)))
 881 \f
 882 ;;;; Hashcash.
 883
 884 (condition-case nil
 885     (progn
 886       (require 'hashcash)
 887
 888       (defun spam-check-hashcash ()
 889         "Check the headers for hashcash payments."
 890         (mail-check-payment)))          ;mail-check-payment returns a boolean
 891
 892   (file-error (progn
 893                 (defalias 'mail-check-payment 'ignore)
 894                 (defalias 'spam-check-hashcash 'ignore))))
 895 \f
 896 ;;;; BBDB
 897
 898 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
 899 ;;; <sacha@giotto.sj.ru>
 900
 901 ;; all this is done inside a condition-case to trap errors
 902
 903 (condition-case nil
 904     (progn
 905       (require 'bbdb)
 906       (require 'bbdb-com)
 907
 908   (defun spam-enter-ham-BBDB (from)
 909     "Enter an address into the BBDB; implies ham (non-spam) sender"
 910     (when (stringp from)
 911       (let* ((parsed-address (gnus-extract-address-components from))
 912              (name (or (car parsed-address) "Ham Sender"))
 913              (net-address (car (cdr parsed-address))))
 914         (gnus-message 5 "Adding address %s to BBDB" from)
 915         (when (and net-address
 916                    (not (bbdb-search-simple nil net-address)))
 917           (bbdb-create-internal name nil net-address nil nil
 918                                 "ham sender added by spam.el")))))
 919
 920   (defun spam-BBDB-register-routine ()
 921     (spam-generic-register-routine
 922      ;; spam function
 923      nil
 924      ;; ham function
 925      (lambda (article)
 926        (spam-log-processing-to-registry
 927         (spam-fetch-field-message-id-fast article)
 928         'process
 929         'ham
 930         'spam-processing-use-BBDB
 931         gnus-newsgroup-name)
 932        (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 933
 934   (defun spam-check-BBDB ()
 935     "Mail from people in the BBDB is classified as ham or non-spam"
 936     (let ((who (nnmail-fetch-field "from")))
 937       (when who
 938         (setq who (cadr (gnus-extract-address-components who)))
 939         (if (bbdb-search-simple nil who)
 940             t
 941           (if spam-use-BBDB-exclusive
 942               spam-split-group
 943             nil))))))
 944
 945   (file-error (progn
 946                 (defalias 'bbdb-search-simple 'ignore)
 947                 (defalias 'spam-check-BBDB 'ignore)
 948                 (defalias 'spam-BBDB-register-routine 'ignore)
 949                 (defalias 'spam-enter-ham-BBDB 'ignore)
 950                 (defalias 'bbdb-create-internal 'ignore)
 951                 (defalias 'bbdb-records 'ignore))))
 952
 953 \f
 954 ;;;; ifile
 955
 956 ;;; check the ifile backend; return nil if the mail was NOT classified
 957 ;;; as spam
 958
 959 (defun spam-get-ifile-database-parameter ()
 960   "Get the command-line parameter for ifile's database from spam-ifile-database-path."
 961   (if spam-ifile-database-path
 962       (format "--db-file=%s" spam-ifile-database-path)
 963     nil))
 964
 965 (defun spam-check-ifile ()
 966   "Check the ifile backend for the classification of this message"
 967   (let ((article-buffer-name (buffer-name))
 968         category return)
 969     (with-temp-buffer
 970       (let ((temp-buffer-name (buffer-name))
 971             (db-param (spam-get-ifile-database-parameter)))
 972         (save-excursion
 973           (set-buffer article-buffer-name)
 974           (if db-param
 975               (call-process-region (point-min) (point-max) spam-ifile-path
 976                                    nil temp-buffer-name nil "-q" "-c" db-param)
 977             (call-process-region (point-min) (point-max) spam-ifile-path
 978                                  nil temp-buffer-name nil "-q" "-c")))
 979         (goto-char (point-min))
 980         (if (not (eobp))
 981             (setq category (buffer-substring (point) (spam-point-at-eol))))
 982         (when (not (zerop (length category))) ; we need a category here
 983           (if spam-ifile-all-categories
 984               (setq return category)
 985             ;; else, if spam-ifile-all-categories is not set...
 986             (when (string-equal spam-ifile-spam-category category)
 987               (setq return spam-split-group))))))
 988     return))
 989
 990 (defun spam-ifile-register-with-ifile (article-string category)
 991   "Register an article, given as a string, with a category.
 992 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 993   (when (stringp article-string)
 994     (let ((category (or category gnus-newsgroup-name))
 995           (db-param (spam-get-ifile-database-parameter)))
 996       (with-temp-buffer
 997         (insert article-string)
 998         (if db-param
 999             (call-process-region (point-min) (point-max) spam-ifile-path
1000                                  nil nil nil
1001                                  "-h" "-i" category db-param)
1002           (call-process-region (point-min) (point-max) spam-ifile-path
1003                                nil nil nil
1004                                "-h" "-i" category))))))
1005
1006 (defun spam-ifile-register-spam-routine ()
1007   (spam-generic-register-routine
1008    (lambda (article)
1009      (spam-log-processing-to-registry
1010       (spam-fetch-field-message-id-fast article)
1011       'process
1012       'spam
1013       'spam-processing-use-ifile-spam
1014       gnus-newsgroup-name)
1015      (spam-ifile-register-with-ifile
1016       (spam-get-article-as-string article) spam-ifile-spam-category))
1017    nil))
1018
1019 (defun spam-ifile-register-ham-routine ()
1020   (spam-generic-register-routine
1021    nil
1022    (lambda (article)
1023      (spam-log-processing-to-registry
1024       (spam-fetch-field-message-id-fast article)
1025       'process
1026       'ham
1027       'spam-processing-use-ifile-ham
1028       gnus-newsgroup-name)
1029      (spam-ifile-register-with-ifile
1030       (spam-get-article-as-string article) spam-ifile-ham-category))))
1031
1032 \f
1033 ;;;; spam-stat
1034
1035 (condition-case nil
1036     (progn
1037       (let ((spam-stat-install-hooks nil))
1038         (require 'spam-stat))
1039
1040       (defun spam-check-stat ()
1041         "Check the spam-stat backend for the classification of this message"
1042         (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
1043               (spam-stat-buffer (buffer-name)) ; stat the current buffer
1044               category return)
1045           (spam-stat-split-fancy)))
1046
1047       (defun spam-stat-register-spam-routine ()
1048         (spam-generic-register-routine
1049          (lambda (article)
1050            (spam-log-processing-to-registry
1051             (spam-fetch-field-message-id-fast article)
1052             'process
1053             'spam
1054             'spam-processing-use-stat-spam
1055             gnus-newsgroup-name)
1056            (let ((article-string (spam-get-article-as-string article)))
1057              (with-temp-buffer
1058                (insert article-string)
1059                (spam-stat-buffer-is-spam))))
1060          nil))
1061
1062       (defun spam-stat-register-ham-routine ()
1063         (spam-generic-register-routine
1064          nil
1065          (lambda (article)
1066            (spam-log-processing-to-registry
1067             (spam-fetch-field-message-id-fast article)
1068             'process
1069             'ham
1070             'spam-processing-use-stat-ham
1071             gnus-newsgroup-name)
1072            (let ((article-string (spam-get-article-as-string article)))
1073              (with-temp-buffer
1074                (insert article-string)
1075                (spam-stat-buffer-is-non-spam))))))
1076
1077       (defun spam-maybe-spam-stat-load ()
1078         (when spam-use-stat (spam-stat-load)))
1079
1080       (defun spam-maybe-spam-stat-save ()
1081         (when spam-use-stat (spam-stat-save))))
1082
1083   (file-error (progn
1084                 (defalias 'spam-maybe-spam-stat-load 'ignore)
1085                 (defalias 'spam-maybe-spam-stat-save 'ignore)
1086                 (defalias 'spam-stat-register-ham-routine 'ignore)
1087                 (defalias 'spam-stat-register-spam-routine 'ignore)
1088                 (defalias 'spam-stat-buffer-is-spam 'ignore)
1089                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
1090                 (defalias 'spam-stat-split-fancy 'ignore)
1091                 (defalias 'spam-stat-load 'ignore)
1092                 (defalias 'spam-stat-save 'ignore)
1093                 (defalias 'spam-check-stat 'ignore))))
1094
1095 \f
1096
1097 ;;;; Blacklists and whitelists.
1098
1099 (defvar spam-whitelist-cache nil)
1100 (defvar spam-blacklist-cache nil)
1101
1102 (defun spam-enter-whitelist (address)
1103   "Enter ADDRESS into the whitelist."
1104   (interactive "sAddress: ")
1105   (spam-enter-list address spam-whitelist)
1106   (setq spam-whitelist-cache nil))
1107
1108 (defun spam-enter-blacklist (address)
1109   "Enter ADDRESS into the blacklist."
1110   (interactive "sAddress: ")
1111   (spam-enter-list address spam-blacklist)
1112   (setq spam-blacklist-cache nil))
1113
1114 (defun spam-enter-list (address file)
1115   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
1116   (unless (file-exists-p (file-name-directory file))
1117     (make-directory (file-name-directory file) t))
1118   (save-excursion
1119     (set-buffer
1120      (find-file-noselect file))
1121     (goto-char (point-min))
1122     (unless (re-search-forward (regexp-quote address) nil t)
1123       (goto-char (point-max))
1124       (unless (bobp)
1125         (insert "\n"))
1126       (insert address "\n")
1127       (save-buffer))))
1128
1129 ;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
1130 (defun spam-check-whitelist ()
1131   ;; FIXME!  Should it detect when file timestamps change?
1132   (unless spam-whitelist-cache
1133     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
1134   (if (spam-from-listed-p spam-whitelist-cache)
1135       t
1136     (if spam-use-whitelist-exclusive
1137         spam-split-group
1138       nil)))
1139
1140 (defun spam-check-blacklist ()
1141   ;; FIXME!  Should it detect when file timestamps change?
1142   (unless spam-blacklist-cache
1143     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1144   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
1145
1146 (defun spam-parse-list (file)
1147   (when (file-readable-p file)
1148     (let (contents address)
1149       (with-temp-buffer
1150         (insert-file-contents file)
1151         (while (not (eobp))
1152           (setq address (buffer-substring (point) (spam-point-at-eol)))
1153           (forward-line 1)
1154           ;; insert the e-mail address if detected, otherwise the raw data
1155           (unless (zerop (length address))
1156             (let ((pure-address (cadr (gnus-extract-address-components address))))
1157               (push (or pure-address address) contents)))))
1158       (nreverse contents))))
1159
1160 (defun spam-from-listed-p (cache)
1161   (let ((from (nnmail-fetch-field "from"))
1162         found)
1163     (while cache
1164       (let ((address (pop cache)))
1165         (unless (zerop (length address)) ; 0 for a nil address too
1166           (setq address (regexp-quote address))
1167           ;; fix regexp-quote's treatment of user-intended regexes
1168           (while (string-match "\\\\\\*" address)
1169             (setq address (replace-match ".*" t t address))))
1170         (when (and address (string-match address from))
1171           (setq found t
1172                 cache nil))))
1173     found))
1174
1175 (defun spam-blacklist-register-routine ()
1176   (spam-generic-register-routine
1177    ;; the spam function
1178    (lambda (article)
1179      (spam-log-processing-to-registry
1180       (spam-fetch-field-message-id-fast article)
1181       'process
1182       'spam
1183       'spam-processing-use-blacklist
1184       gnus-newsgroup-name)
1185      (let ((from (spam-fetch-field-from-fast article)))
1186        (when (stringp from)
1187            (spam-enter-blacklist from))))
1188    ;; the ham function
1189    nil))
1190
1191 (defun spam-whitelist-register-routine ()
1192   (spam-generic-register-routine
1193    ;; the spam function
1194    nil
1195    ;; the ham function
1196    (lambda (article)
1197      (spam-log-processing-to-registry
1198       (spam-fetch-field-message-id-fast article)
1199       'process
1200       'ham
1201       'spam-processing-use-whitelist
1202       gnus-newsgroup-name)
1203      (let ((from (spam-fetch-field-from-fast article)))
1204        (when (stringp from)
1205            (spam-enter-whitelist from))))))
1206
1207 \f
1208 ;;;; Spam-report glue
1209 (defun spam-report-gmane-register-routine ()
1210   (spam-generic-register-routine
1211    'spam-report-gmane
1212    nil))
1213
1214 \f
1215 ;;;; Bogofilter
1216 (defun spam-check-bogofilter-headers (&optional score)
1217   (let ((header (nnmail-fetch-field spam-bogofilter-header)))
1218     (when header                        ; return nil when no header
1219       (if score                         ; scoring mode
1220           (if (string-match "spamicity=\\([0-9.]+\\)" header)
1221               (match-string 1 header)
1222             "0")
1223         ;; spam detection mode
1224         (when (string-match spam-bogofilter-bogosity-positive-spam-header
1225                             header)
1226           spam-split-group)))))
1227
1228 ;; return something sensible if the score can't be determined
1229 (defun spam-bogofilter-score ()
1230   "Get the Bogofilter spamicity score"
1231   (interactive)
1232   (save-window-excursion
1233     (gnus-summary-show-article t)
1234     (set-buffer gnus-article-buffer)
1235     (let ((score (or (spam-check-bogofilter-headers t)
1236                      (spam-check-bogofilter t))))
1237       (message "Spamicity score %s" score)
1238       (or score "0"))
1239     (gnus-summary-show-article)))
1240
1241 (defun spam-check-bogofilter (&optional score)
1242   "Check the Bogofilter backend for the classification of this message"
1243   (let ((article-buffer-name (buffer-name))
1244         return)
1245     (with-temp-buffer
1246       (let ((temp-buffer-name (buffer-name)))
1247         (save-excursion
1248           (set-buffer article-buffer-name)
1249           (if spam-bogofilter-database-directory
1250               (call-process-region (point-min) (point-max)
1251                                    spam-bogofilter-path
1252                                    nil temp-buffer-name nil "-v"
1253                                    "-d" spam-bogofilter-database-directory)
1254             (call-process-region (point-min) (point-max) spam-bogofilter-path
1255                                  nil temp-buffer-name nil "-v")))
1256         (setq return (spam-check-bogofilter-headers score))))
1257     return))
1258
1259 (defun spam-bogofilter-register-with-bogofilter (article-string spam)
1260   "Register an article, given as a string, as spam or non-spam."
1261   (when (stringp article-string)
1262     (let ((switch (if spam spam-bogofilter-spam-switch
1263                     spam-bogofilter-ham-switch)))
1264       (with-temp-buffer
1265         (insert article-string)
1266         (if spam-bogofilter-database-directory
1267             (call-process-region (point-min) (point-max)
1268                                  spam-bogofilter-path
1269                                  nil nil nil "-v" switch
1270                                  "-d" spam-bogofilter-database-directory)
1271           (call-process-region (point-min) (point-max) spam-bogofilter-path
1272                                nil nil nil "-v" switch))))))
1273
1274 (defun spam-bogofilter-register-spam-routine ()
1275   (spam-generic-register-routine
1276    (lambda (article)
1277      (spam-log-processing-to-registry
1278       (spam-fetch-field-message-id-fast article)
1279       'process
1280       'spam
1281       'spam-processing-use-bogofilter-spam
1282       gnus-newsgroup-name)
1283      (spam-bogofilter-register-with-bogofilter
1284       (spam-get-article-as-string article) t))
1285    nil))
1286
1287 (defun spam-bogofilter-register-ham-routine ()
1288   (spam-generic-register-routine
1289    nil
1290    (lambda (article)
1291      (spam-log-processing-to-registry
1292       (spam-fetch-field-message-id-fast article)
1293       'process
1294       'ham
1295       'spam-processing-use-bogofilter-ham
1296       gnus-newsgroup-name)
1297      (spam-bogofilter-register-with-bogofilter
1298       (spam-get-article-as-string article) nil))))
1299
1300 \f
1301 ;;;; spamoracle
1302 (defun spam-check-spamoracle ()
1303   "Run spamoracle on an article to determine whether it's spam."
1304   (let ((article-buffer-name (buffer-name)))
1305     (with-temp-buffer
1306       (let ((temp-buffer-name (buffer-name)))
1307         (save-excursion
1308           (set-buffer article-buffer-name)
1309           (let ((status
1310                  (apply 'call-process-region
1311                         (point-min) (point-max)
1312                         spam-spamoracle-binary
1313                         nil temp-buffer-name nil
1314                         (if spam-spamoracle-database
1315                             `("-f" ,spam-spamoracle-database "mark")
1316                           '("mark")))))
1317             (if (zerop status)
1318                 (progn
1319                   (set-buffer temp-buffer-name)
1320                   (goto-char (point-min))
1321                   (when (re-search-forward "^X-Spam: yes;" nil t)
1322                     spam-split-group))
1323               (error "Error running spamoracle" status))))))))
1324
1325 (defun spam-spamoracle-learn (article article-is-spam-p)
1326   "Run spamoracle in training mode."
1327   (with-temp-buffer
1328     (let ((temp-buffer-name (buffer-name)))
1329       (save-excursion
1330         (goto-char (point-min))
1331         (insert (spam-get-article-as-string article))
1332         (let* ((arg (if article-is-spam-p "-spam" "-good"))
1333                (status
1334                 (apply 'call-process-region
1335                        (point-min) (point-max)
1336                        spam-spamoracle-binary
1337                        nil temp-buffer-name nil
1338                        (if spam-spamoracle-database
1339                            `("-f" ,spam-spamoracle-database
1340                              "add" ,arg)
1341                          `("add" ,arg)))))
1342           (when (not (zerop status))
1343             (error "Error running spamoracle" status)))))))
1344
1345 (defun spam-spamoracle-learn-ham ()
1346   (spam-generic-register-routine
1347    nil
1348    (lambda (article)
1349      (spam-log-processing-to-registry
1350       (spam-fetch-field-message-id-fast article)
1351       'process
1352       'ham
1353       'spam-processing-use-spamoracle-ham
1354       gnus-newsgroup-name)
1355      (spam-spamoracle-learn article nil))))
1356
1357 (defun spam-spamoracle-learn-spam ()
1358   (spam-generic-register-routine
1359    (lambda (article)
1360      (spam-log-processing-to-registry
1361       (spam-fetch-field-message-id-fast article)
1362       'process
1363       'spam
1364       'spam-processing-use-spamoracle-spam
1365       gnus-newsgroup-name)
1366      (spam-spamoracle-learn article t))
1367    nil))
1368 \f
1369 ;;;; Hooks
1370
1371 ;;;###autoload
1372 (defun spam-initialize ()
1373   "Install the spam.el hooks and do other initialization"
1374   (interactive)
1375   (setq spam-install-hooks t)
1376   ;; TODO: How do we redo this every time spam-face is customized?
1377   (push '((eq mark gnus-spam-mark) . spam-face)
1378         gnus-summary-highlight)
1379   ;; Add hooks for loading and saving the spam stats
1380   (when spam-use-stat
1381     (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1382     (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1383     (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load))
1384   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1385   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1386   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening))
1387
1388 (defun spam-unload-hook ()
1389   "Uninstall the spam.el hooks"
1390   (interactive)
1391   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
1392   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
1393   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
1394   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1395   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1396   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening))
1397
1398 (when spam-install-hooks
1399   (spam-initialize))
1400
1401 (provide 'spam)
1402
1403 ;;; spam.el ends here.