(* $Id: rpc_program.ml 1251 2009-05-29 01:57:46Z gerd $ * ---------------------------------------------------------------------- * *) (* The concept of RPC "programs" *) open Rtypes open Xdr module StringMap = Map.Make(String);; type t = { id_obj : < >; prog_nr : uint4; vers_nr : uint4; spec_ts : xdr_type_system; spec_procs : (uint4 * xdr_type_term * xdr_type_term) StringMap.t; spec_procs_validated : (uint4 * xdr_type * xdr_type) StringMap.t ref; null_proc : string option; } let create prognr versnr ts procs = let null = Rtypes.uint4_of_int 0 in let null_proc = try Some(fst(List.find (fun (_, (nr,_,_)) -> nr = null) procs)) with Not_found -> None in { id_obj = (object end); prog_nr = prognr; vers_nr = versnr; spec_ts = ts; spec_procs = List.fold_left (fun set (name,proc) -> StringMap.add name proc set) StringMap.empty procs; spec_procs_validated = ref StringMap.empty; null_proc = null_proc } let id p = Oo.id p.id_obj let update ?program_number ?version_number p = { p with prog_nr = ( match program_number with Some x -> x | None -> p.prog_nr ); vers_nr = ( match version_number with Some x -> x | None -> p.vers_nr ); } let program_number p = p.prog_nr let version_number p = p.vers_nr let null_proc_name p = p.null_proc let mutex = !Netsys_oothr.provider # create_mutex() let signature p procname = Netsys_oothr.serialize mutex (fun () -> try StringMap.find procname !(p.spec_procs_validated) with Not_found -> let (m,s,t) = StringMap.find procname p.spec_procs in let s_type = expanded_xdr_type p.spec_ts s in let t_type = expanded_xdr_type p.spec_ts t in p.spec_procs_validated := StringMap.add procname (m,s_type,t_type) !(p.spec_procs_validated); (m,s_type, t_type) ) () let procedure_number p procname = let (m,s,t) = StringMap.find procname p.spec_procs in m