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

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