]> crepu.dev Git - config.git/blame_incremental - djavu-asus/elpa/jabber-20230715.456/jabber-keepalive.el
Actualizado el Readme
[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-keepalive.el
... / ...
CommitLineData
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.
61That is, regularly send a ping request to the server, and
62disconnect it if it doesn't answer. See variable `jabber-keepalive-interval'
63and variable `jabber-keepalive-timeout'.
64
65The JC argument makes it possible to add this function to
66`jabber-post-connect-hooks'; it is ignored. Keepalive is activated
67for 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
131This is a traditional remedy for a number of problems: to keep NAT
132boxes from considering the connection dead, to have the OS discover
133earlier that the connection is lost, and to placate servers which rely
134on the client doing this, e.g. Openfire.
135
136If 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.
147See `jabber-whitespace-ping-interval'.
148
149The JC argument is ignored; whitespace pings are enabled for all
150accounts."
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