From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/orber/src/corba.erl | 2180 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2180 insertions(+) create mode 100644 lib/orber/src/corba.erl (limited to 'lib/orber/src/corba.erl') 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). + -- cgit v1.2.3