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