djavu-asus/emacs/elpa/jabber-20230715.456/jabber-keepalive.el

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