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;;