Plasma GitLab Archive
Projects Blog Knowledge

open Wd_dialog
open Wd_types
open Unix

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 rec make_unique_session_id tbl =
  let id = make_session_id () in
    try ignore (Hashtbl.find tbl id);make_unique_session_id tbl;id
    with Not_found -> id

let copy_dialog universe env dlg =
  let new_dlg = universe#create env (dlg#name) in
  let b = Buffer.create 1000 in
  dlg # serialize (Hashtbl.create 10) b;
  let ds_buf =
    { ds_str = Buffer.contents b;
      ds_pos = 0;
      ds_end = Buffer.length b;
      ds_universe = universe;
      ds_environment = env;
      ds_dialogs = Hashtbl.create 10;
    } in
  new_dlg # unserialize ds_buf;
  new_dlg

exception Session_not_found

class memory_session (id: string) (dlg : dialog_type) : session_type =
object (self)
  val id = id
  val mutable dialog = dlg
  method commit_changes () = ()
  method serialize = id
  method change_dialog dlg = dialog <- dlg
  method dialog = dialog
  method dialog_name = dialog#name
  method session_id = id
end;;

type session = {created:Int32.t;
		mutable last_used:Int32.t;
		session:memory_session}

class memory_session_manager timeout sweep_time : session_manager_type =
object (self)
  val sessions = Hashtbl.create 50000
  val mutable previous_sweep = Int32.of_float (gettimeofday ())

  method create (dlg: dialog_type) = 
    let id = make_unique_session_id sessions in
    let memses = new memory_session id dlg in
    let now = Int32.of_float (gettimeofday()) in
      self#check_sweep now;
      Hashtbl.add sessions id {session=memses;
			       created=now;
			       last_used=now};
      memses

  method private check_sweep current_time =
    if (Int32.compare 
	  (Int32.sub current_time previous_sweep) 
	  sweep_time) = 1 
    then
      (self#sweep;
       previous_sweep <- current_time)

  method private sweep =
    let now = Int32.of_float (gettimeofday ()) in
      Hashtbl.iter
	(fun id s -> 
	   if (Int32.compare (Int32.sub now s.last_used) timeout) = 1 then
	     Hashtbl.remove sessions id)
	sessions;

  method unserialize (universe: universe_type) env id = 
    try
      let s = Hashtbl.find sessions id in
      let now = Int32.of_float (gettimeofday()) in
	self#check_sweep now;
	if (Int32.compare (Int32.sub now s.last_used) timeout) = 1 then
	  (Hashtbl.remove sessions id;
	   raise Session_not_found)
	else 	  
	  self#create 
	    (copy_dialog 
		universe env s.session#dialog)
    with _ -> raise Session_not_found
end;;

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