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