jabber-keepalive.el

   1 ;; jabber-keepalive.el - try to detect lost connection
   2
   3 ;; Copyright (C) 2004, 2008 - Magnus Henoch - mange@freemail.hu
   4 ;; Copyright (C) 2007 - Detlev Zundel - dzu@gnu.org
   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
  23 ;;;; Keepalive - send something to the server and see if it answers
  24 ;;;
  25 ;;; These keepalive functions send a urn:xmpp:ping request to the
  26 ;;; server every X minutes, and considers the connection broken if
  27 ;;; they get no answer within Y seconds.
  28
  29 (require 'jabber-ping)
  30
  31 ;;;###autoload
  32 (defgroup jabber-keepalive nil
  33   "Keepalive functions try to detect lost connection"
  34   :group 'jabber)
  35
  36 ;;;###autoload
  37 (defcustom jabber-keepalive-interval 600
  38   "Interval in seconds between connection checks."
  39   :type 'integer
  40   :group 'jabber-keepalive)
  41
  42 ;;;###autoload
  43 (defcustom jabber-keepalive-timeout 20
  44   "Seconds to wait for response from server."
  45   :type 'integer
  46   :group 'jabber-keepalive)
  47
  48 (defvar jabber-keepalive-timer nil
  49   "Timer object for keepalive function")
  50
  51 (defvar jabber-keepalive-timeout-timer nil
  52   "Timer object for keepalive timeout function")
  53
  54 (defvar jabber-keepalive-pending nil
  55   "List of outstanding keepalive connections")
  56
  57 (defvar jabber-keepalive-debug nil
  58   "Log keepalive traffic when non-nil")
  59
  60 ;;;###autoload
  61 (defun jabber-keepalive-start (&optional jc)
  62   "Activate keepalive.
  63 That is, regularly send a ping request to the server, and
  64 disconnect if it doesn't answer.  See `jabber-keepalive-interval'
  65 and `jabber-keepalive-timeout'.
  66
  67 The JC argument makes it possible to add this function to
  68 `jabber-post-connect-hooks'; it is ignored.  Keepalive is activated
  69 for all accounts regardless of the argument."
  70   (interactive)
  71
  72   (when jabber-keepalive-timer
  73     (jabber-keepalive-stop))
  74
  75   (setq jabber-keepalive-timer
  76         (run-with-timer 5
  77                         jabber-keepalive-interval
  78                         'jabber-keepalive-do))
  79   (add-hook 'jabber-post-disconnect-hook 'jabber-keepalive-stop))
  80
  81 (defun jabber-keepalive-stop ()
  82   "Deactivate keepalive"
  83   (interactive)
  84
  85   (when jabber-keepalive-timer
  86     (jabber-cancel-timer jabber-keepalive-timer)
  87     (setq jabber-keepalive-timer nil)))
  88
  89 (defun jabber-keepalive-do ()
  90   (when jabber-keepalive-debug
  91     (message "%s: sending keepalive packet(s)" (current-time-string)))
  92   (setq jabber-keepalive-timeout-timer
  93         (run-with-timer jabber-keepalive-timeout
  94                         nil
  95                         'jabber-keepalive-timeout))
  96   (setq jabber-keepalive-pending jabber-connections)
  97   (dolist (c jabber-connections)
  98     ;; Whether we get an error or not is not interesting.
  99     ;; Getting a response at all is.
 100     (jabber-ping-send c nil 'jabber-keepalive-got-response nil nil)))
 101
 102 (defun jabber-keepalive-got-response (jc &rest args)
 103   (when jabber-keepalive-debug
 104     (message "%s: got keepalive response from %s"
 105              (current-time-string)
 106              (plist-get (fsm-get-state-data jc) :server)))
 107   (setq jabber-keepalive-pending (remq jc jabber-keepalive-pending))
 108   (when (and (null jabber-keepalive-pending) (timerp jabber-keepalive-timeout-timer))
 109     (jabber-cancel-timer jabber-keepalive-timeout-timer)
 110     (setq jabber-keepalive-timeout-timer nil)))
 111
 112 (defun jabber-keepalive-timeout ()
 113   (jabber-cancel-timer jabber-keepalive-timer)
 114   (setq jabber-keepalive-timer nil)
 115
 116   (dolist (c jabber-keepalive-pending)
 117     (message "%s: keepalive timeout, connection to %s considered lost"
 118              (current-time-string)
 119              (plist-get (fsm-get-state-data c) :server))
 120
 121     (run-hooks jabber-lost-connection-hooks c)
 122     (jabber-disconnect-one c nil)))
 123
 124 ;;;; Whitespace pings - less traffic, no error checking on our side
 125 ;;;
 126 ;;; Openfire needs something like this, but I couldn't bring myself to
 127 ;;; enable keepalive by default... Whitespace pings are light and
 128 ;;; unobtrusive.
 129
 130 ;;;###autoload
 131 (defcustom jabber-whitespace-ping-interval 30
 132   "Send a space character to the server with this interval, in seconds.
 133
 134 This is a traditional remedy for a number of problems: to keep NAT
 135 boxes from considering the connection dead, to have the OS discover
 136 earlier that the connection is lost, and to placate servers which rely
 137 on the client doing this, e.g. Openfire.
 138
 139 If you want to verify that the server is able to answer, see
 140 `jabber-keepalive-start' for another mechanism."
 141   :type '(integer :tag "Interval in seconds")
 142   :group 'jabber-core)
 143
 144 (defvar jabber-whitespace-ping-timer nil
 145   "Timer object for whitespace pings")
 146
 147 ;;;###autoload
 148 (defun jabber-whitespace-ping-start (&optional jc)
 149   "Start sending whitespace pings at regular intervals.
 150 See `jabber-whitespace-ping-interval'.
 151
 152 The JC argument is ignored; whitespace pings are enabled for all
 153 accounts."
 154   (interactive)
 155
 156   (when jabber-whitespace-ping-timer
 157     (jabber-whitespace-ping-stop))
 158
 159   (setq jabber-whitespace-ping-timer
 160         (run-with-timer 5
 161                         jabber-whitespace-ping-interval
 162                         'jabber-whitespace-ping-do))
 163   (add-hook 'jabber-post-disconnect-hook 'jabber-whitespace-ping-stop))
 164
 165 (defun jabber-whitespace-ping-stop ()
 166   "Deactivate whitespace pings"
 167   (interactive)
 168
 169   (when jabber-whitespace-ping-timer
 170     (jabber-cancel-timer jabber-whitespace-ping-timer)
 171     (setq jabber-whitespace-ping-timer nil)))
 172
 173 (defun jabber-whitespace-ping-do ()
 174   (dolist (c jabber-connections)
 175     (jabber-send-string c " ")))
 176
 177 (provide 'jabber-keepalive)
 178
 179 ;;; arch-tag: d19ca743-75a1-475f-9217-83bd18012146