Commit 19820f9f authored by gremlin43820's avatar gremlin43820

adding in memory session managment module for secure session managment of daemonized processes.


git-svn-id: https://godirepo.camlcity.org/svn/wdialog/trunk@197 f54c9a64-0731-4a92-b797-30fd5898f27c
parent 7b9d9714
requires="wdialog"
version="@VERSION@"
archive(byte)="wd_inmemory_session.cma"
archive(native)="wd_inmemory_session.cmxa"
# $Id: Makefile,v 1.1 2005-05-13 20:13:26 gremlin43820 Exp $
TOP_DIR=../..
OBJECTS =
PKGNAME = wd-inmemory-session
include $(TOP_DIR)/Makefile.rules
all: wd_inmemory_session
opt: wd_inmemory_session.opt
wd_inmemory_session: wd_inmemory_session.cmi wd_inmemory_session.cmo
$(OCAMLC) -o wd_inmemory_session.cma wdialog.cma \
wd_inmemory_session.cmo -linkpkg
wd_inmemory_session.opt: wd_inmemory_session.cmi wd_inmemory_session.cmx
$(OCAMLOPT) -o wd_inmemory_session.cmxa \
wdialog.cmxa wd_inmemory_session.cmx -linkpkg
OCAMLC_OPTIONS += -I ../wdialog
OCAMLOPT_OPTIONS += -I ../wdialog
*.mli:
true
#include depend
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
new_dlg#unserialize (dlg#serialize);
new_dlg
exception Session_not_found
class memory_session (id: string) (dlg : dialog_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
end;;
type session = {created:Int32.t;
mutable last_used:Int32.t;
session:memory_session}
class memory_session_manager timeout sweep_time =
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;;
val random_char : unit -> char
val make_session_id : unit -> string
val make_unique_session_id : (string, 'a) Hashtbl.t -> string
val copy_dialog :
< create : 'a -> 'b -> (< unserialize : 'd -> 'e; .. > as 'c); .. > ->
'a -> < name : 'b; serialize : 'd; .. > -> 'c
exception Session_not_found
class memory_session :
string ->
Wd_types.dialog_type ->
object
val mutable dialog : Wd_types.dialog_type
val id : string
method change_dialog : Wd_types.dialog_type -> unit
method commit_changes : unit -> unit
method dialog : Wd_types.dialog_type
method dialog_name : string
method serialize : string
end
type session = {
created : Int32.t;
mutable last_used : Int32.t;
session : memory_session;
}
class memory_session_manager :
Int32.t -> Int32.t ->
object
val sessions : (string, session) Hashtbl.t
method create : Wd_types.dialog_type -> memory_session
method unserialize :
Wd_types.universe_type ->
Wd_types.environment -> string -> memory_session
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment