(* $Id$ *)

let configure rpc_program_number cf addr : Cache_server.cache_instance =
  let get_param name =
    try cf # resolve_parameter addr name
    with Not_found ->
      failwith ("Missing parameter '" ^ name ^ "'") in

  let get_string_param name =
    cf # string_param (get_param name) in

  let get_int_param name =
    cf # int_param (get_param name) in

  let directory = get_string_param "cache_directory" in
  let max_size = Int64.of_int (get_int_param "cache_max_size") in
  let save_cache_period = get_int_param "save_cache_period" in
  let save_cache_speed = get_int_param "save_cache_speed" in

  let cconfig =
    ( object
	method directory = directory
	method max_size = max_size
	method save_cache_period = save_cache_period
	method save_cache_speed = save_cache_speed
	method rpc_program_number = rpc_program_number
      end
    ) in

  Cache_server.create cconfig
;;


let do_setup rpc_enable also_setup srv (cache : Cache_server.cache_instance) =
  if rpc_enable then
    Cache_server.bind srv cache;
  also_setup srv cache
;;


let hooks post_start_hook (cache : Cache_server.cache_instance) 
    : Netplex_types.processor_hooks =
  object
    inherit Netplex_kit.empty_processor_hooks()

    method post_start_hook cont =
      (* It is important that the cache is first activated in the 
         container process!
       *)
      Cache_server.activate cont#event_system cache;
      cont # log `Notice "Container started";
      post_start_hook cache cont

    method pre_finish_hook cont =
      cont # log `Notice "Container shut down";

    method receive_admin_message cont cmd args =
      match cmd with
	| "verify" ->
	    let log = cont # log `Notice in
	    Cache_server.verify log cache
	| "save" ->
	    Cache_server.save cache
	| _ ->
	    ()
  end
;;


let factory ?(post_start_hook = fun _ _ -> ()) 
            ?(setup = fun _ _ -> ()) 
	    ?(rpc_enable = true) 
            ?(rpc_program_number = 600l)
            ~name () =
  Rpc_netplex.rpc_factory
    ~configure:(configure rpc_program_number)
    ~setup:(do_setup rpc_enable setup)
    ~hooks:(hooks post_start_hook)
    ~name
    ()
;;