open Wd_dialog
open Wd_types
open Unix
open Wdstated_clnt
open Wdstated_aux
open Rpc
open Rpc_client
let _ = Random.full_init [|int_of_float (gettimeofday ());getpid ()|]
let random_char () =
if Random.bool () then
Char.chr ((Random.int 26) + 65)
else
Char.chr ((Random.int 26) + 97)
let make_session_id () =
let length = 128 + (Random.int 128) in
let id = String.create length in
for i=0 to length - 1
do
id.[i] <- random_char ()
done;
id
let copy_dialog universe env dlg =
let new_dlg = universe#create env (dlg#name) in
new_dlg#unserialize (dlg#serialize);
new_dlg
exception Session_not_found
exception Failed_to_commit_changes of int
exception Cannot_fetch_dialog of int
exception Failed_to_get_session of int
type sessiond_con = {
mutable con: Rpc_client.t;
host: string;
user: string;
pass: string;
timeout: int32;
}
let reconnect con =
con.con <- Wdstated.V1.create_portmapped_client con.host Tcp
let rec put_session con id data =
try Wdstated.V1.put_session con.con (con.user, con.pass, con.timeout, id, data)
with
Message_lost | Message_timeout
| Communication_error _ | Client_is_down | Unix.Unix_error _ ->
reconnect con;put_session con id data
let rec replace_session con id data =
try Wdstated.V1.replace_session con.con (con.user, con.pass, con.timeout, id, data)
with
Message_lost | Message_timeout
| Communication_error _ | Client_is_down | Unix.Unix_error _ ->
reconnect con;replace_session con id data
let rec get_session con id =
try Wdstated.V1.get_session con.con (con.user, con.pass, id)
with
Message_lost | Message_timeout
| Communication_error _ | Client_is_down | Unix.Unix_error _ ->
reconnect con;get_session con id
class daemon_session con id (instant_session : session_type) =
object (self)
method commit_changes () =
instant_session#commit_changes ();
match replace_session con id instant_session#serialize with
0l -> ()
| err -> raise (Failed_to_commit_changes (Int32.to_int err))
method serialize = id
method session_id = id
method change_dialog d = instant_session#change_dialog d
method dialog = instant_session#dialog
method dialog_name = instant_session#dialog_name
end;;
class daemon_session_manager user pass host timeout : session_manager_type =
object (self)
inherit instant_session_manager () as super
val session_d = {con=Wdstated.V1.create_portmapped_client host Tcp;
host=host;
user=user;
pass=pass;
timeout=(Int32.of_int timeout)}
method create dlg =
let id = make_session_id () in
let dses = new daemon_session session_d id (super#create dlg) in
(try dses#commit_changes ();dses (* make sure we have a unique id *)
with Failed_to_commit_changes 5 ->
self#create dlg)
method unserialize universe env id =
self#create (* copy the session to make back buttons work *)
(super#unserialize universe env
(match get_session session_d id with
{result_code=0l;serialized_data=data} -> data
| {result_code=err} ->
raise (Failed_to_get_session (Int32.to_int err))))#dialog
end;;