open Rtypes
open Xdr
open Rpc
open Rpc_server
open Wdstated_aux
open Printf
open Unix
open Arg
open Wdstated_config

let server_port = ref 0
let sessions = Hashtbl.create 10000
let last_sweep = ref (gettimeofday ())
let config_location = ref "./wdstated.conf"
let fork_into_background = ref false

let _ = Arg.parse 
	  [("-f", Set_string config_location, "location of the config file");
	   ("-d", Set fork_into_background, "fork into the background as a daemon")]
	  (fun arg -> raise (Invalid_argument arg))
	  "Web State Daemon, a small daemon for maintaining the state of web applications"

let cfg = ref (getconfig !config_location)

let code_success = 0l
let code_authfail = 1l
let code_error = 2l
let code_timeout = 3l
let code_notfound = 4l
let code_exists = 5l

exception Authentication_failed
let authenticate user password =
  try
    if not ((Hashtbl.find !cfg.users user) = password) then
      raise Authentication_failed
  with Not_found -> raise Authentication_failed

let sweep_sessions () =
  let expired = 
    Hashtbl.fold
      (fun k (timestamp, timeout, _) l -> 
	 if (int_of_float ((gettimeofday ()) -. timestamp)) > timeout then
	   k :: l
	 else
	   l)
      sessions
      []
  in
    List.iter (fun k -> Hashtbl.remove sessions k) expired

let do_sweep time = 
  if (int_of_float (time -. !last_sweep)) > !cfg.sweep then
    (last_sweep := time;
     sweep_sessions ())

let put_session (user, password, timeout, key, session_data) =
  try
    authenticate user password;
    do_sweep (gettimeofday ());
    if not (Hashtbl.mem sessions key) then
      (Hashtbl.add sessions key (gettimeofday (), Int32.to_int timeout, session_data);
       code_success)
    else
      code_exists
  with 
      Authentication_failed -> code_authfail
    | _ -> code_error

let replace_session (user, password, timeout, key, session_data) =
  try
    Hashtbl.remove sessions key;
    put_session (user, password, timeout, key, session_data)
  with
      Authentication_failed -> code_authfail
    | _ -> code_error
  
let get_session (user, password, key) = 
  try
    let time = gettimeofday () in
      authenticate user password;
      do_sweep time;
      let (timestamp, timeout, session_data) = Hashtbl.find sessions key in
	if (int_of_float (time -. timestamp)) > timeout then
	  {result_code=code_timeout;serialized_data=""}
	else
	  (Hashtbl.replace sessions key (time, timeout, session_data);
	   {result_code=code_success;
	    serialized_data=session_data})
  with
      Not_found -> {result_code=code_notfound;serialized_data=""}
    | Authentication_failed -> {result_code=code_authfail;serialized_data=""}
    | _ -> {result_code=code_error;serialized_data=""}

let serv() =
  let esys = Unixqueue.create_unix_event_system() in
  let server =
    Wdstated_srv.Wdstated.V1.create_server
      ~proc_put_session: put_session
      ~proc_get_session: get_session
      ~proc_replace_session: replace_session
      Rpc_server.Portmapped
      Tcp
      Socket
      esys
  in

    List.iter
      (fun signal ->
	 Sys.set_signal 
         signal
	 (Sys.Signal_handle (fun _ -> Rpc_server.stop_server server;exit 0)))
      [ Sys.sigint; Sys.sigquit; Sys.sigterm ];

    Sys.set_signal
      Sys.sighup
      (Sys.Signal_handle (fun s -> cfg := getconfig !config_location));

    Sys.set_signal
      Sys.sigpipe
      Sys.Signal_ignore;

    (* ask the portmapper to allocate a port for us *)
    server_port := Rpc_portmapper.port_of_program 
      Wdstated_aux.program_Wdstated'V1 "localhost" Tcp;

    (* server loop *)
    try
      Unixqueue.run esys;
      Rpc_server.stop_server server
    with _ -> 
      try Rpc_server.stop_server server with _ -> ()          
;;

let main () = 
  while true
  do
    serv();
    sleep 1
  done

let _ = 
  if !fork_into_background then
    (close stdin;
     close stdout;
     close stderr;
     if fork () = 0 then
       main ()
     else
       exit 0)
  else
    main ()
;;