aboutsummaryrefslogtreecommitdiffstats
path: root/lib/orber/src/corba.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/orber/src/corba.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/orber/src/corba.erl')
-rw-r--r--lib/orber/src/corba.erl2180
1 files changed, 2180 insertions, 0 deletions
diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl
new file mode 100644
index 0000000000..ea1363742c
--- /dev/null
+++ b/lib/orber/src/corba.erl
@@ -0,0 +1,2180 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File: corba.erl
+%%
+%% Description:
+%% This file contains the CORBA::ORB interface plus some
+%% Orber specific functions.
+%%-----------------------------------------------------------------
+-module(corba).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% Standard interface CORBA
+%%-----------------------------------------------------------------
+-export([orb_init/1, orb_init/2]).
+%%-----------------------------------------------------------------
+%% Standard interface CORBA::ORB
+%%-----------------------------------------------------------------
+-export([%create_list/2,
+ %create_operation_list/2,
+ %% get_default_context/1,
+ %% 'BOA_init/2,
+ resolve_initial_references/1,
+ resolve_initial_references/2,
+ resolve_initial_references_local/1,
+ list_initial_services/0,
+ add_initial_service/2,
+ remove_initial_service/1,
+ resolve_initial_references_remote/2,
+ resolve_initial_references_remote/3,
+ list_initial_services_remote/1,
+ list_initial_services_remote/2,
+ object_to_string/1, object_to_string/2,
+ object_to_string/3, object_to_string/4,
+ string_to_object/1,
+ string_to_object/2]).
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([create/2,
+ create/3,
+ create/4,
+ create_link/2,
+ create_link/3,
+ create_link/4,
+ create_remote/3,
+ create_remote/5,
+ create_link_remote/3,
+ create_link_remote/5,
+ create_nil_objref/0,
+ dispose/1,
+ create_subobject_key/2,
+ get_subobject_key/1,
+ get_pid/1,
+ raise/1, raise_with_state/2,
+ print_object/1,
+ print_object/2,
+ add_alternate_iiop_address/3,
+ add_FTGroup_component/4,
+ add_FTPrimary_component/1,
+ call_internal/10]).
+
+%%-----------------------------------------------------------------
+%% Internal (inside orber implementation) exports
+%%-----------------------------------------------------------------
+-export([call/4, call/5, reply/2,
+ cast/4, cast/5, locate/1, locate/2, locate/3,
+ request_from_iiop/6,
+ common_create/5,
+ mk_objkey/4,
+ mk_light_objkey/2,
+ objkey_to_string/1,
+ string_to_objkey/1,
+ string_to_objkey_local/1,
+ call_relay/3,
+ cast_relay/2,
+ handle_init/2,
+ handle_terminate/3,
+ handle_info/3,
+ handle_code_change/4,
+ handle_call/7,
+ handle_call/10,
+ handle_cast/9,
+ handle_cast/6,
+ get_implicit_context/1]).
+
+%%-----------------------------------------------------------------
+%% Internal definitions
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+-record(is, {flags = 0}).
+
+%% Defines possible configuration parameters a user can add when
+%% creating new CORBA objects.
+-record(options, {sup_child = false,
+ persistent = false,
+ regname = [],
+ pseudo = false,
+ object_flags = ?ORB_INIT_FLAGS,
+ object_flags_set = ?ORB_INIT_FLAGS,
+ create_options = [],
+ passive = false,
+ group_id = 0,
+ internal_state}).
+
+-record(extra, {timeout = infinity,
+ context = []}).
+
+
+%%--------------------------------------------------------------------
+%% FT stuff
+%%--------------------------------------------------------------------
+-define(IDL_MODULES, [oe_TimeBase,
+ oe_CosEventComm,
+ oe_CosEventChannelAdmin,
+ oe_CosNotification,
+ oe_CosNotifyComm,
+ oe_CosNotifyFilter,
+ oe_GIOP]).
+
+-define(groupid_to_table(Integer),
+ list_to_atom("ft_" ++ integer_to_list(Integer))).
+
+-define(RM_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_replication_manager)}]).
+-define(RO_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_replicated_object)}]).
+-define(RR_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_reply_retention)}]).
+
+%% how long we're allowed to wait for database tables to be available.
+-define(TABLE_TIMEOUT, infinite).
+
+%-record(rm_state, {default_options, type_options, node_port_ips}).
+
+%-record(node_port_ip, {node, port, ip}).
+
+-record(ft_replication_manager, {object_group_id,
+ type_id,
+ primary,
+ iogr,
+ ref_version,
+ options}).
+
+-record(ft_replicated_object, {group_id, state}).
+-record(ft_reply_retention, {retention_id, reply}).
+
+%-record(ft_properties, {replications_style,
+% membership_style,
+% consistency_style,
+% initial_number_replicas,
+% minimum_number_replicas}).
+
+% one should change things work with stdlib:proplist and clean up the mess.
+%-record(ft_criteria, {ft_properties,
+% object_location,
+% object_init,
+% object_impl}).
+
+%%------------------------------------------------------------
+%%
+%% Implementation of CORBA CORBA::ORB interfaces
+%%
+%%------------------------------------------------------------
+
+%%create_list(Count) ->
+%% corba_nvlist:create_list(Count).
+
+%%create_operation_list(OpDef) ->
+%% corba_nvlist:create_operation_list(OpDef).
+
+orb_init(KeyValueList) ->
+ orb_init(KeyValueList, "ORBER").
+
+orb_init([], _Name) ->
+ ok;
+orb_init(KeyValueList, _Name) ->
+ orber:multi_configure(KeyValueList).
+
+%%-----------------------------------------------------------------
+%% Initial reference handling
+%%-----------------------------------------------------------------
+resolve_initial_references(ObjectId) ->
+ resolve_initial_references(ObjectId, []).
+resolve_initial_references(ObjectId, Ctx) ->
+ case use_local_host(ObjectId) of
+ true ->
+ orber_initial_references:get(ObjectId);
+ Ref ->
+ string_to_object(Ref, Ctx)
+ end.
+
+resolve_initial_references_local(ObjectId) ->
+ orber_initial_references:get(ObjectId).
+
+list_initial_services() ->
+ Local = orber_initial_references:list(),
+ case orber:get_ORBInitRef() of
+ undefined ->
+ Local;
+ InitRef ->
+ orber_tb:unique(Local ++ get_prefixes(InitRef, []))
+ end.
+
+get_prefixes([], Acc) ->
+ Acc;
+%% A list of ORBInitRef's
+get_prefixes([H|T], Acc) when is_list(H) ->
+ [Key|_] = string:tokens(H, "="),
+ get_prefixes(T, [Key|Acc]);
+%% A single ORBInitRef
+get_prefixes(InitRef, _Acc) when is_list(InitRef) ->
+ [Key|_] = string:tokens(InitRef, "="),
+ [Key];
+get_prefixes(What, _) ->
+ orber:dbg("[~p] corba:get_prefixes(~p);~nMalformed argument?",
+ [?LINE, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+use_local_host(ObjectId) ->
+ case orber:get_ORBInitRef() of
+ undefined ->
+ case orber:get_ORBDefaultInitRef() of
+ undefined ->
+ true;
+ DefRef ->
+ DefRef++"/"++ObjectId
+ end;
+ InitRef ->
+ case check_prefixes(InitRef, ObjectId) of
+ false ->
+ case orber:get_ORBDefaultInitRef() of
+ undefined ->
+ true;
+ DefRef ->
+ DefRef++"/"++ObjectId
+ end;
+ UseRef ->
+ strip_junk(UseRef)
+ end
+ end.
+
+
+check_prefixes([], _) ->
+ false;
+%% A list of ORBInitRef's
+check_prefixes([H|T], ObjectId) when is_list(H) ->
+ case prefix(ObjectId, H) of
+ false ->
+ check_prefixes(T, ObjectId);
+ UseRef ->
+ UseRef
+ end;
+%% A single ORBInitRef
+check_prefixes(InitRef, ObjectId) when is_list(InitRef) ->
+ case prefix(ObjectId, InitRef) of
+ false ->
+ false;
+ UseRef ->
+ UseRef
+ end;
+check_prefixes(What,_) ->
+ orber:dbg("[~p] corba:check_prefixes(~p);~nMalformed argument?",
+ [?LINE, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%% Valid is, for example, "NameService = corbaloc::host/NameService".
+%% Hence, we must remove ' ' and '='.
+strip_junk([32|T]) ->
+ strip_junk(T);
+strip_junk([$=|T]) ->
+ strip_junk(T);
+strip_junk(Ref) ->
+ Ref.
+
+add_initial_service(ObjectId, ObjectRef) ->
+ orber_initial_references:add(ObjectId, ObjectRef).
+
+remove_initial_service(ObjectId) ->
+ orber_initial_references:remove(ObjectId).
+
+resolve_initial_references_remote(ObjectId, Address) ->
+ resolve_initial_references_remote(ObjectId, Address, []).
+
+resolve_initial_references_remote(_ObjectId, [], _Ctx) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+resolve_initial_references_remote(ObjectId, [RemoteModifier| Rest], Ctx)
+ when is_list(RemoteModifier) ->
+ case lists:prefix("iiop://", RemoteModifier) of
+ true ->
+ [_, Host, Port] = string:tokens(RemoteModifier, ":/"),
+ IOR = iop_ior:create_external(orber:giop_version(), "",
+ Host, list_to_integer(Port), "INIT"),
+ %% We know it's an external referens. Hence, no need to check.
+ {_, Key} = iop_ior:get_key(IOR),
+ orber_iiop:request(Key, 'get', [ObjectId],
+ {{'tk_objref', 12, "object"},
+ [{'tk_string', 0}],
+ []}, 'true', infinity, IOR, Ctx);
+ false ->
+ resolve_initial_references_remote(ObjectId, Rest, Ctx)
+ end.
+
+list_initial_services_remote(Address) ->
+ list_initial_services_remote(Address, []).
+
+list_initial_services_remote([], _Ctx) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+list_initial_services_remote([RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) ->
+ case lists:prefix("iiop://", RemoteModifier) of
+ true ->
+ [_, Host, Port] = string:tokens(RemoteModifier, ":/"),
+ IOR = iop_ior:create_external(orber:giop_version(), "",
+ Host, list_to_integer(Port), "INIT"),
+ %% We know it's an external referens. Hence, no need to check.
+ {_, Key} = iop_ior:get_key(IOR),
+ orber_iiop:request(Key, 'list', [],
+ {{'tk_sequence', {'tk_string',0},0},
+ [], []}, 'true', infinity, IOR, Ctx);
+ false ->
+ list_initial_services_remote(Rest, Ctx)
+ end;
+list_initial_services_remote(_, _) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+
+%%-----------------------------------------------------------------
+%% Objectreference convertions
+%%-----------------------------------------------------------------
+object_to_string(Object) ->
+ iop_ior:string_code(Object).
+
+object_to_string(Object, [H|_] = Hosts) when is_list(H) ->
+ iop_ior:string_code(Object, Hosts);
+object_to_string(_Object, _Hosts) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+object_to_string(Object, [H|_] = Hosts, Port) when is_list(H) andalso
+ is_integer(Port) ->
+ iop_ior:string_code(Object, Hosts, Port);
+object_to_string(_Object, _Hosts, _Port) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+object_to_string(Object, [H|_] = Hosts, Port, SSLPort) when is_list(H) andalso
+ is_integer(Port) andalso
+ is_integer(SSLPort)->
+ iop_ior:string_code(Object, Hosts, Port, SSLPort);
+object_to_string(_Object, _Hosts, _Port, _SSLPort) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+string_to_object(IORString) ->
+ string_to_object(IORString, []).
+
+string_to_object(IORString, Ctx) when is_list(Ctx) ->
+ case lists:prefix("IOR", IORString) of
+ true ->
+ {ObjRef, _, _} = iop_ior:string_decode(IORString),
+ ObjRef;
+ _ ->
+ %% CORBA-2.4 allows both IOR and ior prefix.
+ case lists:prefix("ior", IORString) of
+ true ->
+ {ObjRef, _, _} = iop_ior:string_decode(IORString),
+ ObjRef;
+ _ ->
+ Data = orber_cosnaming_utils:select_type(IORString),
+ case orber_cosnaming_utils:lookup(Data, Ctx) of
+ String when is_list(String) ->
+ {Obj, _, _} = iop_ior:string_decode(String),
+ Obj;
+ ObjRef ->
+ ObjRef
+ end
+ end
+ end;
+string_to_object(IORString, Ctx) ->
+ orber:dbg("[~p] corba:string_to_object(~p, ~p);~n"
+ "Failed to supply a context list.",
+ [?LINE, IORString, Ctx], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%------------------------------------------------------------
+%%
+%% Implementation of NON-standard functions
+%%
+%%------------------------------------------------------------
+create(Module, TypeID) ->
+ create(Module, TypeID, []).
+
+create(Module, TypeID, Env) ->
+ common_create(Module, TypeID, Env, [], 'start').
+
+create(Module, TypeID, Env, {Type, RegName}) ->
+ common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
+create(Module, TypeID, Env, Options) ->
+ common_create(Module, TypeID, Env, Options, 'start').
+
+
+create_link(Module, TypeID) ->
+ create_link(Module, TypeID, []).
+
+create_link(Module, TypeID, Env) ->
+ common_create(Module, TypeID, Env, [], 'start_link').
+
+create_link(Module, TypeID, Env, {Type, RegName}) ->
+ common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
+create_link(Module, TypeID, Env, Options) ->
+ common_create(Module, TypeID, Env, Options, 'start_link').
+
+
+create_remote(Node, Module, TypeID) ->
+ create_remote(Node, Module, TypeID, []).
+
+create_remote(Node, Module, TypeID, Env) ->
+ common_create_remote(Node, Module, TypeID, Env, [], 'start').
+
+create_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
+create_remote(Node, Module, TypeID, Env, Options) ->
+ common_create_remote(Node, Module, TypeID, Env, Options, 'start').
+
+
+create_link_remote(Node, Module, TypeID) ->
+ create_link_remote(Node, Module, TypeID, []).
+
+create_link_remote(Node, Module, TypeID, Env) ->
+ common_create_remote(Node, Module, TypeID, Env, [], 'start_link').
+
+create_link_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
+create_link_remote(Node, Module, TypeID, Env, Options) ->
+ common_create_remote(Node, Module, TypeID, Env, Options, 'start_link').
+
+common_create_remote(Node, Module, TypeID, Env, {Type, RegName}, StartMethod) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], StartMethod);
+common_create_remote(Node, Module, TypeID, Env, Options, StartMethod) ->
+ case node_check(Node) of
+ true ->
+ rpc:call(Node, corba, common_create, [Module, TypeID, Env, Options, StartMethod]);
+ _ ->
+ orber:dbg("[~p] corba:common_create_remote(~p);~n"
+ "Node not in current domain.", [?LINE, Node], ?DEBUG_LEVEL),
+ raise(#'OBJ_ADAPTER'{completion_status=?COMPLETED_NO})
+ end.
+
+node_check(Node) ->
+ lists:member(Node,orber:orber_nodes()).
+
+common_create(Module, _TypeID, Env, Options, StartMethod) when is_list(Options) ->
+ Opt = evaluate_options(Options, #options{}),
+ case Opt#options.regname of
+ [] ->
+ ok;
+ {'local', Atom} when is_atom(Atom) andalso Opt#options.persistent == false ->
+ ok;
+ {'global', _} ->
+ ok;
+ Why ->
+ orber:dbg("[~p] corba:common_create(~p, ~p);~n"
+ "Bad name type or combination(~p).",
+ [?LINE, Module, Options, Why], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end,
+ case Opt of
+ #options{pseudo = false, passive = false} ->
+ case gen_server:StartMethod(Module, {Opt#options.object_flags, Env},
+ Opt#options.create_options) of
+ {ok, Pid} ->
+ case catch mk_objkey(Module, Pid, Opt#options.regname,
+ Opt#options.persistent,
+ Opt#options.object_flags) of
+ {'EXCEPTION', E} ->
+ %% This branch is only used if we couldn't register
+ %% our new objectkey due to an internal error in orber.
+ gen_server:call(Pid, stop),
+ raise(E);
+ {'EXIT', _} ->
+ %% This branch takes care of exit values
+ %% which aren't expected (due to bug).
+ gen_server:call(Pid, stop),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO});
+ Objkey when Opt#options.sup_child == true ->
+ {ok, Pid, Objkey};
+ Objkey ->
+ Objkey
+ end;
+ X ->
+ X
+ end;
+ #options{pseudo = true, passive = false} ->
+ ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
+ case ModuleImpl:init(Env) of
+ {ok, State} ->
+ create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ State);
+ {ok, State,_} ->
+ create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ State);
+ Reason ->
+ orber:dbg("[~p] corba:common_create(~p);~n"
+ "'init' function incorrect(~p).",
+ [?LINE, ModuleImpl, Reason], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end;
+ #options{pseudo = false, passive = true} ->
+ ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
+ create_subobject_key(mk_passive_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ ?groupid_to_table(Opt#options.group_id));
+ What ->
+ orber:dbg("[~p] corba:common_create(~p, ~p);~n"
+ "not a boolean(~p).",
+ [?LINE, Module, Options, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : dispose
+%% Arguments : Object
+%% Returns :
+%% Description: Terminate the object represented by the supplied reference.
+%%----------------------------------------------------------------------
+dispose(?ORBER_NIL_OBJREF) ->
+ ok;
+dispose(Obj) ->
+ corba_boa:dispose(Obj).
+
+%%----------------------------------------------------------------------
+%% Function : create_nil_objref
+%% Arguments : -
+%% Returns : A NIL object reference
+%% Description:
+%%----------------------------------------------------------------------
+create_nil_objref() ->
+ ?ORBER_NIL_OBJREF.
+
+%%----------------------------------------------------------------------
+%% Function : create_subobject_key
+%% Arguments : A local object reference and an Erlang term().
+%% Returns : A new instance of the supplied reference with the
+%% sub-object field changed to the given value.
+%% Description: Initially, this field is set to 'undefined'
+%%----------------------------------------------------------------------
+create_subobject_key(Objkey, B) when is_binary(B) ->
+ iop_ior:set_privfield(Objkey, B);
+create_subobject_key(Objkey, T) ->
+ create_subobject_key(Objkey, term_to_binary(T)).
+
+%%----------------------------------------------------------------------
+%% Function : get_subobject_key
+%% Arguments : A local object reference
+%% Returns : Erlang term().
+%% Description: Return the value set by using create_subobject_key/2
+%%----------------------------------------------------------------------
+get_subobject_key(Objkey) ->
+ iop_ior:get_privfield(Objkey).
+
+%%----------------------------------------------------------------------
+%% Function : get_pid
+%% Arguments : A local object reference
+%% Returns : If the object is local and is associated with a pid, this
+%% pid is returned. Otherwise, external- or pseudo-object,
+%% an exception is raised.
+%% Description:
+%%----------------------------------------------------------------------
+get_pid(Objkey) ->
+ case iop_ior:get_key(Objkey) of
+ {'internal', Key, _, _, _} ->
+ orber_objectkeys:get_pid(Key);
+ {'internal_registered', Key, _, _, _} when is_atom(Key) ->
+ case whereis(Key) of
+ undefined ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ Pid ->
+ Pid
+ end;
+ R ->
+ orber:dbg("[~p] corba:get_pid(~p);~n"
+ "Probably a pseudo- or external object(~p).",
+ [?LINE, Objkey, R], ?DEBUG_LEVEL),
+ raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : raise
+%% Arguments : Local exception representation.
+%% Returns : Throws the exception.
+%% Description:
+%%----------------------------------------------------------------------
+raise(E) ->
+ throw({'EXCEPTION', E}).
+
+%%----------------------------------------------------------------------
+%% Function : raise_with_state
+%% Arguments : Local exception representation.
+%% Returns : Throws the exception.
+%% Description:
+%%----------------------------------------------------------------------
+raise_with_state(E, State) ->
+ throw({reply, {'EXCEPTION', E}, State}).
+
+%%----------------------------------------------------------------------
+%% Function : reply
+%% Arguments : To - pid
+%% Reply - Erlang term().
+%% Returns :
+%% Description: Used to reply to the invoker but still be able
+%% to do some more work in the callback module.
+%%----------------------------------------------------------------------
+reply(To, Reply) ->
+ gen_server:reply(To, Reply).
+
+%%----------------------------------------------------------------------
+%% Function : print_object
+%% Arguments : An object represented as one of the following:
+%% - local (tuple)
+%% - IOR
+%% - stringified IOR
+%% - corbaloc- or corbaname-schema
+%% IoDevice - the same as the io-module defines.
+%% Returns :
+%% Description: Prints the object's components and profiles.
+%%----------------------------------------------------------------------
+print_object(Object) ->
+ iop_ior:print(Object).
+print_object(Object, IoDevice) ->
+ iop_ior:print(IoDevice, Object).
+
+%%----------------------------------------------------------------------
+%% Function : add_alternate_iiop_address
+%% Arguments : Local object (tuple or IOR).
+%% IP - IP-string
+%% Port - integer().
+%% Returns : A local IOR with a TAG_ALTERNATE_IIOP_ADDRESS component.
+%% Description:
+%%----------------------------------------------------------------------
+add_alternate_iiop_address(Obj, Host, Port) when is_list(Host) andalso is_integer(Port) ->
+ TC = #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data = #'ALTERNATE_IIOP_ADDRESS'{
+ 'HostID' = Host,
+ 'Port' = Port}},
+ iop_ior:add_component(Obj, TC);
+add_alternate_iiop_address(_, Host, Port) ->
+ orber:dbg("[~p] corba:add_alternate_iiop_address(~p, ~p);~n"
+ "Incorrect argument(s). Host must be IP-string and Port an integer.",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%%----------------------------------------------------------------------
+%% Function : add_FTGroup_component
+%% Arguments : Local object (tuple or IOR).
+%% FTDomain - FT Domain. String().
+%% GroupID - Replicated object group's id. Integer(). (ulonglong)
+%% GroupVer - Object group's version number. Integer(). (ulong)
+%% Returns : A local IOR with one TAG_FT_GROUP component.
+%% Description:
+%%----------------------------------------------------------------------
+add_FTGroup_component(Obj, FTDomain, GroupID, GroupVer)
+ when is_list(FTDomain) andalso is_integer(GroupID) andalso is_integer(GroupVer) andalso
+ GroupID >= ?ULONGLONGMIN andalso GroupID =< ?ULONGLONGMAX andalso
+ GroupVer >= ?ULONGMIN andalso GroupVer =< ?ULONGMAX ->
+ TC = #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP,
+ component_data = #'FT_TagFTGroupTaggedComponent'{
+ version = #'GIOP_Version'{major = 1, minor = 0},
+ ft_domain_id = FTDomain,
+ object_group_id = GroupID,
+ object_group_ref_version = GroupVer}},
+ iop_ior:add_component(Obj, TC);
+add_FTGroup_component(_Obj, FTDomain, GroupID, GroupVer) ->
+ orber:dbg("[~p] corba:add_FTGroup_component(~p, ~p, ~p);~n"
+ "Incorrect argument(s).",
+ [?LINE, FTDomain, GroupID, GroupVer], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%%----------------------------------------------------------------------
+%% Function : add_FTPrimary_component
+%% Arguments : Local object (tuple or IOR).
+%% Returns : A local IOR with one TAG_FT_PRIMARY component.
+%% Description:
+%%----------------------------------------------------------------------
+add_FTPrimary_component(Obj) ->
+ TC = #'IOP_TaggedComponent'{
+ tag=?TAG_FT_PRIMARY,
+ component_data=#'FT_TagFTPrimaryTaggedComponent'{primary = true}},
+ iop_ior:add_component(Obj, TC).
+
+
+%%-----------------------------------------------------------------
+%% Generic functions for accessing the call-back modules (i.e. X_impl.erl).
+%% These functions are invoked by the generated stubs.
+%%-----------------------------------------------------------------
+handle_init(M, {Flags, Env}) ->
+ case M:init(Env) of
+ {ok, State} ->
+ {ok, {#is{flags = Flags}, State}};
+ {ok,State,Timeout} ->
+ {ok, {#is{flags = Flags}, State}, Timeout};
+ Other ->
+ %% E.g. ignore | {stop, Reason}
+ Other
+ end.
+
+
+handle_terminate(M, Reason, {_InternalState, State}) ->
+ catch (M:terminate(Reason, State)).
+
+handle_info(M, Info, {InternalState, State}) ->
+ case catch M:handle_info(Info, State) of
+ {noreply,NewState} ->
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true,
+ {M, handle_info}, [Info, State])
+ end.
+
+handle_code_change(M, OldVsn, {InternalState, State}, Extra) ->
+ {ok, NewState} = M:code_change(OldVsn, State, Extra),
+ {ok, {InternalState, NewState}}.
+
+
+%% This function handles call Pre- & Post-conditions.
+handle_call(M, F, A, {InternalState, State}, Ctx, This, From,
+ PreData, PostData, Stub) ->
+ CArgs = call_state(A, State, This, From),
+ case catch invoke_precond(PreData, Stub, F, CArgs) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, false, PreData, [Stub, F, CArgs]);
+ {'EXCEPTION', E} ->
+ {reply, {'EXCEPTION', E}, {InternalState, State}};
+ ok ->
+ Result = handle_call2(M, F, CArgs, InternalState, State, Ctx),
+ case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, false, PostData, A);
+ {'EXCEPTION', E} ->
+ {reply, {'EXCEPTION', E}, {InternalState, State}};
+ ok ->
+ Result
+ end
+ end.
+
+
+invoke_precond(false, _, _, _) ->
+ ok;
+invoke_precond({CondM, CondF}, Stub, F, CArgs) ->
+ CondM:CondF(Stub, F, CArgs).
+
+%% We must remove the Internal State before invoking post-cond.
+invoke_postcond(false, _, _, _, _) ->
+ ok;
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {reply, Reply, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}, Timeout}) ->
+ CondM:CondF(Stub, F, CArgs, {reply, Reply, NS, Timeout});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, Reply, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {stop, Reason, Reply, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {stop, Reason, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {noreply,NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}, Timeout}) ->
+ CondM:CondF(Stub, F, CArgs, {noreply, NS, Timeout});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, Result) ->
+ CondM:CondF(Stub, F, CArgs, Result).
+
+
+handle_call(M, F, A, {InternalState, State}, Ctx, This, From) ->
+ handle_call2(M, F, call_state(A, State, This, From), InternalState, State, Ctx).
+
+handle_call2(M, F, A, InternalState, State, []) ->
+ case catch apply(M, F, A) of
+ {reply, Reply, NewState} ->
+ {reply, add_context(Reply), {InternalState, NewState}};
+ {reply, Reply, NewState, Timeout} ->
+ {reply, add_context(Reply), {InternalState, NewState}, Timeout};
+ {stop, Reason, Reply, NewState} ->
+ {stop, Reason, add_context(Reply), {InternalState, NewState}};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {noreply,NewState} ->
+ {noreply,{InternalState, NewState}};
+ {noreply,NewState,Timeout} ->
+ {noreply,{InternalState, NewState},Timeout};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, false, {M, F}, A);
+ {'EXCEPTION', E} ->
+ {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
+ {Reply, NewState} ->
+ {reply, add_context(Reply), {InternalState, NewState}}
+ end;
+handle_call2(M, F, A, InternalState, State, Ctx) ->
+ %% Set the new Context.
+ put(oe_server_in_context, Ctx),
+ case catch apply(M, F, A) of
+ {reply, Reply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}};
+ {reply, Reply, NewState, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}, Timeout};
+ {stop, Reason, Reply, NewState} ->
+ {stop, Reason, add_context(Reply), {InternalState, NewState}};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {noreply,NewState} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}};
+ {noreply, {InternalState, NewState}, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState},Timeout};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, false, {M, F}, A);
+ {'EXCEPTION', E} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
+ {Reply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}}
+ end.
+
+call_state(A, State, false, false) ->
+ [State|A];
+call_state(A, State, false, From) ->
+ [From, State|A];
+call_state(A, State, This, false) ->
+ [This, State|A];
+call_state(A, State, This, From) ->
+ [This, From, State|A].
+
+cast_state(A, State, false) ->
+ [State|A];
+cast_state(A, State, This) ->
+ [This, State|A].
+
+add_context(Reply) ->
+ %% Reset oe_server_out_context
+ case put(oe_server_out_context, undefined) of
+ undefined ->
+ Reply;
+ _OutCtx ->
+ %% The previous value wasn't 'undefined', which means that
+ %% the server supplied a return context.
+ Reply
+ end.
+
+
+%% This function handles call Pre- & Post-conditions.
+handle_cast(M, F, A, {InternalState, State}, Ctx, This, PreData, PostData, Stub) ->
+ CArgs = cast_state(A, State, This),
+ case catch invoke_precond(PreData, Stub, F, CArgs) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true, PreData, [Stub, F, CArgs]);
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ ok ->
+ Result = handle_cast2(M, F, CArgs, InternalState, State, Ctx),
+ case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true, PostData, A);
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ ok ->
+ Result
+ end
+ end.
+
+
+handle_cast(M, F, A, {InternalState, State}, Ctx, This) ->
+ handle_cast2(M, F, cast_state(A, State, This), InternalState, State, Ctx).
+
+handle_cast2(M, F, A, InternalState, State, []) ->
+ case catch apply(M, F, A) of
+ {noreply, NewState} ->
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, true, {M, F}, A);
+ NewState ->
+ {noreply, {InternalState, NewState}}
+ end;
+handle_cast2(M, F, A, InternalState, State, Ctx) ->
+ put(oe_server_in_context, Ctx),
+ case catch apply(M, F, A) of
+ {noreply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXCEPTION', _} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, State}};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, true, {M, F}, A);
+ NewState ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}}
+ end.
+
+handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ case catch check_exports(M:module_info(exports), F) of
+ {'EXIT',{undef,_}} ->
+ %% No such module.
+ orber:dbg("~p.beam doesn't exist.~n"
+ "Check IC compile options (e.g. 'impl') and that the~n"
+ "beam-file is load-able.",
+ [M], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_MAYBE});
+ "" ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "Check spelling, export-attributes etc",
+ [M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_MAYBE});
+ Exports when is_list(Exports) ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p~s do exists.~nCheck export-attributes etc",
+ [M, F, length(A), M, F, Exports], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE});
+ _ ->
+ %% Should never happen
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+handle_exit(InternalState, State, {undef, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ case catch check_exports(M2:module_info(exports), F2) of
+ {'EXIT',{undef,_}} ->
+ %% No such module.
+ orber:dbg("~p.beam doesn't exist.~n"
+ "~p:~p/~p invoked an operation on the module above.~n"
+ "Check IC compile options and that the beam-file is load-able.",
+ [M2, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE});
+ "" ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p/~p invoked the operation above~n"
+ "Check spelling, export-attributes etc",
+ [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE});
+ Exports when is_list(Exports) ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p~s do exist(s).~nCheck export-attributes etc~n"
+ "~p:~p/~p invoked the operation above~n",
+ [M2, F2, length(A2), M2, F2, Exports, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_MAYBE});
+ _ ->
+ %% Should never happen
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+%% Misc errors. We separate between direct and in-direct errors. Due to different
+%% notation we must separate between different cases.
+handle_exit(InternalState, State, {{case_clause,_}, [{M, F, _}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'case_clause' error.",
+ [M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {Reason, [{M, F, _}|_]}, OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a '~p' error.",
+ [M, F, length(A), Reason], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {function_clause, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'function_clause' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {{case_clause,_}, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'case_clause' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, A2, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {Reason, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a '~p' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, A2, Reason, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, Reason, OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p(~p) ->~n"
+ " {EXIT, ~p}~n",
+ [M, F, A, Reason], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 10),
+ completion_status=?COMPLETED_MAYBE}).
+
+
+reply_after_exit(#is{flags = Flags} = InternalState, State,
+ Reason, OnewayOp, Exc) ->
+ case ?ORB_FLAG_TEST(Flags, ?ORB_SURVIVE_EXIT) of
+ false ->
+ exit(Reason);
+ true when OnewayOp == false ->
+ put(oe_server_in_context, undefined),
+ {reply, {'EXCEPTION', Exc}, {InternalState, State}};
+ true ->
+ %% One-way operation. Cannot return exception.
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, State}}
+ end.
+
+
+check_exports(Exports, Op) ->
+ check_exports(Exports, Op, []).
+
+check_exports([], _, Acc) ->
+ Acc;
+check_exports([{Op, Arity}|Rest], Op, Acc) ->
+ check_exports(Rest, Op, Acc ++ "/" ++ integer_to_list(Arity));
+check_exports([_|Rest], Op, Acc) ->
+ check_exports(Rest, Op, Acc).
+
+
+%%-----------------------------------------------------------------
+%% Corba:call - the function for reqests
+%%-----------------------------------------------------------------
+call(Obj, Func, Args, TypesOrMod) ->
+ call_helper(Obj, Func, Args, TypesOrMod, infinity, []).
+
+call(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
+ call_helper(Obj, Func, Args, TypesOrMod, infinity, Ctx);
+call(Obj, Func, Args, TypesOrMod, [{timeout, Timeout}]) ->
+ call_helper(Obj, Func, Args, TypesOrMod, Timeout, []);
+call(Obj, Func, Args, TypesOrMod, Extra) when is_list(Extra) ->
+ ExtraData = extract_extra_data(Extra, #extra{}),
+ call_helper(Obj, Func, Args, TypesOrMod, ExtraData#extra.timeout,
+ ExtraData#extra.context);
+call(Obj, Func, Args, TypesOrMod, Timeout) ->
+ call_helper(Obj, Func, Args, TypesOrMod, Timeout, []).
+
+call_helper(Obj, Func, Args, TypesOrMod, Timeout, InCtx) ->
+ Ctx = get_implicit_context(InCtx),
+ case iop_ior:get_key(Obj) of
+ {'internal', Key, _, Flags, Mod} ->
+ Pid = orber_objectkeys:get_pid(Key),
+ call_internal(Pid, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
+ {'internal_registered', Key, _, Flags, Mod} ->
+ call_internal(Key, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
+ {'external', Key} when is_atom(TypesOrMod) ->
+ case catch TypesOrMod:oe_tc(Func) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:call_helper(~p);~n"
+ "The call-back module does not exist or"
+ " incorrect IC-version used.~nReason: ~p",
+ [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ orber_iiop:request(Key, Func, Args, Types, 'true', Timeout, Obj, Ctx)
+ end;
+ {'external', Key} ->
+ orber_iiop:request(Key, Func, Args, TypesOrMod, 'true', Timeout, Obj, Ctx)
+ end.
+
+get_implicit_context([]) ->
+ case get(oe_server_in_context) of
+ undefined ->
+ [];
+ ImplCtx ->
+ ImplCtx
+ end;
+get_implicit_context(Ctx) ->
+ case get(oe_server_in_context) of
+ undefined ->
+ Ctx;
+ ImplCtx ->
+ %% Both defined. An explicit interface context overrides
+ %% an implicit.
+ case check_for_interface_ctx(Ctx) of
+ false ->
+ ImplCtx;
+ true ->
+ remove_interface_ctx(ImplCtx, Ctx)
+ end
+ end.
+
+check_for_interface_ctx([]) ->
+ false;
+check_for_interface_ctx([#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, _I}}|_]) ->
+ true;
+check_for_interface_ctx([_|T]) ->
+ check_for_interface_ctx(T).
+
+remove_interface_ctx([], Acc) ->
+ Acc;
+remove_interface_ctx([#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, _I}}|T], Acc) ->
+ remove_interface_ctx(T, Acc);
+remove_interface_ctx([H|T], Acc) ->
+ remove_interface_ctx(T, [H|Acc]).
+
+
+extract_extra_data([], ED) ->
+ ED;
+extract_extra_data([{context, Ctx}|T], ED) ->
+ extract_extra_data(T, ED#extra{context = Ctx});
+extract_extra_data([{timeout, Timeout}|T], ED) ->
+ extract_extra_data(T, ED#extra{timeout = Timeout}).
+
+call_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Timeout, Ctx)
+ when is_pid(Pid) andalso node(Pid) == node() ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case catch gen_server:call(Pid, {Obj, Ctx, Func, Args}, Timeout) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end;
+call_internal(Pid, Obj, Func, Args, Types, Check, PI,
+ _Mod, Timeout, Ctx) when is_pid(Pid) ->
+ typecheck_request(Check, Args, Types, Func),
+ case catch rpc:call(node(Pid), corba, call_relay,
+ [Pid, {Obj, Ctx, Func, Args}, Timeout]) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {badrpc, {'EXIT',R}} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {badrpc,nodedown} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~nNode ~p down.",
+ [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {badrpc, Reason} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Unable to invoke operation due to: ~p",
+ [?LINE, Func, Args, Types, Reason], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end;
+
+%% This case handles if the reference is created as a Pseudo object.
+%% Just call apply/3.
+call_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI,
+ _Mod, _Timeout, Ctx) ->
+ OldCtx = put(oe_server_in_context, Ctx),
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ State = binary_to_term(get_subobject_key(Obj)),
+ case catch apply(Module, Func, [Obj, State|Args]) of
+ {noreply, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {noreply, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {reply, Reply, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {reply, Reply, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {stop, _, Reply, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {stop, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {'EXCEPTION', E} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {'EXIT', What} ->
+ put(oe_server_in_context, OldCtx),
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Pseudo object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Unknown ->
+ put(oe_server_in_context, OldCtx),
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Pseudo object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc)
+ end;
+call_internal({passive, Module}, Obj, Func, Args, Types, Check, PI,
+ Mod, Timeout, Ctx) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ GroupID = binary_to_term(get_subobject_key(Obj)),
+ Transaction =
+ fun() ->
+ ObjectGroup = read_object_group(GroupID),
+ call_primary_protected(ObjectGroup, Module, Obj,
+ Func, Args, GroupID,
+ get_FTRequestCtx(Ctx))
+ end,
+ case mnesia:transaction(Transaction) of
+ {atomic, Reply} ->
+ %% this check should be inside transaction so that
+ %% failing typecheck_reply would result in transaction
+ %% abortion. Or not. call_internal(Registered...) does not
+ %% cancel the state transition even if the result isn't type compliant.
+ %% So, we do likewise.
+ typecheck_reply(Check, Reply, Mod, Func),
+ Reply;
+ {aborted, {not_primary, Primary, _}} ->
+ FTRequestCtx = mk_FTRequestCtx(10000000),
+ case rpc:call(Primary, corba, call_internal,
+ [{passive, Module}, Obj, Func, Args,
+ Types, Check, PI, Mod, Timeout,
+ [FTRequestCtx|Ctx]]) of
+ {badrpc, Reason} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); ~n"
+ " badrpc(~p).",
+ [?LINE, Func, Args, Types, Reason],?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=0,
+ completion_status=?COMPLETED_MAYBE});
+ %% one should keep trying request_duration_policy_value -time.
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ raise(E);
+ Reply ->
+ %% is this typecheck_reply neccessary? The check is made
+ %% on the remote node...
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Mod, Func),
+ Reply
+ %% generate RetentionID's and call Primary node with flag that tells
+ %% the node not to escalate rpc call's to next node if the primary
+ %% has changed again.
+ %% raise({not_primary, Primary});
+ end;
+ {aborted, {throw, {'EXCEPTION', E}}} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {aborted, {'EXIT', What}} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
+ "Passive object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {aborted, Unknown} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
+ "Passive object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc)
+ end;
+call_internal(Registered, Obj, Func, Args, Types, Check, PI,
+ _Mod, Timeout, Ctx) when is_atom(Registered)->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case whereis(Registered) of
+ undefined ->
+ Exc = #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ P ->
+ case catch gen_server:call(P, {Obj, Ctx, Func, Args}, Timeout) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p).~n"
+ "call exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end
+ end.
+
+invoke_pi_request(false, _Obj, _Ctx, _Func, _Args) ->
+ ok;
+invoke_pi_request(_, Obj, Ctx, Func, Args) ->
+ case orber:get_cached_interceptors() of
+ {native, PIs} ->
+ orber_pi:out_request(PIs, Obj, Ctx, Func, "localhost", Args);
+ _ ->
+ ok
+ end.
+
+invoke_pi_reply(false, _Obj, _Ctx, _Func, _Res) ->
+ ok;
+invoke_pi_reply(_, Obj, Ctx, Func, Res) ->
+ case orber:get_cached_interceptors() of
+ {native, PIs} ->
+ orber_pi:in_reply(PIs, Obj, Ctx, Func, "localhost", Res);
+ _ ->
+ ok
+ end.
+
+typecheck_request(false, _, _, _) ->
+ ok;
+typecheck_request(true, Args, Mod, Func) when is_atom(Mod) ->
+ case catch Mod:oe_tc(Func) of
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:typecheck_request(~p, ~p, ~p);~n"
+ "The call-back module does not exist or incorrect"
+ "IC-version used.~nReason: ~p",
+ [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ typecheck_request_helper(Types, Args, Mod, Func)
+ end;
+typecheck_request(true, Args, Types, Func) ->
+ typecheck_request_helper(Types, Args, Types, Func).
+
+typecheck_request_helper(Types, Args, Mod, Func) ->
+ case catch cdr_encode:validate_request_body(
+ #giop_env{version = {1,2}, tc = Types, parameters = Args,
+ host = orber:host(), iiop_port = orber:iiop_port(),
+ iiop_ssl_port = orber:iiop_ssl_port(),
+ domain = orber:domain(),
+ partial_security = orber:partial_security(),
+ flags = orber:get_flags()}) of
+ {'EXCEPTION', E} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========= Orber Typecheck Request =========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Arguments....: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), TC, Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'EXIT',R} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========= Orber Typecheck Request =========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Arguments....: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), TC, Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ _ ->
+ ok
+ end.
+
+typecheck_reply(true, Args, Mod, Func) when is_atom(Mod) ->
+ case catch Mod:oe_tc(Func) of
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:typecheck_reply(~p, ~p, ~p);~n"
+ "The call-back module does not exist or incorrect"
+ " IC-version used.~nReason: ~p",
+ [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ typecheck_reply_helper(Types, Args, Mod, Func)
+ end;
+typecheck_reply(true, Args, Types, Func) ->
+ typecheck_reply_helper(Types, Args, Types, Func);
+typecheck_reply(_, _, _, _) ->
+ ok.
+
+typecheck_reply_helper(Types, Args, Mod, Func) ->
+ case catch cdr_encode:validate_reply_body(
+ #giop_env{version = {1,2}, tc = Types,
+ host = orber:host(), iiop_port = orber:iiop_port(),
+ iiop_ssl_port = orber:iiop_ssl_port(),
+ domain = orber:domain(),
+ partial_security = orber:partial_security(),
+ flags = orber:get_flags()}, Args) of
+ {'tk_except', ExcType, ExcTC, {'EXCEPTION', E}} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Exception Type.: ~p~n"
+ "Typecode.......: ~p~n"
+ "Raised.........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'EXCEPTION', E} ->
+ {RetType, TC, OutParams} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Reply........: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'tk_except', ExcType, ExcTC, {'EXIT',R}} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Exception Type.: ~p~n"
+ "Typecode.......: ~p~n"
+ "Raised.........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT',R} ->
+ {RetType, TC, OutParams} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Typecode.......: ~p~n"
+ "Reply..........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ _ ->
+ ok
+ end.
+
+call_relay(Pid, Data, Timeout) ->
+ case whereis(orber_objkeyserver) of
+ undefined ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE});
+ _ ->
+ case catch gen_server:call(Pid, Data, Timeout) of
+ {'EXCEPTION', E} ->
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ raise(#'TIMEOUT'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p);~n"
+ "call exit(~p).", [?LINE, Data, R], ?DEBUG_LEVEL),
+ exit(R);
+ Res ->
+ Res
+ end
+ end.
+
+%%-----------------------------------------------------------------
+%% Corba:cast - the function for ONEWAY requests
+%%-----------------------------------------------------------------
+cast(Obj, Func, Args, TypesOrMod) ->
+ cast_helper(Obj, Func, Args, TypesOrMod, []).
+
+cast(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
+ cast_helper(Obj, Func, Args, TypesOrMod, Ctx).
+
+cast_helper(Obj, Func, Args, TypesOrMod, InCtx) ->
+ Ctx = get_implicit_context(InCtx),
+ case iop_ior:get_key(Obj) of
+ {'internal', Key, _, Flags, Mod} ->
+ Pid = orber_objectkeys:get_pid(Key),
+ cast_internal(Pid, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
+ {'internal_registered', Key, _, Flags, Mod} ->
+ cast_internal(Key, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
+ {'external', Key} when is_atom(TypesOrMod) ->
+ case catch TypesOrMod:oe_tc(Func) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:cast_helper(~p);~n"
+ "The call-back module does not exist or incorrect"
+ " IC-version used.~nReason: ~p",
+ [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ orber_iiop:request(Key, Func, Args, Types, 'false', infinity,
+ Obj, Ctx)
+ end;
+ {'external', Key} ->
+ orber_iiop:request(Key, Func, Args, TypesOrMod, 'false', infinity,
+ Obj, Ctx)
+ end.
+
+cast_internal(Pid, Obj, Func, Args, Types, Check, PI, _Mod, Ctx)
+ when is_pid(Pid) andalso node(Pid) == node() ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ catch gen_server:cast(Pid, {Obj, Ctx, Func, Args}),
+ ok;
+cast_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Ctx) when is_pid(Pid) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case catch rpc:call(node(Pid), corba, cast_relay, [Pid, {Obj, Ctx, Func, Args}]) of
+ {'EXCEPTION', E} ->
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {badrpc, {'EXIT', _R}} ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE});
+ {badrpc,nodedown} ->
+ orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~nNode ~p down.",
+ [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_NO});
+ Other ->
+ orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~n"
+ "Communication with node: ~p failed with reason: ~p.",
+ [?LINE, Func, Args, Types, node(Pid), Other], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+
+%% This case handles if the reference is created as a Pseudo object.
+%% Just call apply/3.
+cast_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
+ OldCtx = put(oe_server_in_context, Ctx),
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ State = binary_to_term(get_subobject_key(Obj)),
+ catch apply(Module, Func, [Obj, State|Args]),
+ put(oe_server_in_context, OldCtx),
+ ok;
+cast_internal(Registered, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case whereis(Registered) of
+ undefined ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ P ->
+ gen_server:cast(P, {Obj, Ctx, Func, Args})
+ end.
+
+cast_relay(Pid, Data) ->
+ case whereis(orber_objkeyserver) of
+ undefined ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO});
+ _ ->
+ gen_server:cast(Pid, Data)
+ end.
+
+%%-----------------------------------------------------------------
+%% Corba:locate - this function is for the moment just used for tests
+%%-----------------------------------------------------------------
+locate(Obj) ->
+ locate(Obj, infinity, []).
+
+locate(Obj, Timeout) ->
+ locate(Obj, Timeout, []).
+
+locate(Obj, Timeout, Ctx) ->
+ case iop_ior:get_key(Obj) of
+ {'external', Key} ->
+ orber_iiop:locate(Key, Timeout, Obj, Ctx);
+ _ ->
+ orber_objectkeys:check(iop_ior:get_objkey(Obj))
+ end.
+
+%%-----------------------------------------------------------------
+%% Incomming request from iiop
+%%-----------------------------------------------------------------
+%% Operations which do not allow object invokation.
+request_from_iiop(Obj, '_is_a', [Args], _, _, _) ->
+ catch corba_object:is_a(Obj, Args);
+%% First the OMG specified this operation to be '_not_existent' and then
+%% changed it to '_non_existent' without suggesting that both must be supported.
+%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999
+request_from_iiop(Obj, '_not_existent', _, _, _, _) ->
+ catch corba_object:non_existent(Obj);
+request_from_iiop(Obj, '_non_existent', _, _, _, _) ->
+ catch corba_object:non_existent(Obj);
+request_from_iiop(_, '_FT_HB', _, _, _, _) ->
+ ok;
+
+%% "Ordinary" operations.
+request_from_iiop({Mod, _, _, _, _, _}, oe_get_interface,
+ _, _, _, _ServiceCtx) when is_atom(Mod) ->
+ case catch Mod:oe_get_interface() of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p);~n"
+ "The call-back module does not exist or"
+ " incorrect IC-version used.~nReason: ~p",
+ [?LINE, Mod, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO}};
+ undefined ->
+ {'EXCEPTION', #'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status='COMPLETED_NO'}};
+ Interface ->
+ Interface
+ end;
+request_from_iiop({_Mod, pseudo, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, ResponseExpected, _ServiceCtx) ->
+ State = binary_to_term(get_subobject_key(ObjRef)),
+ case ResponseExpected of
+ true ->
+ case catch apply(Module, Func, [ObjRef, State|Args]) of
+ {noreply, _} ->
+ ok;
+ {noreply, _, _} ->
+ ok;
+ {reply, Reply, _} ->
+ Reply;
+ {reply, Reply, _, _} ->
+ Reply;
+ {stop, _, Reply, _} ->
+ Reply;
+ {stop, _, _} ->
+ ok;
+ {'EXCEPTION', E} ->
+ {'EXCEPTION', E};
+ {'EXIT', {undef, _}} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "The call-back module does not exist.",
+ [?LINE, Func, Args, Types], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO}};
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "Pseudo object exit(~p).~n"
+ "The call-back module probably contain an error.",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Unknown ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "Pseudo object failed(~p);~n"
+ "Confirm that the return value is correct"
+ " (e.g. {reply, Reply, State})",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE}}
+ end;
+ false ->
+ catch apply(Module, Func, [ObjRef, State|Args]),
+ ok;
+ true_oneway ->
+ catch apply(Module, Func, [ObjRef, State|Args]),
+ ok
+ end;
+% FOR PASSIVE REPLICATION! (Response IS expected --- one way semantics doesn't
+% really mix with intentions to be consistent & fault tolerant.)
+request_from_iiop({_Mod, passive, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, true, Ctx) ->
+ GroupID = binary_to_term(get_subobject_key(ObjRef)),
+ FTGroupVersionCtx = get_FTGroupVersionCtx(Ctx),
+ Transaction =
+ fun() ->
+ ObjectGroup = read_object_group(GroupID),
+ check_version_context(ObjectGroup,
+ FTGroupVersionCtx),
+ call_primary_protected(ObjectGroup,
+ Module,
+ ObjRef,
+ Func,
+ Args,
+ GroupID,
+ get_FTRequestCtx(Ctx))
+ end,
+ case mnesia:transaction(Transaction) of
+ {atomic, Reply} ->
+ Reply;
+ {aborted, {too_old_reference, IOGR}} ->
+ {oe_location_forward_perm, IOGR};
+ {aborted, {not_primary, _Primary, IOGR}} ->
+ case FTGroupVersionCtx of
+ [] ->
+ {oe_location_forward_perm, IOGR};
+ _ ->
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status = ?COMPLETED_NO}}
+ end;
+ {aborted, {throw, {'EXCEPTION', E}}} ->
+ {'EXCEPTION', E};
+ {aborted, {'EXIT', What}} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
+ "Passive object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status=?COMPLETED_MAYBE}};
+ {aborted, Unknown} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
+ "Passive object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status=?COMPLETED_MAYBE}}
+ end;
+request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, true, _ServiceCtx) ->
+ case catch gen_server:call(convert_key_to_pid(Key),
+ {ObjRef, [], Func, Args}, infinity) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "gen_server:call exit: ~p",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Result ->
+ Result
+ end;
+request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, _, _ServiceCtx) ->
+ case catch gen_server:cast(convert_key_to_pid(Key),
+ {ObjRef, [], Func, Args}) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "gen_server:cast exit: ~p",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Result ->
+ Result
+ end.
+
+%%------------------------------------------------------------
+%% Internal stuff
+%%------------------------------------------------------------
+
+convert_key_to_pid(Key) when is_binary(Key) ->
+ orber_objectkeys:get_pid(Key);
+convert_key_to_pid(Name) when is_atom(Name) ->
+ Name.
+
+mk_objkey(Mod, Pid, RegName, Persistent) ->
+ mk_objkey(Mod, Pid, RegName, Persistent, 0).
+
+mk_objkey(Mod, Pid, [], _, Flags) when is_pid(Pid) ->
+ Key = make_objkey(),
+ case orber_objectkeys:register(Key, Pid, false) of
+ ok ->
+ {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p);~n"
+ "unable to store key(~p).", [?LINE, Mod, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end;
+mk_objkey(Mod, Pid, {'global', RegName}, Persitent, Flags) when is_pid(Pid) ->
+ Key = term_to_binary(RegName),
+ case orber_objectkeys:register(Key, Pid, Persitent) of
+ ok ->
+ {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
+ "unable to store key(~p).",
+ [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end;
+mk_objkey(Mod, Pid, {'local', RegName}, Persistent, Flags) when is_pid(Pid) andalso is_atom(RegName) ->
+ register(RegName, Pid),
+ Key = make_objkey(),
+ case orber_objectkeys:register(Key, Pid, Persistent) of
+ ok ->
+ {Mod, 'registered', RegName, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
+ "unable to store key(~p).",
+ [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end.
+
+
+mk_light_objkey(Mod, RegName) ->
+ {Mod, 'registered', RegName, term_to_binary(undefined), 0, 0}.
+
+mk_pseudo_objkey(Mod, Module, Flags) ->
+ {Mod, 'pseudo', Module, term_to_binary(undefined), 0, Flags}.
+
+mk_passive_objkey(Mod, Module, Flags) ->
+ {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}.
+
+make_objkey() ->
+ term_to_binary({now(), node()}).
+
+objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) ->
+ "INIT";
+objkey_to_string({Mod, Type, Key, UserDef, OrberDef, Flags}) ->
+ orber:domain() ++ [ 7 | binary_to_list(term_to_binary({Mod, Type, Key, UserDef, OrberDef, Flags}))];
+objkey_to_string(External_object_key) ->
+ External_object_key.
+
+string_to_objkey("INIT") ->
+ {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
+string_to_objkey(String) ->
+ case prefix(orber:domain(), String) of
+ [7 | Rest] ->
+ binary_to_term(list_to_binary(Rest));
+ _ ->
+ String
+ end.
+%% This function may only be used when we know it's a local reference (i.e. target
+%% key in a request; IOR's passed as argument or reply doesn't qualify)!
+string_to_objkey_local("INIT") ->
+ {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
+string_to_objkey_local(String) ->
+ case prefix(orber:domain(), String) of
+ [7 | Rest] ->
+ binary_to_term(list_to_binary(Rest));
+ _ ->
+ case resolve_initial_references(String) of
+ ?ORBER_NIL_OBJREF ->
+ orber:dbg("[~p] corba:string_to_objkey_local(~p);~n"
+ "Invalid ObjektKey.", [?LINE, String], ?DEBUG_LEVEL),
+ ?ORBER_NIL_OBJREF;
+ Object ->
+ {location_forward, Object}
+ end
+ end.
+
+prefix([], L2) ->
+ L2;
+prefix([E |L1], [E | L2]) ->
+ prefix(L1, L2);
+prefix(_, _) ->
+ false.
+
+
+evaluate_options([], Options) ->
+ GlobalFlags = orber:get_flags(),
+ Options2 = check_flag(Options, ?ORB_TYPECHECK,
+ ?ORB_ENV_LOCAL_TYPECHECKING, GlobalFlags),
+ Options3 = check_flag(Options2, ?ORB_USE_PI, ?ORB_ENV_USE_PI, GlobalFlags),
+ check_flag(Options3, ?ORB_SURVIVE_EXIT, ?ORB_ENV_SURVIVE_EXIT, GlobalFlags);
+%% Pseudo or not.
+evaluate_options([{pseudo, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{pseudo, true}|Rest], #options{passive = false} = Options) ->
+ evaluate_options(Rest, Options#options{pseudo = true});
+%% FT stuff
+evaluate_options([{passive, true}|Rest], #options{pseudo = false} = Options) ->
+ evaluate_options(Rest, Options#options{passive = true});
+evaluate_options([{group_id, ID}|Rest], Options) when is_integer(ID) ->
+ evaluate_options(Rest, Options#options{group_id = ID});
+%% Options accepted by gen_server (e.g. dbg).
+evaluate_options([{create_options, COpt}|Rest], Options) when is_list(COpt) ->
+ evaluate_options(Rest, Options#options{create_options = COpt});
+%% When starting object as supervisor child.
+evaluate_options([{sup_child, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{sup_child, true}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{sup_child = true});
+%% Persistent object-key
+evaluate_options([{persistent, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{persistent, true}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{persistent = true});
+evaluate_options([{regname, []}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{regname, Name}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{regname = Name});
+evaluate_options([{survive_exit, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_SURVIVE_EXIT bor FlagsSet)});
+evaluate_options([{survive_exit, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags =
+ (?ORB_SURVIVE_EXIT bor Flags),
+ object_flags_set =
+ (?ORB_SURVIVE_EXIT bor FlagsSet)});
+evaluate_options([{local_typecheck, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_TYPECHECK bor FlagsSet)});
+evaluate_options([{local_typecheck, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_TYPECHECK bor Flags),
+ object_flags_set =
+ (?ORB_TYPECHECK bor FlagsSet)});
+evaluate_options([{local_interceptors, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_USE_PI bor FlagsSet)});
+evaluate_options([{local_interceptors, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_USE_PI bor Flags),
+ object_flags_set =
+ (?ORB_USE_PI bor FlagsSet)});
+%% Temporary option.
+evaluate_options([{no_security, true}|Rest],
+ #options{object_flags = Flags} = Options) ->
+ %% We do not allow this option to be set globally.
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_NO_SECURITY bor Flags)});
+evaluate_options([{no_security, false}|Rest], Options) ->
+ %% We do not allow this option to be set globally.
+ evaluate_options(Rest, Options);
+evaluate_options([{Key, Value}|_], _) ->
+ orber:dbg("[~p] corba:evaluate_options(~p, ~p);~n"
+ "Option not recognized, illegal value or combination.~n"
+ "Allowed settings:~n"
+ "survive_exit.......: boolean()~n"
+ "sup_child..........: boolean()~n"
+ "persistent.........: boolean()~n"
+ "pseudo.............: boolean()~n"
+ "local_typecheck....: boolean()~n"
+ "local_interceptors.: boolean()~n"
+ "regname............: {local, atom()} | {global, term()}",
+ [?LINE, Key, Value], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+check_flag(#options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options, Flag,
+ FlagConstant, GlobalFlags) ->
+ %% Option activated/deactived by a supplied option.
+ case ?ORB_FLAG_TEST(FlagsSet, Flag) of
+ true ->
+ Options;
+ false ->
+ %% Not the above. Globally defined?
+ case ?ORB_FLAG_TEST(GlobalFlags, FlagConstant) of
+ true ->
+ Options#options{object_flags = (Flag bor Flags)};
+ false ->
+ Options
+ end
+ end.
+
+%%%%%%%%%%%%%%%%% FOR PASSIVE REPLICATION!
+% Note should be called inside transaction. Does not catch exceptions.
+% let's not allow corba:reply from transaction... (no {noreply, ...} messages)
+% should the object be able to stop itself by returning {stop, ...}?
+% how about corba:dispose then? Deleting table representing object group and
+% corresponding entry in ft_replication_manager -table might just do the job?
+% No {stop, ...} messages for now
+% Exceptions falls through. They are expected to be caught by transaction in a
+% form of {aborted, {throw, {'EXCEPTION', ...}}}
+call_passive(Module, Obj, Func, Args, GroupID) ->
+ [Record] = mnesia:read(ft_replicated_object, GroupID, sticky_write),
+ State = Record#ft_replicated_object.state,
+
+ case apply(Module, Func, [Obj, State|Args]) of
+ {reply, Reply, NewState} ->
+ {Reply, NewState};
+ {reply, Reply, NewState, _} ->
+ {Reply, NewState}
+ end,
+ mnesia:write(ft_replicated_object,
+ #ft_replicated_object{group_id = GroupID, state = NewState},
+ sticky_write),
+ Reply.
+
+
+
+% FTRequestCtx protected object call
+% One should protect agains aged reply. If expirations_time is reached and
+% request is retransmitted, one might return BAD_CONTEXT -exception!
+call_RQprotected(Module, Obj, Func, Args, GroupID, RQCtx) ->
+ case mnesia:read(ft_reply_retention, RQCtx, sticky_write) of
+ % fresh request
+ [] ->
+ Reply = call_passive(Module, Obj, Func, Args, GroupID),
+ mnesia:write(ft_reply_retention,
+ #ft_reply_retention{retention_id= RQCtx,reply= Reply},
+ sticky_write),
+ Reply;
+ % retransmitted request
+ #ft_reply_retention{reply = Reply} ->
+ Reply
+ end.
+
+
+
+% call_primary_protected. Protects agains calling non-primary node.
+% normal case, without FTRequest Service Context
+call_primary_protected(#ft_replication_manager{primary = Primary},
+ Module,
+ Obj,
+ Func,
+ Args,
+ GroupID,
+ []) when Primary == node() ->
+ call_passive(Module, Obj, Func, Args, GroupID);
+% normal case, with FTRequest Service Context
+call_primary_protected(#ft_replication_manager{primary = Primary},
+ Module,
+ Obj,
+ Func,
+ Args,
+ GroupID,
+ RetentionID) when Primary == node() ->
+ call_RQprotected(Module, Obj, Func, Args, GroupID, RetentionID);
+% case where primary resides in another node
+call_primary_protected(#ft_replication_manager{primary = Primary,
+ iogr = IOGR},
+ _Module, _Obj, _Func, _Args, _GroupID, _) ->
+ mnesia:abort({not_primary, Primary, IOGR}).
+
+
+
+% no context
+check_version_context(_, []) ->
+ ok;
+% client's IOGR is current.
+check_version_context(#ft_replication_manager{ref_version = CurrentVer},
+ GroupVer) when CurrentVer == GroupVer ->
+ ok;
+% client's IOGR is old.
+check_version_context(#ft_replication_manager{ref_version = CurrentVer,
+ iogr = IOGR},
+ GroupVer) when CurrentVer > GroupVer ->
+ mnesia:abort({too_old_reference, IOGR});
+% client's IOGR is too new!
+check_version_context(#ft_replication_manager{ref_version = CurrentVer},
+ GroupVer) when CurrentVer < GroupVer ->
+ raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO}).
+
+
+
+read_object_group(GroupID) ->
+ case mnesia:read({ft_replication_manager, GroupID}) of
+ [] ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status = ?COMPLETED_NO});
+ [ObjectGroup] ->
+ ObjectGroup
+ end.
+
+
+
+mk_FTRequestCtx(Expiration_time) ->
+ #'FT_FTRequestServiceContext'{
+ client_id = atom_to_list(node()),
+ retention_id = orber_request_number:get(),
+ expiration_time = Expiration_time}.
+
+
+
+get_FTRequestCtx([#'FT_FTRequestServiceContext'
+ {client_id = Client_ID, retention_id = Retention_ID,
+ expiration_time = Expiration_time}|_Ctxs]) ->
+ {Client_ID, Retention_ID, Expiration_time};
+get_FTRequestCtx([]) ->
+ [];
+get_FTRequestCtx([_Ctx|Ctxs]) ->
+ get_FTRequestCtx(Ctxs).
+
+
+
+get_FTGroupVersionCtx([#'FT_FTGroupVersionServiceContext'
+ {object_group_ref_version = Version}|_Ctxs]) ->
+ Version;
+get_FTGroupVersionCtx([]) ->
+ [];
+get_FTGroupVersionCtx([_Ctx|Ctxs]) ->
+ get_FTGroupVersionCtx(Ctxs).
+