jabber-keepalive.el

   1 ;; jabber-keepalive.el - try to detect lost connection
   2
   3 ;; Copyright (C) 2007 - Detlev Zundel - dzu@gnu.org
   4 ;; Copyright (C) 2004 - Magnus Henoch - mange@freemail.hu
   5
   6 ;; This file is a part of jabber.el.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 ;;; These keepalive functions send a jabber:iq:time request to the
  23 ;;; server every X minutes, and considers the connection broken if
  24 ;;; they get no answer within Y seconds.
  25
  26 (defgroup jabber-keepalive nil
  27   "Keepalive functions try to detect lost connection"
  28   :group 'jabber)
  29
  30 (defcustom jabber-keepalive-interval 600
  31   "Interval in seconds between connection checks."
  32   :type 'integer
  33   :group 'jabber-keepalive)
  34
  35 (defcustom jabber-keepalive-timeout 20
  36   "Seconds to wait for response from server."
  37   :type 'integer
  38   :group 'jabber-keepalive)
  39
  40 (defvar jabber-keepalive-timer nil
  41   "Timer object for keepalive function")
  42
  43 (defvar jabber-keepalive-timeout-timer nil
  44   "Timer object for keepalive timeout function")
  45
  46 (defvar jabber-keepalive-pending nil
  47   "List of outstanding keepalive connections")
  48
  49 (defvar jabber-keepalive-debug nil
  50   "Log keepalive traffic when non-nil")
  51
  52 (defun jabber-keepalive-start (&optional jc)
  53   "Activate keepalive.
  54 The JC argument makes it possible to add this function to
  55 `jabber-post-connect-hooks'; it is ignored.  Keepalive is activated
  56 for all accounts regardless of the argument."
  57   (interactive)
  58
  59   (when jabber-keepalive-timer
  60     (jabber-keepalive-stop))
  61
  62   (setq jabber-keepalive-timer
  63         (run-with-timer 5
  64                         jabber-keepalive-interval
  65                         'jabber-keepalive-do))
  66   (add-hook 'jabber-post-disconnect-hook 'jabber-keepalive-stop))
  67
  68 (defun jabber-keepalive-stop ()
  69   "Deactivate keepalive"
  70   (interactive)
  71
  72   (when jabber-keepalive-timer
  73     (jabber-cancel-timer jabber-keepalive-timer)
  74     (setq jabber-keepalive-timer nil)))
  75
  76 (defun jabber-keepalive-do ()
  77   (when jabber-keepalive-debug
  78     (message "%s: sending keepalive packet(s)" (current-time-string)))
  79   (setq jabber-keepalive-timeout-timer
  80         (run-with-timer jabber-keepalive-timeout
  81                         nil
  82                         'jabber-keepalive-timeout))
  83   (setq jabber-keepalive-pending jabber-connections)
  84   (dolist (c jabber-connections)
  85     ;; Whether we get an error or not is not interesting.
  86     ;; Getting a response at all is.
  87     (jabber-send-iq c nil "get"
  88                     '(query ((xmlns . "jabber:iq:time")))
  89                     'jabber-keepalive-got-response nil
  90                     'jabber-keepalive-got-response nil)))
  91
  92 (defun jabber-keepalive-got-response (jc &rest args)
  93   (when jabber-keepalive-debug
  94     (message "%s: got keepalive response from %s"
  95              (current-time-string)
  96              (plist-get (fsm-get-state-data jc) :server)))
  97   (setq jabber-keepalive-pending (remq jc jabber-keepalive-pending))
  98   (when (null jabber-keepalive-pending)
  99     (jabber-cancel-timer jabber-keepalive-timeout-timer)
 100     (setq jabber-keepalive-timeout-timer nil)))
 101
 102 (defun jabber-keepalive-timeout ()
 103   (jabber-cancel-timer jabber-keepalive-timer)
 104   (setq jabber-keepalive-timer nil)
 105
 106   (dolist (c jabber-keepalive-pending)
 107     (message "%s: keepalive timeout, connection to %s considered lost"
 108              (current-time-string)
 109              (plist-get (fsm-get-state-data c) :server))
 110
 111     (run-hooks jabber-lost-connection-hook)
 112     (jabber-disconnect-one c nil)))
 113
 114 (provide 'jabber-keepalive)
 115
 116 ;;; arch-tag: d19ca743-75a1-475f-9217-83bd18012146