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
  66 (defvar spam-blacklist (expand-file-name "blacklist" spam-directory)
  67   "The location of the whitelist.")
  68
  69 (defvar spam-whitelist-cache nil)
  70 (defvar spam-blacklist-cache nil)
  71
  72 (defun spam-enter-whitelist (address &optional blacklist)
  73   "Enter ADDRESS into the whitelist."
  74   (interactive "sAddress: ")
  75   (let ((file (if blacklist spam-blacklist spam-whitelist)))
  76     (unless (file-exists-p (file-name-directory file))
  77       (make-directory (file-name-directory file) t))
  78     (save-excursion
  79       (set-buffer
  80        (find-file-noselect file))
  81       (goto-char (point-max))
  82       (unless (bobp)
  83         (insert "\n"))
  84       (insert address "\n")
  85       (save-buffer))))
  86
  87 (defun spam-parse-whitelist (&optional blacklist)
  88   (let ((file (if blacklist spam-blacklist spam-whitelist))
  89         contents address)
  90     (when (file-exists-p file)
  91       (with-temp-buffer
  92         (insert-file-contents file)
  93         (while (not (eobp))
  94           (setq address (buffer-substring (point) (point-at-eol)))
  95           (forward-line 1)
  96           (unless (zerop (length address))
  97             (setq address (regexp-quote address))
  98             (while (string-match "\\\\\\*" address)
  99               (setq address (replace-match ".*" t t address)))
 100             (push address contents))))
 101       (nreverse contents))))
 102
 103 (defun spam-refresh-list-cache ()
 104   (setq spam-whitelist-cache (spam-parse-whitelist))
 105   (setq spam-blacklist-cache (spam-parse-whitelist t)))
 106
 107 (defun spam-address-whitelisted-p (address &optional blacklist)
 108   (let ((cache (if blacklist spam-blacklist-cache spam-whitelist-cache))
 109         found)
 110     (while (and (not found)
 111                 cache)
 112       (when (string-match (pop cache) address)
 113         (setq found t)))
 114     found))
 115
 116 (provide 'spam)
 117
 118 ;;; spam.el ends here