cgit.sxemacs.org Git - packages/blob - xemacs-packages/zenirc/src/zenirc-netsplit.el

   1 ;;; zenirc-netsplit.el --- hide excessive spew from netsplits
   2
   3 ;; Copyright (C) 1993, 1994 Ben A. Mesander
   4 ;; Copyright (C) 1995 Noah S. Friedman
   5 ;; Copyright (C) 1998 Per Persson
   6
   7 ;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
   8 ;;         Eric Prestemon <ecp@io.com>
   9 ;;         Noah Friedman <friedman@prep.ai.mit.edu>
  10 ;;         Per Persson <pp@sno.pp.se>
  11 ;; Maintainer: pp@sno.pp.se
  12 ;; Keywords: zenirc, extensions
  13 ;; Created: 1993/03/10
  14
  15 ;; This program is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19 ;;
  20 ;; This program is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with this program; if not, you can either send email to this
  27 ;; program's maintainer or write to: The Free Software Foundation,
  28 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; This script attempts to supress excessive signon/offs and mode changes
  33 ;; due to netsplits.
  34
  35 ;;; Code:
  36
  37 (require 'zenirc)
  38
  39 (defvar zenirc-netsplit-show-server-mode-changes-p nil
  40   "Set to t to enable display of server mode changes.")
  41
  42 (defvar zenirc-netsplit-debug nil
  43   "Set to t in order to enable debugging messages in the netsplit code")
  44
  45 ;; this is a list of the form
  46 ;; (("a.b.c.d e.f.g" (time stamp) first-join "nick1" ... "nickn") ...)
  47 ;; where first-join is t or nil, depending on whether or not the first
  48 ;; join from that split has been detected or not.
  49 (defvar zenirc-netsplit-list nil)
  50 (make-variable-buffer-local 'zenirc-netsplit-list)
  51
  52 (defvar zenirc-command-wholeft-hook '(zenirc-netsplit-wholeft))
  53
  54 (zenirc-add-hook 'zenirc-server-JOIN-hook 'zenirc-netsplit-JOIN)
  55 (zenirc-add-hook 'zenirc-server-MODE-hook 'zenirc-netsplit-MODE)
  56 (zenirc-add-hook 'zenirc-server-QUIT-hook 'zenirc-netsplit-QUIT)
  57 (zenirc-add-hook 'zenirc-timer-hook 'zenirc-netsplit-timer)
  58
  59 ;; TODO: add messages for other languages
  60 (defun zenirc-netsplit-install-message-catalogs ()
  61   (zenirc-lang-define-catalog 'english
  62    '((netsplit . "[info] netsplit: %s")
  63      (netsplit-join . "[info] netjoin: %s")
  64      (netsplit-wholeft . "[info] split: %s missing: %s %s")
  65      )))
  66
  67 ;; show/don't show rejoins
  68 (defun zenirc-netsplit-JOIN (proc parsedmsg)
  69   (let ((nick (zenirc-downcase-name (zenirc-extract-nick (aref parsedmsg 1))))
  70         (list zenirc-netsplit-list)
  71         elt)
  72     (while list
  73       (setq elt (car list))
  74       (setq list (cdr list))
  75       (if (member nick (nthcdr 3 elt))
  76           (progn
  77             (setq zenirc-run-next-hook nil)
  78             (if (not (car (cdr (cdr elt))))
  79                 (progn
  80                   (zenirc-message proc 'netsplit-join (car elt))
  81                   (setcar (nthcdr 2 elt) t)))
  82             ;; need to remove this nick, perhaps the whole entry here.
  83             ;; Note that by removing the nick now, we can't tell if further
  84             ;; join messages (for other channels) should also be
  85             ;; suppressed.
  86             (if (null (nthcdr 4 elt))
  87                 (setq zenirc-netsplit-list (delq elt zenirc-netsplit-list))
  88               (delete nick elt)))))))
  89
  90 ;; hide mode changes from servers
  91 (defun zenirc-netsplit-MODE (proc parsedmsg)
  92   (save-match-data
  93     ;; regexp matches things with a . in them, and no ! or @ in them.
  94     (cond ((string-match "^[^@!]+\\.[^@!]+$" (aref parsedmsg 1))
  95            (and zenirc-netsplit-debug
  96                 (zenirc-message proc "[debug] server mode change.\n"))
  97            (or zenirc-netsplit-show-server-mode-changes-p
  98                (setq zenirc-run-next-hook nil))))))
  99
 100 ;; detect netsplits
 101 (defun zenirc-netsplit-QUIT (proc parsedmsg)
 102   (save-match-data
 103     (let* ((split (zenirc-downcase-name (aref parsedmsg 2)))
 104            (nick (zenirc-downcase-name (zenirc-extract-nick (aref parsedmsg 1))))
 105            ass)
 106       ;; look for arguments of the form host.name.1 host.name.2
 107       (if (string-match "^[^ ]+\\.[^ ]+ [^ ]+\\.[^ ]+$" split)
 108           (progn
 109             (setq zenirc-run-next-hook nil)
 110             (setq ass (assoc split zenirc-netsplit-list))
 111             (if ass
 112                 ;; element for this netsplit exists already
 113                 (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
 114               ;; element for this netsplit does not yet exist
 115               (setq zenirc-netsplit-list
 116                     (cons (list split
 117                                 (zenirc-time-to-int (current-time-string))
 118                                 nil
 119                                 nick)
 120                           zenirc-netsplit-list))
 121               (zenirc-message proc 'netsplit split)))))))
 122
 123 ;; clean cruft from zenirc-netsplit-list older than 10 minutes
 124 (defun zenirc-netsplit-timer (proc now)
 125   (let ((list zenirc-netsplit-list)
 126         elt)
 127     (while list
 128       (setq elt (car list))
 129       (setq list (cdr list))
 130       (and (zenirc-time< '(0 600) (zenirc-time-diff now (car (cdr elt))))
 131            (setq zenirc-netsplit-list (delq elt zenirc-netsplit-list))))))
 132
 133 ;; show who's gone
 134 (defun zenirc-netsplit-wholeft (proc parsedcmd)
 135   (let ((list zenirc-netsplit-list)
 136         elt)
 137     (while list
 138       (setq elt (car list))
 139       (setq list (cdr list))
 140       (zenirc-message proc 'netsplit-wholeft
 141                       (car elt)
 142                       (mapconcat 'identity (nthcdr 3 elt) " ")
 143                       (if (car (cdr (cdr elt)))
 144                           "(joining)"
 145                         "")))))
 146
 147 (provide 'zenirc-netsplit)
 148
 149 (zenirc-netsplit-install-message-catalogs)
 150
 151 ;;; zenirc-netsplit.el ends here