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