]>
Commit | Line | Data |
---|---|---|
53e6db90 DC |
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 |