Plasma GitLab Archive
Projects Blog Knowledge

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

This web site is published by Informatikbüro Gerd Stolpmann
Powered by Caml