cgit.sxemacs.org Git - gnus/blob - lisp/spam.el

   1 ;;; spam.el --- Identifying spam
   2 ;; Copyright (C) 2002 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 ;; autoload executable-find
  44 (eval-and-compile
  45   ;; executable-find is not autoloaded in Emacs 20
  46   (autoload 'executable-find "executable"))
  47
  48 ;; autoload query-dig
  49 (eval-and-compile
  50   (autoload 'query-dig "dig"))
  51
  52 ;; autoload query-dns
  53 (eval-and-compile
  54   (autoload 'query-dns "dns"))
  55
  56 ;;; Main parameters.
  57
  58 (defgroup spam nil
  59   "Spam configuration.")
  60
  61 (defcustom spam-directory "~/News/spam/"
  62   "Directory for spam whitelists and blacklists."
  63   :type 'directory
  64   :group 'spam)
  65
  66 (defcustom spam-move-spam-nonspam-groups-only t
  67   "Whether spam should be moved in non-spam groups only.
  68 When nil, only ham and unclassified groups will have their spam moved
  69 to the spam-process-destination.  When t, spam will also be moved from
  70 spam groups."
  71   :type 'boolean
  72   :group 'spam-ifile)
  73
  74 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
  75   "The location of the whitelist.
  76 The file format is one regular expression per line.
  77 The regular expression is matched against the address."
  78   :type 'file
  79   :group 'spam)
  80
  81 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
  82   "The location of the blacklist.
  83 The file format is one regular expression per line.
  84 The regular expression is matched against the address."
  85   :type 'file
  86   :group 'spam)
  87
  88 (defcustom spam-use-dig t
  89   "Whether query-dig should be used instead of query-dns."
  90   :type 'boolean
  91   :group 'spam)
  92
  93 (defcustom spam-use-blacklist nil
  94   "Whether the blacklist should be used by spam-split."
  95   :type 'boolean
  96   :group 'spam)
  97
  98 (defcustom spam-use-whitelist nil
  99   "Whether the whitelist should be used by spam-split."
 100   :type 'boolean
 101   :group 'spam)
 102
 103 (defcustom spam-use-blackholes nil
 104   "Whether blackholes should be used by spam-split."
 105   :type 'boolean
 106   :group 'spam)
 107
 108 (defcustom spam-use-bogofilter nil
 109   "Whether bogofilter should be used by spam-split."
 110   :type 'boolean
 111   :group 'spam)
 112
 113 (defcustom spam-use-BBDB nil
 114   "Whether BBDB should be used by spam-split."
 115   :type 'boolean
 116   :group 'spam)
 117
 118 (defcustom spam-use-ifile nil
 119   "Whether ifile should be used by spam-split."
 120   :type 'boolean
 121   :group 'spam)
 122
 123 (defcustom spam-split-group "spam"
 124   "Group name where incoming spam should be put by spam-split."
 125   :type 'string
 126   :group 'spam)
 127
 128 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
 129   "Mailgroups with spam contents.
 130 All unmarked article in such group receive the spam mark on group entry."
 131   :type '(repeat (string :tag "Group"))
 132   :group 'spam)
 133
 134 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
 135                                     "dev.null.dk" "relays.visi.com")
 136   "List of blackhole servers."
 137   :type '(repeat (string :tag "Server"))
 138   :group 'spam)
 139
 140 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark
 141                                 'gnus-killed-mark 'gnus-kill-file-mark
 142                                 'gnus-low-score-mark)
 143   "Marks considered as being ham (positively not spam).
 144 Such articles will be processed as ham (non-spam) on group exit."
 145   :type '(set
 146           (variable-item gnus-del-mark)
 147           (variable-item gnus-read-mark)
 148           (variable-item gnus-killed-mark)
 149           (variable-item gnus-kill-file-mark)
 150           (variable-item gnus-low-score-mark))
 151   :group 'spam)
 152
 153 (defcustom spam-spam-marks (list 'gnus-spam-mark)
 154   "Marks considered as being spam (positively spam).
 155 Such articles will be transmitted to `bogofilter -s' on group exit."
 156   :type '(set
 157           (variable-item gnus-spam-mark)
 158           (variable-item gnus-killed-mark)
 159           (variable-item gnus-kill-file-mark)
 160           (variable-item gnus-low-score-mark))
 161   :group 'spam)
 162
 163 (defcustom spam-face 'gnus-splash-face
 164   "Face for spam-marked articles"
 165   :type 'face
 166   :group 'spam)
 167
 168 (defgroup spam-ifile nil
 169   "Spam ifile configuration."
 170   :group 'spam)
 171
 172 (defcustom spam-ifile-path (executable-find "ifile")
 173   "File path of the ifile executable program."
 174   :type '(choice (file :tag "Location of ifile")
 175                  (const :tag "ifile is not installed"))
 176   :group 'spam-ifile)
 177
 178 (defcustom spam-ifile-database-path nil
 179   "File path of the ifile database."
 180   :type '(choice (file :tag "Location of the ifile database")
 181                  (const :tag "Use the default"))
 182   :group 'spam-ifile)
 183
 184 (defcustom spam-ifile-spam-category "spam"
 185   "Name of the spam ifile category."
 186   :type 'string
 187   :group 'spam-ifile)
 188
 189 (defcustom spam-ifile-all-categories nil
 190   "Whether the ifile check will return all categories, or just spam.
 191 Set this to t if you want to use the spam-split invocation of ifile as
 192 your main source of newsgroup names."
 193   :type 'boolean
 194   :group 'spam-ifile)
 195
 196 (defgroup spam-bogofilter nil
 197   "Spam bogofilter configuration."
 198   :group 'spam)
 199
 200 (defcustom spam-bogofilter-output-buffer-name "*Bogofilter Output*"
 201   "Name of buffer when displaying `bogofilter -v' output."
 202   :type 'string
 203   :group 'spam-bogofilter)
 204
 205 (defcustom spam-bogofilter-initial-timeout 40
 206   "Timeout in seconds for the initial reply from the `bogofilter' program."
 207   :type 'integer
 208   :group 'spam-bogofilter)
 209
 210 (defcustom spam-bogofilter-subsequent-timeout 15
 211   "Timeout in seconds for any subsequent reply from the `bogofilter' program."
 212   :type 'integer
 213   :group 'spam-bogofilter)
 214
 215 (defcustom spam-bogofilter-path (executable-find "bogofilter")
 216   "File path of the Bogofilter executable program."
 217   :type '(choice (file :tag "Location of bogofilter")
 218                  (const :tag "Bogofilter is not installed"))
 219   :group 'spam-bogofilter)
 220
 221 ;; FIXME!  In the following regexp, we should explain which tool produces
 222 ;; which kind of header.  I do not even remember them all by now.  X-Junk
 223 ;; (and previously X-NoSpam) are produced by the `NoSpam' tool, which has
 224 ;; never been published, so it might not be reasonable leaving it in the
 225 ;; list.
 226 (defcustom spam-bogofilter-spaminfo-header-regexp
 227   "^X-\\(jf\\|Junk\\|NoSpam\\|Spam\\|SB\\)[^:]*:"
 228   "Regexp for spam markups in headers.
 229 Markup from spam recognisers, as well as `Xref', are to be removed from
 230 articles before they get registered by Bogofilter."
 231   :type 'regexp
 232   :group 'spam-bogofilter)
 233
 234 ;;; Key bindings for spam control.
 235
 236 (gnus-define-keys gnus-summary-mode-map
 237   "St" spam-bogofilter-score
 238   "Sx" gnus-summary-mark-as-spam
 239   "Mst" spam-bogofilter-score
 240   "Msx" gnus-summary-mark-as-spam
 241   "\M-d" gnus-summary-mark-as-spam)
 242
 243 ;;; How to highlight a spam summary line.
 244
 245 ;; TODO: How do we redo this every time spam-face is customized?
 246
 247 (push '((eq mark gnus-spam-mark) . spam-face)
 248       gnus-summary-highlight)
 249
 250 ;; convenience functions
 251 (defun spam-group-spam-contents-p (group)
 252   (if (stringp group)
 253       (or (member group spam-junk-mailgroups)
 254           (memq 'gnus-group-spam-classification-spam
 255                 (gnus-parameter-spam-contents group)))
 256     nil))
 257
 258 (defun spam-group-ham-contents-p (group)
 259   (if (stringp group)
 260       (memq 'gnus-group-spam-classification-ham
 261             (gnus-parameter-spam-contents group))
 262     nil))
 263
 264 (defun spam-group-processor-p (group processor)
 265   (if (and (stringp group)
 266            (symbolp processor))
 267       (member processor (car (gnus-parameter-spam-process group)))
 268     nil))
 269
 270 (defun spam-group-spam-processor-bogofilter-p (group)
 271   (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
 272
 273 (defun spam-group-spam-processor-blacklist-p (group)
 274   (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
 275
 276 (defun spam-group-spam-processor-ifile-p (group)
 277   (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
 278
 279 (defun spam-group-ham-processor-ifile-p (group)
 280   (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
 281
 282 (defun spam-group-ham-processor-whitelist-p (group)
 283   (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
 284
 285 (defun spam-group-ham-processor-BBDB-p (group)
 286   (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
 287
 288 ;;; Summary entry and exit processing.
 289
 290 (defun spam-summary-prepare ()
 291   (spam-mark-junk-as-spam-routine))
 292
 293 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
 294
 295 (defun spam-summary-prepare-exit ()
 296   ;; The spam processors are invoked for any group, spam or ham or neither
 297   (when (and spam-bogofilter-path
 298              (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
 299     (spam-bogofilter-register-routine))
 300
 301   (when (and spam-ifile-path
 302              (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
 303     (spam-ifile-register-spam-routine))
 304
 305   (when (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name)
 306     (spam-blacklist-register-routine))
 307
 308   (if spam-move-spam-nonspam-groups-only
 309       (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
 310         (spam-mark-spam-as-expired-and-move-routine
 311          (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 312     (spam-mark-spam-as-expired-and-move-routine
 313      (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 314
 315   ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
 316   ;; expire spam, in case the above did not expire them
 317   (spam-mark-spam-as-expired-and-move-routine nil)
 318
 319   (when (spam-group-ham-contents-p gnus-newsgroup-name)
 320     (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
 321       (spam-whitelist-register-routine))
 322     (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
 323       (spam-ifile-register-ham-routine))
 324     (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
 325       (spam-BBDB-register-routine)))
 326
 327   ;; now move all ham articles out of spam groups
 328   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 329     (spam-ham-move-routine
 330      (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 331
 332 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
 333
 334 (defun spam-mark-junk-as-spam-routine ()
 335   ;; check the global list of group names spam-junk-mailgroups and the
 336   ;; group parameters
 337   (when (spam-group-spam-contents-p gnus-newsgroup-name)
 338     (let ((articles gnus-newsgroup-articles)
 339           article)
 340       (while articles
 341         (setq article (pop articles))
 342         (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
 343           (gnus-summary-mark-article article gnus-spam-mark))))))
 344
 345 (defun spam-mark-spam-as-expired-and-move-routine (&optional group)
 346   (let ((articles gnus-newsgroup-articles)
 347         article)
 348     (while articles
 349       (setq article (pop articles))
 350       (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
 351         (gnus-summary-mark-article article gnus-expirable-mark)
 352         (when (stringp group)
 353           (let ((gnus-current-article article))
 354             (gnus-summary-move-article nil group)))))))
 355
 356 (defun spam-ham-move-routine (&optional group)
 357   (let ((articles gnus-newsgroup-articles)
 358         article ham-mark-values mark)
 359     (dolist (mark spam-ham-marks)
 360       (push (symbol-value mark) ham-mark-values))
 361
 362     (while articles
 363       (setq article (pop articles))
 364       (when (and (memq mark ham-mark-values)
 365                  (stringp group))
 366           (let ((gnus-current-article article))
 367             (gnus-summary-move-article nil group))))))
 368
 369 (defun spam-generic-register-routine (spam-func ham-func)
 370   (let ((articles gnus-newsgroup-articles)
 371         article mark ham-articles spam-articles spam-mark-values
 372         ham-mark-values)
 373
 374     ;; marks are stored as symbolic values, so we have to dereference
 375     ;; them for memq to work.  we wouldn't have to do this if
 376     ;; gnus-summary-article-mark returned a symbol.
 377     (dolist (mark spam-ham-marks)
 378       (push (symbol-value mark) ham-mark-values))
 379
 380     (dolist (mark spam-spam-marks)
 381       (push (symbol-value mark) spam-mark-values))
 382
 383     (while articles
 384       (setq article (pop articles)
 385             mark (gnus-summary-article-mark article))
 386       (cond ((memq mark spam-mark-values) (push article spam-articles))
 387             ((memq article gnus-newsgroup-saved))
 388             ((memq mark ham-mark-values) (push article ham-articles))))
 389     (when (and ham-articles ham-func)
 390       (mapc ham-func ham-articles))     ; we use mapc because unlike
 391                                         ; mapcar it discards the
 392                                         ; return values
 393     (when (and spam-articles spam-func)
 394       (mapc spam-func spam-articles)))) ; we use mapc because unlike
 395                                         ; mapcar it discards the
 396                                         ; return values
 397
 398 (eval-and-compile
 399   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
 400                                    'point-at-eol
 401                                  'line-end-position)))
 402
 403 (defun spam-get-article-as-string (article)
 404   (let ((article-string))
 405     (when (numberp article)
 406       (save-window-excursion
 407         (gnus-summary-goto-subject article)
 408         (gnus-summary-show-article t)
 409         (set-buffer gnus-article-buffer)
 410         (setq article-string (buffer-string))))
 411     article-string))
 412
 413 (defun spam-fetch-field-from-fast (article)
 414   "Fetch the `from' field quickly, using the internal gnus-data-list function"
 415   (if (and (numberp article)
 416            (assoc article (gnus-data-list nil)))
 417       (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
 418     nil))
 419
 420 (defun spam-fetch-field-subject-fast (article)
 421   "Fetch the `subject' field quickly, using the internal gnus-data-list function"
 422   (if (and (numberp article)
 423            (assoc article (gnus-data-list nil)))
 424       (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
 425     nil))
 426
 427 \f
 428 ;;;; Spam determination.
 429
 430 (defvar spam-list-of-checks
 431   '((spam-use-blacklist  . spam-check-blacklist)
 432     (spam-use-whitelist  . spam-check-whitelist)
 433     (spam-use-BBDB       . spam-check-BBDB)
 434     (spam-use-ifile      . spam-check-ifile)
 435     (spam-use-blackholes . spam-check-blackholes)
 436     (spam-use-bogofilter . spam-check-bogofilter))
 437 "The spam-list-of-checks list contains pairs associating a parameter
 438 variable with a spam checking function.  If the parameter variable is
 439 true, then the checking function is called, and its value decides what
 440 happens.  Each individual check may return `nil', `t', or a mailgroup
 441 name.  The value `nil' means that the check does not yield a decision,
 442 and so, that further checks are needed.  The value `t' means that the
 443 message is definitely not spam, and that further spam checks should be
 444 inhibited.  Otherwise, a mailgroup name is returned where the mail
 445 should go, and further checks are also inhibited.  The usual mailgroup
 446 name is the value of `spam-split-group', meaning that the message is
 447 definitely a spam.")
 448
 449 (defun spam-split ()
 450   "Split this message into the `spam' group if it is spam.
 451 This function can be used as an entry in `nnmail-split-fancy', for
 452 example like this: (: spam-split)
 453
 454 See the Info node `(gnus)Fancy Mail Splitting' for more details."
 455   (interactive)
 456
 457   (let ((list-of-checks spam-list-of-checks)
 458         decision)
 459     (while (and list-of-checks (not decision))
 460       (let ((pair (pop list-of-checks)))
 461         (when (symbol-value (car pair))
 462           (setq decision (funcall (cdr pair))))))
 463     (if (eq decision t)
 464         nil
 465       decision)))
 466 \f
 467 ;;;; Blackholes.
 468
 469 (defun spam-check-blackholes ()
 470   "Check the Received headers for blackholed relays."
 471   (let ((headers (message-fetch-field "received"))
 472         ips matches)
 473     (when headers
 474       (with-temp-buffer
 475         (insert headers)
 476         (goto-char (point-min))
 477         (while (re-search-forward
 478                 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
 479           (message "Blackhole search found host IP %s." (match-string 1))
 480           (push (mapconcat 'identity
 481                            (nreverse (split-string (match-string 1) "\\."))
 482                            ".")
 483                 ips)))
 484       (dolist (server spam-blackhole-servers)
 485         (dolist (ip ips)
 486           (let ((query-string (concat ip "." server)))
 487             (if spam-use-dig
 488                 (let ((query-result (query-dig query-string)))
 489                   (when query-result
 490                     (message "spam: positive blackhole check '%s'" query-result)
 491                     (push (list ip server query-result)
 492                           matches)))
 493               ;; else, if not using dig.el
 494               (when (query-dns query-string)
 495                 (push (list ip server (query-dns query-string 'TXT))
 496                       matches)))))))
 497     (when matches
 498       spam-split-group)))
 499 \f
 500 ;;;; BBDB
 501
 502 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
 503 ;;; <sacha@giotto.sj.ru>
 504
 505 ;; all this is done inside a condition-case to trap errors
 506
 507 (condition-case nil
 508     (progn
 509       (require 'bbdb)
 510       (require 'bbdb-com)
 511
 512   (defun spam-enter-ham-BBDB (from)
 513     "Enter an address into the BBDB; implies ham (non-spam) sender"
 514     (when (stringp from)
 515       (let* ((parsed-address (gnus-extract-address-components from))
 516              (name (or (car parsed-address) "Ham Sender"))
 517              (net-address (car (cdr parsed-address))))
 518         (message "Adding address %s to BBDB" from)
 519         (when (and net-address
 520                    (not (bbdb-search-simple nil net-address)))
 521           (bbdb-create-internal name nil net-address nil nil
 522                                 "ham sender added by spam.el")))))
 523
 524   (defun spam-BBDB-register-routine ()
 525     (spam-generic-register-routine
 526      ;; spam function
 527      nil
 528      ;; ham function
 529      (lambda (article)
 530        (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 531
 532   (defun spam-check-BBDB ()
 533     "Mail from people in the BBDB is never considered spam"
 534     (let ((who (message-fetch-field "from")))
 535       (when who
 536         (setq who (regexp-quote (cadr
 537                                  (gnus-extract-address-components who))))
 538         (if (bbdb-search-simple nil who)
 539             nil spam-split-group)))))
 540
 541   (file-error (progn
 542                 (defalias 'bbdb-search-simple 'ignore)
 543                 (defalias 'spam-check-BBDB 'ignore)
 544                 (defalias 'spam-BBDB-register-routine 'ignore)
 545                 (defalias 'spam-enter-ham-BBDB 'ignore)
 546                 (defalias 'bbdb-create-internal 'ignore)
 547                 (defalias 'bbdb-records 'ignore))))
 548
 549 \f
 550 ;;;; ifile
 551
 552 ;;; check the ifile backend; return nil if the mail was NOT classified
 553 ;;; as spam
 554
 555 (defun spam-get-ifile-database-parameter ()
 556   "Get the command-line parameter for ifile's database from spam-ifile-database-path."
 557   (if spam-ifile-database-path
 558       (format "--db-file=%s" spam-ifile-database-path)
 559     ""))
 560
 561 (defun spam-check-ifile ()
 562   "Check the ifile backend for the classification of this message"
 563   (let ((article-buffer-name (buffer-name))
 564         category return)
 565     (with-temp-buffer
 566       (let ((temp-buffer-name (buffer-name)))
 567         (save-excursion
 568           (set-buffer article-buffer-name)
 569           (call-process-region (point-min) (point-max) spam-ifile-path
 570                                nil temp-buffer-name nil
 571                                "-q" "-c" (spam-get-ifile-database-parameter)))
 572         (goto-char (point-min))
 573         (if (not (eobp))
 574             (setq category (buffer-substring (point) (spam-point-at-eol))))
 575         (when (not (zerop (length category))) ; we need a category here
 576           (if spam-ifile-all-categories
 577               (setq return category)
 578             ;; else, if spam-ifile-all-categories is not set...
 579             (when (string-equal spam-ifile-spam-category category)
 580               ;; always accept the ifile category
 581               (setq return spam-split-group))))))
 582     return))
 583
 584 (defun spam-ifile-register-with-ifile (article-string category)
 585   "Register an article, given as a string, with a category.
 586 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 587   (when (stringp article-string)
 588     (let ((category (or category gnus-newsgroup-name)))
 589       (with-temp-buffer
 590         (insert-string article-string)
 591         (call-process-region (point-min) (point-max) spam-ifile-path
 592                              nil nil nil
 593                              "-h" "-i" category
 594                              (spam-get-ifile-database-parameter))))))
 595
 596 (defun spam-ifile-register-spam-routine ()
 597   (spam-generic-register-routine
 598    (lambda (article)
 599      (spam-ifile-register-with-ifile
 600       (spam-get-article-as-string article) spam-ifile-spam-category))
 601    nil))
 602
 603 (defun spam-ifile-register-ham-routine ()
 604   (spam-generic-register-routine
 605    nil
 606    (lambda (article)
 607      (spam-ifile-register-with-ifile
 608       (spam-get-article-as-string article) nil))))
 609
 610 \f
 611 ;;;; Blacklists and whitelists.
 612
 613 (defvar spam-whitelist-cache nil)
 614 (defvar spam-blacklist-cache nil)
 615
 616 (defun spam-enter-whitelist (address)
 617   "Enter ADDRESS into the whitelist."
 618   (interactive "sAddress: ")
 619   (spam-enter-list address spam-whitelist)
 620   (setq spam-whitelist-cache nil))
 621
 622 (defun spam-enter-blacklist (address)
 623   "Enter ADDRESS into the blacklist."
 624   (interactive "sAddress: ")
 625   (spam-enter-list address spam-blacklist)
 626   (setq spam-blacklist-cache nil))
 627
 628 (defun spam-enter-list (address file)
 629   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 630   (unless (file-exists-p (file-name-directory file))
 631     (make-directory (file-name-directory file) t))
 632   (save-excursion
 633     (set-buffer
 634      (find-file-noselect file))
 635     (goto-char (point-max))
 636     (unless (bobp)
 637       (insert "\n"))
 638     (insert address "\n")
 639     (save-buffer)))
 640
 641 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
 642 (defun spam-check-whitelist ()
 643   ;; FIXME!  Should it detect when file timestamps change?
 644   (unless spam-whitelist-cache
 645     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 646   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
 647
 648 (defun spam-check-blacklist ()
 649   ;; FIXME!  Should it detect when file timestamps change?
 650   (unless spam-blacklist-cache
 651     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 652   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 653
 654 (defun spam-parse-list (file)
 655   (when (file-readable-p file)
 656     (let (contents address)
 657       (with-temp-buffer
 658         (insert-file-contents file)
 659         (while (not (eobp))
 660           (setq address (buffer-substring (point) (spam-point-at-eol)))
 661           (forward-line 1)
 662           (unless (zerop (length address))
 663             (setq address (regexp-quote address))
 664             (while (string-match "\\\\\\*" address)
 665               (setq address (replace-match ".*" t t address)))
 666             (push address contents))))
 667       (nreverse contents))))
 668
 669 (defun spam-from-listed-p (cache)
 670   (let ((from (message-fetch-field "from"))
 671         found)
 672     (while cache
 673       (when (string-match (pop cache) from)
 674         (setq found t
 675               cache nil)))
 676     found))
 677
 678 (defun spam-blacklist-register-routine ()
 679   (spam-generic-register-routine
 680    ;; the spam function
 681    (lambda (article)
 682      (let ((from (spam-fetch-field-from-fast article)))
 683        (when (stringp from)
 684            (spam-enter-blacklist from))))
 685    ;; the ham function
 686    nil))
 687
 688 (defun spam-whitelist-register-routine ()
 689   (spam-generic-register-routine
 690    ;; the spam function
 691    nil
 692    ;; the ham function
 693    (lambda (article)
 694      (let ((from (spam-fetch-field-from-fast article)))
 695        (when (stringp from)
 696            (spam-enter-whitelist from))))))
 697
 698 \f
 699 ;;;; Bogofilter
 700
 701 ;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
 702
 703 ;;; This page is for those wanting to control spam with the help of
 704 ;;; Eric Raymond's speedy Bogofilter, see
 705 ;;; http://www.tuxedo.org/~esr/bogofilter.  This has been tested with
 706 ;;; a locally patched copy of version 0.4.
 707
 708 ;;; Make sure Bogofilter is installed.  Bogofilter internally uses
 709 ;;; Judy fast associative arrays, so you need to install Judy first,
 710 ;;; and Bogofilter next.  Fetch both distributions by visiting the
 711 ;;; following links and downloading the latest version of each:
 712 ;;;
 713 ;;;     http://sourceforge.net/projects/judy/
 714 ;;;     http://www.tuxedo.org/~esr/bogofilter/
 715 ;;;
 716 ;;; Unpack the Judy distribution and enter its main directory.  Then do:
 717 ;;;
 718 ;;;     ./configure
 719 ;;;     make
 720 ;;;     make install
 721 ;;;
 722 ;;; You will likely need to become super-user for the last step.
 723 ;;; Then, unpack the Bogofilter distribution and enter its main
 724 ;;; directory:
 725 ;;;
 726 ;;;     make
 727 ;;;     make install
 728 ;;;
 729 ;;; Here as well, you need to become super-user for the last step.
 730 ;;; Now, initialize your word lists by doing, under your own identity:
 731 ;;;
 732 ;;;     mkdir ~/.bogofilter
 733 ;;;     touch ~/.bogofilter/badlist
 734 ;;;     touch ~/.bogofilter/goodlist
 735 ;;;
 736 ;;; These two files are text files you may edit, but you normally don't!
 737
 738 ;;; The `M-d' command gets added to Gnus summary mode, marking current
 739 ;;; article as spam, showing it with the `H' mark.  Whenever you see a
 740 ;;; spam article, make sure to mark its summary line with `M-d' before
 741 ;;; leaving the group.  Some groups, as per variable
 742 ;;; `spam-junk-mailgroups' below, receive articles from Gnus splitting
 743 ;;; on clues added by spam recognisers, so for these groups, we tack
 744 ;;; an `H' mark at group entry for all summary lines which would
 745 ;;; otherwise have no other mark.  Make sure to _remove_ `H' marks for
 746 ;;; any article which is _not_ genuine spam, before leaving such
 747 ;;; groups: you may use `M-u' to "unread" the article, or `d' for
 748 ;;; declaring it read the non-spam way.  When you leave a group, all
 749 ;;; `H' marked articles, saved or unsaved, are sent to Bogofilter
 750 ;;; which will study them as spam samples.
 751
 752 ;;; Messages may also be deleted in various other ways, and unless
 753 ;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for
 754 ;;; default read or explicit delete, marks `X' and 'K' for automatic
 755 ;;; or explicit kills, as well as mark `Y' for low scores, are all
 756 ;;; considered to be associated with articles which are not spam.
 757 ;;; This assumption might be false, in particular if you use kill
 758 ;;; files or score files as means for detecting genuine spam, you
 759 ;;; should then adjust `spam-ham-marks-form'.  When you leave a group,
 760 ;;; all _unsaved_ articles bearing any the above marks are sent to
 761 ;;; Bogofilter which will study these as not-spam samples.  If you
 762 ;;; explicit kill a lot, you might sometimes end up with articles
 763 ;;; marked `K' which you never saw, and which might accidentally
 764 ;;; contain spam.  Best is to make sure that real spam is marked with
 765 ;;; `H', and nothing else.
 766
 767 ;;; All other marks do not contribute to Bogofilter pre-conditioning.
 768 ;;; In particular, ticked, dormant or souped articles are likely to
 769 ;;; contribute later, when they will get deleted for real, so there is
 770 ;;; no need to use them prematurely.  Explicitly expired articles do
 771 ;;; not contribute, command `E' is a way to get rid of an article
 772 ;;; without Bogofilter ever seeing it.
 773
 774 ;;; In a word, with a minimum of care for associating the `H' mark for
 775 ;;; spam articles only, Bogofilter training all gets fairly automatic.
 776 ;;; You should do this until you get a few hundreds of articles in
 777 ;;; each category, spam or not.  The shell command `head -1
 778 ;;; ~/.bogofilter/*' shows both article counts.  The command `S S' in
 779 ;;; summary mode, either for debugging or for curiosity, triggers
 780 ;;; Bogofilter into displaying in another buffer the "spamicity" score
 781 ;;; of the current article (between 0.0 and 1.0), together with the
 782 ;;; article words which most significantly contribute to the score.
 783
 784 ;;; The real way for using Bogofilter, however, is to have some use
 785 ;;; tool like `procmail' for invoking it on message reception, then
 786 ;;; adding some recognisable header in case of detected spam.  Gnus
 787 ;;; splitting rules might later trip on these added headers and react
 788 ;;; by sorting such articles into specific junk folders as per
 789 ;;; `spam-junk-mailgroups'.  Here is a possible `.procmailrc' contents
 790 ;;; (still untested -- please tell me how it goes):
 791 ;;;
 792 ;;; :0HBf:
 793 ;;; * ? bogofilter
 794 ;;; | formail -bfI "X-Spam-Status: Yes"
 795
 796 (defun spam-check-bogofilter ()
 797   ;; Dynamic spam check.  I do not know how to check the exit status,
 798   ;; so instead, read `bogofilter -v' output.
 799   (when (and spam-use-bogofilter spam-bogofilter-path)
 800     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 801     (when (save-excursion
 802             (set-buffer spam-bogofilter-output-buffer-name)
 803             (goto-char (point-min))
 804             (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
 805       spam-split-group)))
 806
 807 (defun spam-bogofilter-score ()
 808   "Use `bogofilter -v' on the current article.
 809 This yields the 15 most discriminant words for this article and the
 810 spamicity coefficient of each, and the overall article spamicity."
 811   (interactive)
 812   (when (and spam-use-bogofilter spam-bogofilter-path)
 813     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 814     (with-current-buffer spam-bogofilter-output-buffer-name
 815       (unless (zerop (buffer-size))
 816         (if (<= (count-lines (point-min) (point-max)) 1)
 817             (progn
 818               (goto-char (point-max))
 819               (when (bolp)
 820                 (backward-char 1))
 821               (message "%s" (buffer-substring (point-min) (point))))
 822           (goto-char (point-min))
 823           (display-buffer (current-buffer)))))))
 824
 825 (defun spam-bogofilter-register-routine ()
 826   (let ((articles gnus-newsgroup-articles)
 827         article mark ham-articles spam-articles spam-mark-values
 828         ham-mark-values)
 829
 830     ;; marks are stored as symbolic values, so we have to dereference
 831     ;; them for memq to work we wouldn't have to do this if
 832     ;; gnus-summary-article-mark returned a symbol.
 833     (dolist (mark spam-ham-marks)
 834       (push (symbol-value mark) ham-mark-values))
 835
 836     (dolist (mark spam-spam-marks)
 837       (push (symbol-value mark) spam-mark-values))
 838
 839     (while articles
 840       (setq article (pop articles)
 841             mark (gnus-summary-article-mark article))
 842       (cond ((memq mark spam-mark-values) (push article spam-articles))
 843             ((memq article gnus-newsgroup-saved))
 844             ((memq mark ham-mark-values) (push article ham-articles))))
 845     (when ham-articles
 846       (spam-bogofilter-articles "ham" "-n" ham-articles))
 847     (when spam-articles
 848       (spam-bogofilter-articles "SPAM" "-s" spam-articles))))
 849
 850 (defun spam-bogofilter-articles (type option articles)
 851   (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
 852         (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
 853         (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp
 854                                "\\|Xref:"))
 855         (counter 0)
 856         prefix process article)
 857     (when type
 858       (setq prefix (format "Studying %d articles as %s..." (length articles)
 859                            type))
 860       (message "%s" prefix))
 861     (save-excursion (set-buffer output-buffer) (erase-buffer))
 862     (setq process (start-process "bogofilter" output-buffer
 863                                  spam-bogofilter-path "-F" option))
 864     (process-kill-without-query process t)
 865     (unwind-protect
 866         (save-window-excursion
 867           (while articles
 868             (setq counter (1+ counter))
 869             (when prefix
 870               (message "%s %d" prefix counter))
 871             (setq article (pop articles))
 872             (gnus-summary-goto-subject article)
 873             (gnus-summary-show-article t)
 874             (gnus-eval-in-buffer-window article-copy
 875               (insert-buffer-substring gnus-original-article-buffer)
 876               ;; Remove spam classification redundant headers: they may induce
 877               ;; unwanted biases in later analysis.
 878               (message-remove-header remove-regexp t)
 879               ;; Bogofilter really wants From envelopes for counting articles.
 880               ;; Fake one at the beginning, make sure there will be no other.
 881               (goto-char (point-min))
 882               (if (looking-at "From ")
 883                   (forward-line 1)
 884                 (insert "From nobody " (current-time-string) "\n"))
 885               (let (case-fold-search)
 886                 (while (re-search-forward "^From " nil t)
 887                   (beginning-of-line)
 888                   (insert ">")))
 889               (process-send-region process (point-min) (point-max))
 890               (erase-buffer))))
 891       ;; Sending the EOF is unwind-protected.  This is to prevent lost copies
 892       ;; of `bogofilter', hung on reading their standard input, in case the
 893       ;; whole registering process gets interrupted by the user.
 894       (process-send-eof process))
 895     (kill-buffer article-copy)
 896     ;; Receive process output.  It sadly seems that we still have to protect
 897     ;; ourselves against hung `bogofilter' processes.
 898     (let ((status (process-status process))
 899           (timeout (* 1000 spam-bogofilter-initial-timeout))
 900           (quanta 200))                 ; also counted in milliseconds
 901       (while (and (not (eq status 'exit)) (> timeout 0))
 902         ;; `accept-process-output' timeout is counted in microseconds.
 903         (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
 904                           (* 1000 spam-bogofilter-subsequent-timeout)
 905                         (- timeout quanta))
 906               status (process-status process)))
 907       (if (eq status 'exit)
 908           (when prefix
 909             (message "%s done!" prefix))
 910         ;; Sigh!  The process did time out...  Become brutal!
 911         (interrupt-process process)
 912         (message "%s %d INTERRUPTED!  (Article %d, status %s)"
 913                  (or prefix "Bogofilter process...")
 914                  counter article status)
 915         ;; Give some time for user to read.  Sitting redisplays but gives up
 916         ;; if input is pending.  Sleeping does not give up, but it does not
 917         ;; redisplay either.  Mix both: let's redisplay and not give up.
 918         (sit-for 1)
 919         (sleep-for 3)))))
 920
 921 (provide 'spam)
 922
 923 ;;; spam.el ends here.