git.chise.org Git - elisp/gnus.git-/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 ;;; Code:
  27
  28 (require 'dns)
  29 (require 'message)
  30
  31 ;;; Blackholes
  32
  33 (defvar spam-blackhole-servers
  34   '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk"
  35     "relays.visi.com" "rbl.maps.vix.com")
  36   "List of blackhole servers.")
  37
  38 (defun spam-check-blackholes ()
  39   "Check the Recevieved headers for blackholed relays."
  40   (let ((headers (message-fetch-field "received"))
  41         ips matches)
  42     (with-temp-buffer
  43       (insert headers)
  44       (goto-char (point-min))
  45       (while (re-search-forward
  46               "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
  47         (push (mapconcat 'identity
  48                          (nreverse (split-string (match-string 1) "\\."))
  49                          ".")
  50               ips)))
  51     (dolist (server spam-blackhole-servers)
  52       (dolist (ip ips)
  53         (when (query-dns (concat ip "." server))
  54           (push (list ip server (query-dns (concat ip "." server) 'TXT))
  55                 matches))))
  56     matches))
  57
  58 ;;; Black- and white-lists
  59
  60 (defvar spam-directory "~/News/spam/"
  61   "When spam files are kept.")
  62
  63 (defvar spam-whitelist (expand-file-name "whitelist" spam-directory)
  64   "The location of the whitelist.
  65 The file format is one regular expression per line.
  66 The regular expression is matched against the address.")
  67
  68 (defvar spam-blacklist (expand-file-name "blacklist" spam-directory)
  69   "The location of the blacklist.
  70 The file format is one regular expression per line.
  71 The regular expression is matched against the address.")
  72
  73 (defvar spam-whitelist-cache nil)
  74 (defvar spam-blacklist-cache nil)
  75
  76 (defun spam-enter-whitelist (address &optional blacklist)
  77   "Enter ADDRESS into the whitelist.
  78 Optional arg BLACKLIST, if non-nil, means to enter in the blacklist instead."
  79   (interactive "sAddress: ")
  80   (let ((file (if blacklist spam-blacklist spam-whitelist)))
  81     (unless (file-exists-p (file-name-directory file))
  82       (make-directory (file-name-directory file) t))
  83     (save-excursion
  84       (set-buffer
  85        (find-file-noselect file))
  86       (goto-char (point-max))
  87       (unless (bobp)
  88         (insert "\n"))
  89       (insert address "\n")
  90       (save-buffer))))
  91
  92 (defun spam-enter-blacklist (address)
  93   "Enter ADDRESS into the blacklist."
  94   (interactive "sAddress: ")
  95   (spam-enter-whitelist address t))
  96
  97 (defun spam-parse-whitelist (&optional blacklist)
  98   (let ((file (if blacklist spam-blacklist spam-whitelist))
  99         contents address)
 100     (when (file-exists-p file)
 101       (with-temp-buffer
 102         (insert-file-contents file)
 103         (while (not (eobp))
 104           (setq address (buffer-substring (point) (point-at-eol)))
 105           (forward-line 1)
 106           (unless (zerop (length address))
 107             (setq address (regexp-quote address))
 108             (while (string-match "\\\\\\*" address)
 109               (setq address (replace-match ".*" t t address)))
 110             (push address contents))))
 111       (nreverse contents))))
 112
 113 (defun spam-refresh-list-cache ()
 114   (setq spam-whitelist-cache (spam-parse-whitelist))
 115   (setq spam-blacklist-cache (spam-parse-whitelist t)))
 116
 117 (defun spam-address-whitelisted-p (address &optional blacklist)
 118   (let ((cache (if blacklist spam-blacklist-cache spam-whitelist-cache))
 119         found)
 120     (while (and (not found)
 121                 cache)
 122       (when (string-match (pop cache) address)
 123         (setq found t)))
 124     found))
 125
 126 (provide 'spam)
 127
 128 ;;; spam.el ends here