open Xmpp open Error open Types open Config open Common open Hooks let

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
open Xmpp
open Error
open Types
open Config
open Common
open Hooks
let _ =
let server = try
trim (Xml.get_cdata config ~path:["jabber"; "server"])
with Not_found ->
Printf.eprintf "Cannot find servername in config file";
flush stdout;
Pervasives.exit 127
in
let port = try
int_of_string (trim (Xml.get_cdata config ~path:["jabber"; "port"]))
with Not_found -> 5222
in
let username = try
trim (Xml.get_cdata config ~path:["jabber"; "user"])
with Not_found ->
Printf.eprintf "Cannot find username in config file";
flush stdout;
Pervasives.exit 127
in
let password = try
trim (Xml.get_cdata config ~path:["jabber"; "password"])
with Not_found ->
Printf.eprintf "Cannot find password in config file";
flush stdout;
Pervasives.exit 127
in
let resource = try
trim (Xml.get_cdata config ~path:["jabber"; "resource"])
with Not_found ->
Printf.eprintf "Cannot find resource name in config file";
flush stdout;
Pervasives.exit 127
in
let rawxml_log =
try Some (List.assoc "rawxml" Config.logger_options)
with Not_found -> None
in
let run () =
let jid, out, next_xml =
Xmpp.client ~username ~password ~resource ~server ~port
?rawxml_log () in
log#info "Connected to %s!" server;
Sys.set_signal Sys.sigint
(Sys.Signal_handle (function x -> Hooks.quit out));
Sys.set_signal Sys.sigterm
(Sys.Signal_handle (function x -> Hooks.quit out));
(* workaround for wildfire *)
out (make_presence ());
List.iter (fun proc ->
try proc out with exn ->
log#error "sulci.ml: %s" (Printexc.to_string exn))
!on_connect;
process_xml next_xml out
in
let reconnect_interval =
try int_of_string (trim (Xml.get_attr_s Config.config
~path:["reconnect"] "interval"))
with Not_found -> 0
in
let count =
try int_of_string (trim (Xml.get_attr_s Config.config
~path:["reconnect"] "count"))
with Not_found -> 0
in
let rec reconnect times =
try
if times >= 0 then
run ()
else
()
with
| Unix.Unix_error (code, "connect", _) ->
log#info "Unable to connect to %s:%d: %s"
server port (Unix.error_message code);
if times > 0 then (
Unix.sleep reconnect_interval;
log#info "Reconnecting. Attempts remains: %d" times;
);
reconnect (times - 1)
| Sasl.Failure cond ->
log#info "Auth.Failure: %s" cond;
(match cond with
| "non-authorized" ->
print_endline "will register"
| _ -> ()
)
| Sasl.AuthError reason ->
log#crit "Authorization failed: %s" reason;
Pervasives.exit 127
| Xmpp.XMPPStreamEnd ->
log#info"The connection to the server is lost";
List.iter (fun proc -> proc ()) !on_disconnect;
reconnect count
| Xmpp.XMPPStreamError els ->
let cond, text, _ = parse_stream_error els in
(match cond with
| `ERR_CONFLICT ->
log#info "Connection to the server closed: %s" text
| _ ->
log#info "The server reject us: %s" text
);
Pervasives.exit 127
| exn ->
log#error "sulci.ml: %s" (Printexc.to_string exn);
log#error "Probably it is a bug, please send me a bugreport"
in
reconnect count