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 ()
 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)
 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 (symbol-value (car pair))
 623               (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair)))
 624               (setq decision (funcall (cdr pair))))))
 625         (if (eq decision t)
 626             nil
 627           decision)))))
 628
 629 (defun spam-setup-widening ()
 630   (dolist (check spam-list-of-statistical-checks)
 631     (when (symbol-value check)
 632       (setq nnimap-split-download-body-default t))))
 633
 634 (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
 635
 636 \f
 637 ;;;; Regex headers
 638
 639 (defun spam-check-regex-headers ()
 640   (let (ret found)
 641     (dolist (h-regex spam-regex-headers-ham)
 642       (unless found
 643         (goto-char (point-min))
 644         (when (re-search-forward h-regex nil t)
 645           (message "Ham regex header search positive.")
 646           (setq found t))))
 647     (dolist (s-regex spam-regex-headers-spam)
 648       (unless found
 649         (goto-char (point-min))
 650         (when (re-search-forward s-regex nil t)
 651           (message "Spam regex header search positive." (match-string 1))
 652           (setq found t)
 653           (setq ret spam-split-group))))
 654     ret))
 655
 656 \f
 657 ;;;; Blackholes.
 658
 659 (defun spam-check-blackholes ()
 660   "Check the Received headers for blackholed relays."
 661   (let ((headers (message-fetch-field "received"))
 662         ips matches)
 663     (when headers
 664       (with-temp-buffer
 665         (insert headers)
 666         (goto-char (point-min))
 667         (gnus-message 5 "Checking headers for relay addresses")
 668         (while (re-search-forward
 669                 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
 670           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
 671           (push (mapconcat 'identity
 672                            (nreverse (split-string (match-string 1) "\\."))
 673                            ".")
 674                 ips)))
 675       (dolist (server spam-blackhole-servers)
 676         (dolist (ip ips)
 677           (unless (and spam-blackhole-good-server-regex
 678                        (string-match spam-blackhole-good-server-regex ip))
 679             (let ((query-string (concat ip "." server)))
 680               (if spam-use-dig
 681                   (let ((query-result (query-dig query-string)))
 682                     (when query-result
 683                       (gnus-message 5 "(DIG): positive blackhole check '%s'"
 684                                     query-result)
 685                       (push (list ip server query-result)
 686                             matches)))
 687                 ;; else, if not using dig.el
 688                 (when (query-dns query-string)
 689                   (gnus-message 5 "positive blackhole check")
 690                   (push (list ip server (query-dns query-string 'TXT))
 691                         matches))))))))
 692     (when matches
 693       spam-split-group)))
 694 \f
 695 ;;;; Hashcash.
 696
 697 (condition-case nil
 698     (progn
 699       (require 'hashcash)
 700
 701       (defun spam-check-hashcash ()
 702         "Check the headers for hashcash payments."
 703         (mail-check-payment)))          ;mail-check-payment returns a boolean
 704
 705   (file-error (progn
 706                 (defalias 'mail-check-payment 'ignore)
 707                 (defalias 'spam-check-hashcash 'ignore))))
 708 \f
 709 ;;;; BBDB
 710
 711 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
 712 ;;; <sacha@giotto.sj.ru>
 713
 714 ;; all this is done inside a condition-case to trap errors
 715
 716 (condition-case nil
 717     (progn
 718       (require 'bbdb)
 719       (require 'bbdb-com)
 720
 721   (defun spam-enter-ham-BBDB (from)
 722     "Enter an address into the BBDB; implies ham (non-spam) sender"
 723     (when (stringp from)
 724       (let* ((parsed-address (gnus-extract-address-components from))
 725              (name (or (car parsed-address) "Ham Sender"))
 726              (net-address (car (cdr parsed-address))))
 727         (gnus-message 5 "Adding address %s to BBDB" from)
 728         (when (and net-address
 729                    (not (bbdb-search-simple nil net-address)))
 730           (bbdb-create-internal name nil net-address nil nil
 731                                 "ham sender added by spam.el")))))
 732
 733   (defun spam-BBDB-register-routine ()
 734     (spam-generic-register-routine
 735      ;; spam function
 736      nil
 737      ;; ham function
 738      (lambda (article)
 739        (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 740
 741   (defun spam-check-BBDB ()
 742     "Mail from people in the BBDB is classified as ham or non-spam"
 743     (let ((who (message-fetch-field "from")))
 744       (when who
 745         (setq who (cadr (gnus-extract-address-components who)))
 746         (if (bbdb-search-simple nil who)
 747             t
 748           (if spam-use-BBDB-exclusive
 749               spam-split-group
 750             nil))))))
 751
 752   (file-error (progn
 753                 (defalias 'bbdb-search-simple 'ignore)
 754                 (defalias 'spam-check-BBDB 'ignore)
 755                 (defalias 'spam-BBDB-register-routine 'ignore)
 756                 (defalias 'spam-enter-ham-BBDB 'ignore)
 757                 (defalias 'bbdb-create-internal 'ignore)
 758                 (defalias 'bbdb-records 'ignore))))
 759
 760 \f
 761 ;;;; ifile
 762
 763 ;;; check the ifile backend; return nil if the mail was NOT classified
 764 ;;; as spam
 765
 766 (defun spam-get-ifile-database-parameter ()
 767   "Get the command-line parameter for ifile's database from spam-ifile-database-path."
 768   (if spam-ifile-database-path
 769       (format "--db-file=%s" spam-ifile-database-path)
 770     nil))
 771
 772 (defun spam-check-ifile ()
 773   "Check the ifile backend for the classification of this message"
 774   (let ((article-buffer-name (buffer-name))
 775         category return)
 776     (with-temp-buffer
 777       (let ((temp-buffer-name (buffer-name))
 778             (db-param (spam-get-ifile-database-parameter)))
 779         (save-excursion
 780           (set-buffer article-buffer-name)
 781           (if db-param
 782               (call-process-region (point-min) (point-max) spam-ifile-path
 783                                    nil temp-buffer-name nil "-q" "-c" db-param)
 784             (call-process-region (point-min) (point-max) spam-ifile-path
 785                                  nil temp-buffer-name nil "-q" "-c")))
 786         (goto-char (point-min))
 787         (if (not (eobp))
 788             (setq category (buffer-substring (point) (spam-point-at-eol))))
 789         (when (not (zerop (length category))) ; we need a category here
 790           (if spam-ifile-all-categories
 791               (setq return category)
 792             ;; else, if spam-ifile-all-categories is not set...
 793             (when (string-equal spam-ifile-spam-category category)
 794               (setq return spam-split-group))))))
 795     return))
 796
 797 (defun spam-ifile-register-with-ifile (article-string category)
 798   "Register an article, given as a string, with a category.
 799 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 800   (when (stringp article-string)
 801     (let ((category (or category gnus-newsgroup-name))
 802           (db-param (spam-get-ifile-database-parameter)))
 803       (with-temp-buffer
 804         (insert article-string)
 805         (if db-param
 806             (call-process-region (point-min) (point-max) spam-ifile-path
 807                                  nil nil nil
 808                                  "-h" "-i" category db-param)
 809           (call-process-region (point-min) (point-max) spam-ifile-path
 810                                nil nil nil
 811                                "-h" "-i" category))))))
 812
 813 (defun spam-ifile-register-spam-routine ()
 814   (spam-generic-register-routine
 815    (lambda (article)
 816      (spam-ifile-register-with-ifile
 817       (spam-get-article-as-string article) spam-ifile-spam-category))
 818    nil))
 819
 820 (defun spam-ifile-register-ham-routine ()
 821   (spam-generic-register-routine
 822    nil
 823    (lambda (article)
 824      (spam-ifile-register-with-ifile
 825       (spam-get-article-as-string article) spam-ifile-ham-category))))
 826
 827 \f
 828 ;;;; spam-stat
 829
 830 (condition-case nil
 831     (progn
 832       (let ((spam-stat-install-hooks nil))
 833         (require 'spam-stat))
 834
 835       (defun spam-check-stat ()
 836         "Check the spam-stat backend for the classification of this message"
 837         (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
 838               (spam-stat-buffer (buffer-name)) ; stat the current buffer
 839               category return)
 840           (spam-stat-split-fancy)))
 841
 842       (defun spam-stat-register-spam-routine ()
 843         (spam-generic-register-routine
 844          (lambda (article)
 845            (let ((article-string (spam-get-article-as-string article)))
 846              (with-temp-buffer
 847                (insert article-string)
 848                (spam-stat-buffer-is-spam))))
 849          nil))
 850
 851       (defun spam-stat-register-ham-routine ()
 852         (spam-generic-register-routine
 853          nil
 854          (lambda (article)
 855            (let ((article-string (spam-get-article-as-string article)))
 856              (with-temp-buffer
 857                (insert article-string)
 858                (spam-stat-buffer-is-non-spam))))))
 859
 860       (defun spam-maybe-spam-stat-load ()
 861         (when spam-use-stat (spam-stat-load)))
 862
 863       (defun spam-maybe-spam-stat-save ()
 864         (when spam-use-stat (spam-stat-save)))
 865
 866       ;; Add hooks for loading and saving the spam stats
 867       (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
 868       (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
 869       (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load))
 870
 871   (file-error (progn
 872                 (defalias 'spam-stat-register-ham-routine 'ignore)
 873                 (defalias 'spam-stat-register-spam-routine 'ignore)
 874                 (defalias 'spam-stat-buffer-is-spam 'ignore)
 875                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
 876                 (defalias 'spam-stat-split-fancy 'ignore)
 877                 (defalias 'spam-stat-load 'ignore)
 878                 (defalias 'spam-stat-save 'ignore)
 879                 (defalias 'spam-check-stat 'ignore))))
 880
 881 \f
 882
 883 ;;;; Blacklists and whitelists.
 884
 885 (defvar spam-whitelist-cache nil)
 886 (defvar spam-blacklist-cache nil)
 887
 888 (defun spam-enter-whitelist (address)
 889   "Enter ADDRESS into the whitelist."
 890   (interactive "sAddress: ")
 891   (spam-enter-list address spam-whitelist)
 892   (setq spam-whitelist-cache nil))
 893
 894 (defun spam-enter-blacklist (address)
 895   "Enter ADDRESS into the blacklist."
 896   (interactive "sAddress: ")
 897   (spam-enter-list address spam-blacklist)
 898   (setq spam-blacklist-cache nil))
 899
 900 (defun spam-enter-list (address file)
 901   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 902   (unless (file-exists-p (file-name-directory file))
 903     (make-directory (file-name-directory file) t))
 904   (save-excursion
 905     (set-buffer
 906      (find-file-noselect file))
 907     (goto-char (point-max))
 908     (unless (bobp)
 909       (insert "\n"))
 910     (insert address "\n")
 911     (save-buffer)))
 912
 913 ;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
 914 (defun spam-check-whitelist ()
 915   ;; FIXME!  Should it detect when file timestamps change?
 916   (unless spam-whitelist-cache
 917     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 918   (if (spam-from-listed-p spam-whitelist-cache)
 919       t
 920     (if spam-use-whitelist-exclusive
 921         spam-split-group
 922       nil)))
 923
 924 (defun spam-check-blacklist ()
 925   ;; FIXME!  Should it detect when file timestamps change?
 926   (unless spam-blacklist-cache
 927     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 928   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 929
 930 (defun spam-parse-list (file)
 931   (when (file-readable-p file)
 932     (let (contents address)
 933       (with-temp-buffer
 934         (insert-file-contents file)
 935         (while (not (eobp))
 936           (setq address (buffer-substring (point) (spam-point-at-eol)))
 937           (forward-line 1)
 938           (unless (zerop (length address))
 939             (setq address (regexp-quote address))
 940             (while (string-match "\\\\\\*" address)
 941               (setq address (replace-match ".*" t t address)))
 942             (push address contents))))
 943       (nreverse contents))))
 944
 945 (defun spam-from-listed-p (cache)
 946   (let ((from (message-fetch-field "from"))
 947         found)
 948     (while cache
 949       (when (string-match (pop cache) from)
 950         (setq found t
 951               cache nil)))
 952     found))
 953
 954 (defun spam-blacklist-register-routine ()
 955   (spam-generic-register-routine
 956    ;; the spam function
 957    (lambda (article)
 958      (let ((from (spam-fetch-field-from-fast article)))
 959        (when (stringp from)
 960            (spam-enter-blacklist from))))
 961    ;; the ham function
 962    nil))
 963
 964 (defun spam-whitelist-register-routine ()
 965   (spam-generic-register-routine
 966    ;; the spam function
 967    nil
 968    ;; the ham function
 969    (lambda (article)
 970      (let ((from (spam-fetch-field-from-fast article)))
 971        (when (stringp from)
 972            (spam-enter-whitelist from))))))
 973
 974 \f
 975 ;;;; Spam-report glue
 976 (defun spam-report-gmane-register-routine ()
 977   (spam-generic-register-routine
 978    'spam-report-gmane
 979    nil))
 980
 981 \f
 982 ;;;; Bogofilter
 983 (defun spam-check-bogofilter-headers (&optional score)
 984   (let ((header (message-fetch-field spam-bogofilter-header)))
 985       (when (and header
 986                  (string-match spam-bogofilter-bogosity-positive-spam-header
 987                                header))
 988           (if score
 989               (when (string-match "spamicity=\\([0-9.]+\\)" header)
 990                 (match-string 1 header))
 991             spam-split-group))))
 992
 993 ;; return something sensible if the score can't be determined
 994 (defun spam-bogofilter-score ()
 995   "Get the Bogofilter spamicity score"
 996   (interactive)
 997   (save-window-excursion
 998     (gnus-summary-show-article t)
 999     (set-buffer gnus-article-buffer)
1000     (let ((score (or (spam-check-bogofilter-headers t)
1001                      (spam-check-bogofilter t))))
1002       (message "Spamicity score %s" score)
1003       (or score "0"))))
1004
1005 (defun spam-check-bogofilter (&optional score)
1006   "Check the Bogofilter backend for the classification of this message"
1007   (let ((article-buffer-name (buffer-name))
1008         return)
1009     (with-temp-buffer
1010       (let ((temp-buffer-name (buffer-name)))
1011         (save-excursion
1012           (set-buffer article-buffer-name)
1013           (if spam-bogofilter-database-directory
1014               (call-process-region (point-min) (point-max)
1015                                    spam-bogofilter-path
1016                                    nil temp-buffer-name nil "-v"
1017                                    "-d" spam-bogofilter-database-directory)
1018             (call-process-region (point-min) (point-max) spam-bogofilter-path
1019                                  nil temp-buffer-name nil "-v")))
1020         (setq return (spam-check-bogofilter-headers score))))
1021     return))
1022
1023 (defun spam-bogofilter-register-with-bogofilter (article-string spam)
1024   "Register an article, given as a string, as spam or non-spam."
1025   (when (stringp article-string)
1026     (let ((switch (if spam spam-bogofilter-spam-switch
1027                     spam-bogofilter-ham-switch)))
1028       (with-temp-buffer
1029         (insert article-string)
1030         (if spam-bogofilter-database-directory
1031             (call-process-region (point-min) (point-max)
1032                                  spam-bogofilter-path
1033                                  nil nil nil "-v" switch
1034                                  "-d" spam-bogofilter-database-directory)
1035           (call-process-region (point-min) (point-max) spam-bogofilter-path
1036                                nil nil nil "-v" switch))))))
1037
1038 (defun spam-bogofilter-register-spam-routine ()
1039   (spam-generic-register-routine
1040    (lambda (article)
1041      (spam-bogofilter-register-with-bogofilter
1042       (spam-get-article-as-string article) t))
1043    nil))
1044
1045 (defun spam-bogofilter-register-ham-routine ()
1046   (spam-generic-register-routine
1047    nil
1048    (lambda (article)
1049      (spam-bogofilter-register-with-bogofilter
1050       (spam-get-article-as-string article) nil))))
1051
1052 (provide 'spam)
1053
1054 ;;; spam.el ends here.