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 original idea for spam-check-BBDB from Alexander Kotelnikov
 501 ;;; <sacha@giotto.sj.ru>
 502
 503 ;; all this is done inside a condition-case to trap errors
 504 (condition-case nil
 505     (progn
 506
 507       (require 'bbdb-com)
 508
 509       (defun spam-enter-ham-BBDB (from)
 510         "Enter an address into the BBDB; implies ham (non-spam) sender"
 511         (when (stringp from)
 512           (let* ((parsed-address (gnus-extract-address-components from))
 513                  (name (or (car parsed-address) "Ham Sender"))
 514                  (net-address (car (cdr parsed-address))))
 515             (message "Adding address %s to BBDB" from)
 516             (when (and net-address
 517                        (not (bbdb-search (bbdb-records) nil nil net-address)))
 518               (bbdb-create-internal name nil net-address nil nil
 519                                     "ham sender added by spam.el")))))
 520
 521       (defun spam-BBDB-register-routine ()
 522         (spam-generic-register-routine
 523          ;; spam function
 524          nil
 525          ;; ham function
 526          (lambda (article)
 527            (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 528
 529       (defun spam-check-BBDB ()
 530         "Mail from people in the BBDB is never considered spam"
 531         (let ((who (message-fetch-field "from")))
 532           (when who
 533             (setq who (regexp-quote (cadr
 534                                      (gnus-extract-address-components who))))
 535             (if (bbdb-search (bbdb-records) nil nil who)
 536                 nil spam-split-group)))))
 537
 538   (file-error (progn
 539                 (setq spam-list-of-checks
 540                       (delete (assoc 'spam-use-BBDB spam-list-of-checks)
 541                               spam-list-of-checks)))))
 542
 543 \f
 544 ;;;; ifile
 545
 546 ;;; check the ifile backend; return nil if the mail was NOT classified
 547 ;;; as spam
 548
 549 (defun spam-get-ifile-database-parameter ()
 550   "Get the command-line parameter for ifile's database from spam-ifile-database-path."
 551   (if spam-ifile-database-path
 552       (format "--db-file=%s" spam-ifile-database-path)
 553     ""))
 554
 555 (defun spam-check-ifile ()
 556   "Check the ifile backend for the classification of this message"
 557   (let ((article-buffer-name (buffer-name))
 558         category return)
 559     (with-temp-buffer
 560       (let ((temp-buffer-name (buffer-name)))
 561         (save-excursion
 562           (set-buffer article-buffer-name)
 563           (call-process-region (point-min) (point-max) spam-ifile-path
 564                                nil temp-buffer-name nil
 565                                "-q" "-c" (spam-get-ifile-database-parameter)))
 566         (goto-char (point-min))
 567         (if (not (eobp))
 568             (setq category (buffer-substring (point) (spam-point-at-eol))))
 569         (when (not (zerop (length category))) ; we need a category here
 570           (if spam-ifile-all-categories
 571               (setq return category)
 572             ;; else, if spam-ifile-all-categories is not set...
 573             (when (string-equal spam-ifile-spam-category category)
 574               ;; always accept the ifile category
 575               (setq return spam-split-group))))))
 576     return))
 577
 578 (defun spam-ifile-register-with-ifile (article-string category)
 579   "Register an article, given as a string, with a category.
 580 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 581   (when (stringp article-string)
 582     (let ((category (or category gnus-newsgroup-name)))
 583       (with-temp-buffer
 584         (insert-string article-string)
 585         (call-process-region (point-min) (point-max) spam-ifile-path
 586                              nil nil nil
 587                              "-h" "-i" category
 588                              (spam-get-ifile-database-parameter))))))
 589
 590 (defun spam-ifile-register-spam-routine ()
 591   (spam-generic-register-routine
 592    (lambda (article)
 593      (spam-ifile-register-with-ifile
 594       (spam-get-article-as-string article) spam-ifile-spam-category))
 595    nil))
 596
 597 (defun spam-ifile-register-ham-routine ()
 598   (spam-generic-register-routine
 599    nil
 600    (lambda (article)
 601      (spam-ifile-register-with-ifile
 602       (spam-get-article-as-string article) nil))))
 603
 604 \f
 605 ;;;; Blacklists and whitelists.
 606
 607 (defvar spam-whitelist-cache nil)
 608 (defvar spam-blacklist-cache nil)
 609
 610 (defun spam-enter-whitelist (address)
 611   "Enter ADDRESS into the whitelist."
 612   (interactive "sAddress: ")
 613   (spam-enter-list address spam-whitelist)
 614   (setq spam-whitelist-cache nil))
 615
 616 (defun spam-enter-blacklist (address)
 617   "Enter ADDRESS into the blacklist."
 618   (interactive "sAddress: ")
 619   (spam-enter-list address spam-blacklist)
 620   (setq spam-blacklist-cache nil))
 621
 622 (defun spam-enter-list (address file)
 623   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
 624   (unless (file-exists-p (file-name-directory file))
 625     (make-directory (file-name-directory file) t))
 626   (save-excursion
 627     (set-buffer
 628      (find-file-noselect file))
 629     (goto-char (point-max))
 630     (unless (bobp)
 631       (insert "\n"))
 632     (insert address "\n")
 633     (save-buffer)))
 634
 635 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
 636 (defun spam-check-whitelist ()
 637   ;; FIXME!  Should it detect when file timestamps change?
 638   (unless spam-whitelist-cache
 639     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
 640   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
 641
 642 (defun spam-check-blacklist ()
 643   ;; FIXME!  Should it detect when file timestamps change?
 644   (unless spam-blacklist-cache
 645     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
 646   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
 647
 648 (defun spam-parse-list (file)
 649   (when (file-readable-p file)
 650     (let (contents address)
 651       (with-temp-buffer
 652         (insert-file-contents file)
 653         (while (not (eobp))
 654           (setq address (buffer-substring (point) (spam-point-at-eol)))
 655           (forward-line 1)
 656           (unless (zerop (length address))
 657             (setq address (regexp-quote address))
 658             (while (string-match "\\\\\\*" address)
 659               (setq address (replace-match ".*" t t address)))
 660             (push address contents))))
 661       (nreverse contents))))
 662
 663 (defun spam-from-listed-p (cache)
 664   (let ((from (message-fetch-field "from"))
 665         found)
 666     (while cache
 667       (when (string-match (pop cache) from)
 668         (setq found t
 669               cache nil)))
 670     found))
 671
 672 (defun spam-blacklist-register-routine ()
 673   (spam-generic-register-routine
 674    ;; the spam function
 675    (lambda (article)
 676      (let ((from (spam-fetch-field-from-fast article)))
 677        (when (stringp from)
 678            (spam-enter-blacklist from))))
 679    ;; the ham function
 680    nil))
 681
 682 (defun spam-whitelist-register-routine ()
 683   (spam-generic-register-routine
 684    ;; the spam function
 685    nil
 686    ;; the ham function
 687    (lambda (article)
 688      (let ((from (spam-fetch-field-from-fast article)))
 689        (when (stringp from)
 690            (spam-enter-whitelist from))))))
 691
 692 \f
 693 ;;;; Bogofilter
 694
 695 ;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
 696
 697 ;;; This page is for those wanting to control spam with the help of
 698 ;;; Eric Raymond's speedy Bogofilter, see
 699 ;;; http://www.tuxedo.org/~esr/bogofilter.  This has been tested with
 700 ;;; a locally patched copy of version 0.4.
 701
 702 ;;; Make sure Bogofilter is installed.  Bogofilter internally uses
 703 ;;; Judy fast associative arrays, so you need to install Judy first,
 704 ;;; and Bogofilter next.  Fetch both distributions by visiting the
 705 ;;; following links and downloading the latest version of each:
 706 ;;;
 707 ;;;     http://sourceforge.net/projects/judy/
 708 ;;;     http://www.tuxedo.org/~esr/bogofilter/
 709 ;;;
 710 ;;; Unpack the Judy distribution and enter its main directory.  Then do:
 711 ;;;
 712 ;;;     ./configure
 713 ;;;     make
 714 ;;;     make install
 715 ;;;
 716 ;;; You will likely need to become super-user for the last step.
 717 ;;; Then, unpack the Bogofilter distribution and enter its main
 718 ;;; directory:
 719 ;;;
 720 ;;;     make
 721 ;;;     make install
 722 ;;;
 723 ;;; Here as well, you need to become super-user for the last step.
 724 ;;; Now, initialize your word lists by doing, under your own identity:
 725 ;;;
 726 ;;;     mkdir ~/.bogofilter
 727 ;;;     touch ~/.bogofilter/badlist
 728 ;;;     touch ~/.bogofilter/goodlist
 729 ;;;
 730 ;;; These two files are text files you may edit, but you normally don't!
 731
 732 ;;; The `M-d' command gets added to Gnus summary mode, marking current
 733 ;;; article as spam, showing it with the `H' mark.  Whenever you see a
 734 ;;; spam article, make sure to mark its summary line with `M-d' before
 735 ;;; leaving the group.  Some groups, as per variable
 736 ;;; `spam-junk-mailgroups' below, receive articles from Gnus splitting
 737 ;;; on clues added by spam recognisers, so for these groups, we tack
 738 ;;; an `H' mark at group entry for all summary lines which would
 739 ;;; otherwise have no other mark.  Make sure to _remove_ `H' marks for
 740 ;;; any article which is _not_ genuine spam, before leaving such
 741 ;;; groups: you may use `M-u' to "unread" the article, or `d' for
 742 ;;; declaring it read the non-spam way.  When you leave a group, all
 743 ;;; `H' marked articles, saved or unsaved, are sent to Bogofilter
 744 ;;; which will study them as spam samples.
 745
 746 ;;; Messages may also be deleted in various other ways, and unless
 747 ;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for
 748 ;;; default read or explicit delete, marks `X' and 'K' for automatic
 749 ;;; or explicit kills, as well as mark `Y' for low scores, are all
 750 ;;; considered to be associated with articles which are not spam.
 751 ;;; This assumption might be false, in particular if you use kill
 752 ;;; files or score files as means for detecting genuine spam, you
 753 ;;; should then adjust `spam-ham-marks-form'.  When you leave a group,
 754 ;;; all _unsaved_ articles bearing any the above marks are sent to
 755 ;;; Bogofilter which will study these as not-spam samples.  If you
 756 ;;; explicit kill a lot, you might sometimes end up with articles
 757 ;;; marked `K' which you never saw, and which might accidentally
 758 ;;; contain spam.  Best is to make sure that real spam is marked with
 759 ;;; `H', and nothing else.
 760
 761 ;;; All other marks do not contribute to Bogofilter pre-conditioning.
 762 ;;; In particular, ticked, dormant or souped articles are likely to
 763 ;;; contribute later, when they will get deleted for real, so there is
 764 ;;; no need to use them prematurely.  Explicitly expired articles do
 765 ;;; not contribute, command `E' is a way to get rid of an article
 766 ;;; without Bogofilter ever seeing it.
 767
 768 ;;; In a word, with a minimum of care for associating the `H' mark for
 769 ;;; spam articles only, Bogofilter training all gets fairly automatic.
 770 ;;; You should do this until you get a few hundreds of articles in
 771 ;;; each category, spam or not.  The shell command `head -1
 772 ;;; ~/.bogofilter/*' shows both article counts.  The command `S S' in
 773 ;;; summary mode, either for debugging or for curiosity, triggers
 774 ;;; Bogofilter into displaying in another buffer the "spamicity" score
 775 ;;; of the current article (between 0.0 and 1.0), together with the
 776 ;;; article words which most significantly contribute to the score.
 777
 778 ;;; The real way for using Bogofilter, however, is to have some use
 779 ;;; tool like `procmail' for invoking it on message reception, then
 780 ;;; adding some recognisable header in case of detected spam.  Gnus
 781 ;;; splitting rules might later trip on these added headers and react
 782 ;;; by sorting such articles into specific junk folders as per
 783 ;;; `spam-junk-mailgroups'.  Here is a possible `.procmailrc' contents
 784 ;;; (still untested -- please tell me how it goes):
 785 ;;;
 786 ;;; :0HBf:
 787 ;;; * ? bogofilter
 788 ;;; | formail -bfI "X-Spam-Status: Yes"
 789
 790 (defun spam-check-bogofilter ()
 791   ;; Dynamic spam check.  I do not know how to check the exit status,
 792   ;; so instead, read `bogofilter -v' output.
 793   (when (and spam-use-bogofilter spam-bogofilter-path)
 794     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 795     (when (save-excursion
 796             (set-buffer spam-bogofilter-output-buffer-name)
 797             (goto-char (point-min))
 798             (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
 799       spam-split-group)))
 800
 801 (defun spam-bogofilter-score ()
 802   "Use `bogofilter -v' on the current article.
 803 This yields the 15 most discriminant words for this article and the
 804 spamicity coefficient of each, and the overall article spamicity."
 805   (interactive)
 806   (when (and spam-use-bogofilter spam-bogofilter-path)
 807     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
 808     (with-current-buffer spam-bogofilter-output-buffer-name
 809       (unless (zerop (buffer-size))
 810         (if (<= (count-lines (point-min) (point-max)) 1)
 811             (progn
 812               (goto-char (point-max))
 813               (when (bolp)
 814                 (backward-char 1))
 815               (message "%s" (buffer-substring (point-min) (point))))
 816           (goto-char (point-min))
 817           (display-buffer (current-buffer)))))))
 818
 819 (defun spam-bogofilter-register-routine ()
 820   (let ((articles gnus-newsgroup-articles)
 821         article mark ham-articles spam-articles spam-mark-values
 822         ham-mark-values)
 823
 824     ;; marks are stored as symbolic values, so we have to dereference
 825     ;; them for memq to work we wouldn't have to do this if
 826     ;; gnus-summary-article-mark returned a symbol.
 827     (dolist (mark spam-ham-marks)
 828       (push (symbol-value mark) ham-mark-values))
 829
 830     (dolist (mark spam-spam-marks)
 831       (push (symbol-value mark) spam-mark-values))
 832
 833     (while articles
 834       (setq article (pop articles)
 835             mark (gnus-summary-article-mark article))
 836       (cond ((memq mark spam-mark-values) (push article spam-articles))
 837             ((memq article gnus-newsgroup-saved))
 838             ((memq mark ham-mark-values) (push article ham-articles))))
 839     (when ham-articles
 840       (spam-bogofilter-articles "ham" "-n" ham-articles))
 841     (when spam-articles
 842       (spam-bogofilter-articles "SPAM" "-s" spam-articles))))
 843
 844 (defun spam-bogofilter-articles (type option articles)
 845   (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
 846         (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
 847         (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp
 848                                "\\|Xref:"))
 849         (counter 0)
 850         prefix process article)
 851     (when type
 852       (setq prefix (format "Studying %d articles as %s..." (length articles)
 853                            type))
 854       (message "%s" prefix))
 855     (save-excursion (set-buffer output-buffer) (erase-buffer))
 856     (setq process (start-process "bogofilter" output-buffer
 857                                  spam-bogofilter-path "-F" option))
 858     (process-kill-without-query process t)
 859     (unwind-protect
 860         (save-window-excursion
 861           (while articles
 862             (setq counter (1+ counter))
 863             (when prefix
 864               (message "%s %d" prefix counter))
 865             (setq article (pop articles))
 866             (gnus-summary-goto-subject article)
 867             (gnus-summary-show-article t)
 868             (gnus-eval-in-buffer-window article-copy
 869               (insert-buffer-substring gnus-original-article-buffer)
 870               ;; Remove spam classification redundant headers: they may induce
 871               ;; unwanted biases in later analysis.
 872               (message-remove-header remove-regexp t)
 873               ;; Bogofilter really wants From envelopes for counting articles.
 874               ;; Fake one at the beginning, make sure there will be no other.
 875               (goto-char (point-min))
 876               (if (looking-at "From ")
 877                   (forward-line 1)
 878                 (insert "From nobody " (current-time-string) "\n"))
 879               (let (case-fold-search)
 880                 (while (re-search-forward "^From " nil t)
 881                   (beginning-of-line)
 882                   (insert ">")))
 883               (process-send-region process (point-min) (point-max))
 884               (erase-buffer))))
 885       ;; Sending the EOF is unwind-protected.  This is to prevent lost copies
 886       ;; of `bogofilter', hung on reading their standard input, in case the
 887       ;; whole registering process gets interrupted by the user.
 888       (process-send-eof process))
 889     (kill-buffer article-copy)
 890     ;; Receive process output.  It sadly seems that we still have to protect
 891     ;; ourselves against hung `bogofilter' processes.
 892     (let ((status (process-status process))
 893           (timeout (* 1000 spam-bogofilter-initial-timeout))
 894           (quanta 200))                 ; also counted in milliseconds
 895       (while (and (not (eq status 'exit)) (> timeout 0))
 896         ;; `accept-process-output' timeout is counted in microseconds.
 897         (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
 898                           (* 1000 spam-bogofilter-subsequent-timeout)
 899                         (- timeout quanta))
 900               status (process-status process)))
 901       (if (eq status 'exit)
 902           (when prefix
 903             (message "%s done!" prefix))
 904         ;; Sigh!  The process did time out...  Become brutal!
 905         (interrupt-process process)
 906         (message "%s %d INTERRUPTED!  (Article %d, status %s)"
 907                  (or prefix "Bogofilter process...")
 908                  counter article status)
 909         ;; Give some time for user to read.  Sitting redisplays but gives up
 910         ;; if input is pending.  Sleeping does not give up, but it does not
 911         ;; redisplay either.  Mix both: let's redisplay and not give up.
 912         (sit-for 1)
 913         (sleep-for 3)))))
 914
 915 (provide 'spam)
 916
 917 ;;; spam.el ends here.