iop_ior.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,532 行 · 第 1/5 页

	    {'internal', Key, OrberDef, Flags, Module};
	Type == pseudo ->
	    {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
	atom(Key) ->
	    {'internal_registered', Key, OrberDef, Flags, Module}
    end;
get_key(What) ->
    orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR", 
	      [?LINE, What], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
    

get_key(#'IOP_IOR'{profiles=P}, Exclude)  ->
    get_key_1(P, true, 0, Exclude, #host_data{});
get_key(What, _Exclude) ->
    orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR", 
	      [?LINE, What], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).


get_key_1([], false, _, _, _)  ->
    orber:dbg("[~p] iop_ior:get_key_1([]); bad object reference, profile not found.", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
get_key_1([], true, _, _, _)  ->
    undefined;
%%--------- Local IIOP-1.0 Profile ---------
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_0'
	    {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_], 
	  _Retry, _Counter, _Exclude, _HD) ->
    if
	binary(Key) ->
	    {'internal', Key, OrberDef, Flags, Module};
	Type == pseudo ->
	    {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
	atom(Key) ->
	    {'internal_registered', Key, OrberDef, Flags, Module}
    end;
%%--------- Local IIOP-1.1 & IIOP-1.2 Profiles ---------
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_1'
	    {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_], 
	  _Retry, _Counter, _Exclude, _HD) ->
    if
	binary(Key) ->
	    {'internal', Key, OrberDef, Flags, Module};
	Type == pseudo ->
	    {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
	Type == passive ->
	    %% CHECK FOR PRIMARY COMPONENT & GROUPID! Better yet, do not.
	    %% This is internal key and is supposed to be well formed.
	    %% Also, internal keys are not searched for primary member or
	    %% groupid in the component-section of IOR. ObjectKey will tell
	    %% GroupID and database read transaction will tell primary member.
	    {'internal_registered', {passive, Key}, OrberDef, Flags, Module};
	atom(Key) ->
	    {'internal_registered', Key, OrberDef, Flags, Module}
    end;
%%--------- External IIOP-1.0 Profile ---------
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_0'
	    {host = Host, port = Port, object_key= ObjectKey}} = TP|P], 
	  _Retry, Counter, Exclude, HD) when Exclude == undefined ->
	    %% This case is "necessary" if an ORB adds several IIOP-profiles since,
	    %% for example, wchar isn't supported for 1.0.
    case get_key_1(P, true, Counter+1, Exclude, HD) of
	undefined ->
	    %% We now it's IIOP-1.0 and it doesn't contain any
	    %% components. Hence, no need to check for it.
	    {'external', {Host, Port, ObjectKey, Counter, TP, 
			  HD#host_data{version = {1,0}}}};
	LaterVersion ->
	    LaterVersion
    end;
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_0'
	    {host = Host, port = Port, object_key= ObjectKey}} = TP|P], 
	  Retry, Counter, Exclude, HD) ->
    case lists:member(Counter, Exclude) of
	true ->
	    get_key_1(P, Retry, Counter+1, Exclude, HD);
	false ->
	    %% This case is "necessary" if an ORB adds several IIOP-profiles since,
	    %% for example, wchar isn't supported for 1.0.
	    case get_key_1(P, true, Counter+1, Exclude, HD) of
		undefined ->
		    {'external', {Host, Port, ObjectKey, Counter, TP, 
				  HD#host_data{version = {1,0}}}};
		LaterVersion ->
		    LaterVersion
	    end
    end;
%%--------- External IIOP-1.1 & IIOP-1.2 Profiles ---------
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_1'
	    {iiop_version = #'IIOP_Version'{major=Major, minor=Minor}, 
	     host = Host, port = Port, object_key= ObjectKey, 
	     components = Components}} = TP|P], 
	      Retry, Counter, Exclude, HD) when Exclude == undefined ->
    case check_components(Components, Port, HD#host_data{version = {Major,Minor}}) of
	#host_data{csiv2_mech = undefined} when Port == 0 ->
	    get_key_1(P, Retry, Counter+1, Exclude, HD);
	NewHD ->
	    {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
    end;
get_key_1([#'IOP_TaggedProfile'
	   {tag=?TAG_INTERNET_IOP, 
	    profile_data=#'IIOP_ProfileBody_1_1'
	    {iiop_version = #'IIOP_Version'{major=Major, minor=Minor}, 
	     host = Host, port = Port, object_key= ObjectKey, 
	     components = Components}} = TP|P], 
	  Retry, Counter, Exclude, HD) ->
    case lists:member(Counter, Exclude) of
	true ->
	    get_key_1(P, Retry, Counter+1, Exclude, HD);
	false ->
	    case check_components(Components, Port,
				  HD#host_data{version = {Major,Minor}}) of
		#host_data{csiv2_mech = undefined} when Port == 0 ->
		    get_key_1(P, Retry, Counter+1, Exclude, HD);
		NewHD ->
		    {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
	    end
    end;
get_key_1([_ | P], Retry, Counter, Exclude, HD) ->
    get_key_1(P, Retry, Counter+1, Exclude, HD).

check_components([], _, HostData) ->
    HostData;
check_components([#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS, 
					 component_data=SSLStruct}|Rest], 
		       Port, HostData) when record(SSLStruct, 'SSLIOP_SSL') ->
    check_components(Rest, Port, HostData#host_data{protocol = ssl,
						    ssl_data = SSLStruct});
%% CSIv2 Components
check_components([#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST, 
					 component_data=Data}|Rest], 
		 Port, HostData) when record(Data, 'CSIIOP_CompoundSecMechList') ->
    case check_sec_mech(Data#'CSIIOP_CompoundSecMechList'.mechanism_list, Port) of
	undefined ->
	    check_components(Rest, Port, HostData);
	{ok, Protocol, Mech, Addresses} ->
	    check_components(Rest, Port, 
			     HostData#host_data
			     {protocol = Protocol,
			      csiv2_mech = Mech,
			      csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful,
			      csiv2_addresses = Addresses});
	{ok, Mech} ->
	    check_components(Rest, Port, 
			     HostData#host_data
			     {csiv2_mech = Mech,
			      csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful})
    end;
%% FT Components
check_components([#'IOP_TaggedComponent'
		  {tag=?TAG_FT_HEARTBEAT_ENABLED, 
		   component_data= 
		   #'FT_TagFTHeartbeatEnabledTaggedComponent'
		   {heartbeat_enabled = Boolean}}|Rest], 
		 Port, HostData) ->
    check_components(Rest, Port, HostData#host_data{ft_heartbeat = Boolean});
check_components([#'IOP_TaggedComponent'
		  {tag=?TAG_FT_PRIMARY,
		   component_data=
		   #'FT_TagFTPrimaryTaggedComponent'{primary = Boolean}}|Rest], 
		 Port, HostData) ->
    check_components(Rest, Port, HostData#host_data{ft_primary = Boolean});
check_components([#'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}}|Rest], 
		 Port, HostData) ->
    check_components(Rest, Port, HostData#host_data{ft_domain = FTDomain,
						    ft_group = GroupID,
						    ft_ref_version = GroupVer});
%% CodeSets Component
check_components([#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS, 
					 component_data=#'CONV_FRAME_CodeSetComponentInfo'
					 {'ForCharData' = Char,
					  'ForWcharData' = Wchar}}|Rest], 
		 Port, HostData) ->
    CharData = check_char_codeset(Char),
    WcharData = check_wchar_codeset(Wchar),
    check_components(Rest, Port, HostData#host_data{charset = CharData,
						    wcharset = WcharData});
%% Not used
check_components([_ | Rest], Port, HostData) ->
    check_components(Rest, Port, HostData).

check_sec_mech([], _) ->
    undefined;
%% Not supported yet.
%check_sec_mech([#'CSIIOP_CompoundSecMech'
%		{target_requires = TR,
%		 transport_mech=
%		 #'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS}} = Mech|_], 
%		Port) ->
%    {ok, seciop, Mech};
check_sec_mech([#'CSIIOP_CompoundSecMech'
		{target_requires = TR,
		 transport_mech= 
		 #'IOP_TaggedComponent'{tag = ?TAG_TLS_SEC_TRANS,
					component_data = CD}} = Mech|_], _Port)
  when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
    {ok, ssl, Mech, extract_host_port(CD#'CSIIOP_TLS_SEC_TRANS'.addresses, [])};
%% The TAG_NULL_TAG component shall be used in the 'transport_mech' field to
%% indicate that a mechanism does not implement security functionality at the
%% transport layer.
%% If the port field in TAG_INTERNET_IOP equals 0 we must find a TAG_TLS_SEC_TRANS
%% or TAG_SECIOP_SEC_TRANS mechanism.
check_sec_mech([#'CSIIOP_CompoundSecMech'
		{transport_mech= 
		 #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}}|Rest], 0) ->
    check_sec_mech(Rest, 0);
check_sec_mech([#'CSIIOP_CompoundSecMech'
		{target_requires = TR,
		 transport_mech= 
		 #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}} = Mech|_], _Port)
  when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
    {ok, Mech};
%% Unrecognized or the peer requires more than we support.
check_sec_mech([_ | Rest], Port) ->
    check_sec_mech(Rest, Port).

extract_host_port([], Acc) ->
    Acc;
extract_host_port([#'CSIIOP_TransportAddress'{host_name = Host, 
					      port = Port}|Rest], Acc) ->
    extract_host_port(Rest, [{Host, Port}|Acc]).


check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO8859_1_ID}) ->
    ?ISO8859_1_ID;
check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO646_IRV_ID}) ->
    ?ISO646_IRV_ID;
check_char_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
    %% Since the list of Converters usually is very short (0 or 1 element) we
    %% can use lists:member.
    case lists:member(?ISO8859_1_ID, Converters) of
	true ->
	    ?ISO8859_1_ID;
	false ->
	    %% Since we are 100% sure strings will be (e.g. IFR-ids) used we
	    %% can raise an exception at this point.
	    orber:dbg("[~p] iop_ior:check_char_codeset(~p);~n"
		      "Orber cannot communicate with this ORB.~n"
		      "It doesn't support a Char CodeSet known to Orber.", 
		      [?LINE, Converters], ?DEBUG_LEVEL),
	    corba:raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO})
    end.

check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UTF_16_ID}) ->
    ?UTF_16_ID;
check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UCS_2_ID}) ->
    ?UCS_2_ID;
check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
    case lists:member(?UTF_16_ID, Converters) of
	true ->
	    ?UTF_16_ID;
	false ->
	    %% We should not raise an exception here since we do not know if
	    %% wchar/wstring is used.
	    ?UTF_16_ID
%	    ?UNSUPPORTED_WCHAR
    end.


%%-----------------------------------------------------------------
%% Func: add_component/2
%%-----------------------------------------------------------------
add_component(Objref, Component) when record(Objref, 'IOP_IOR') ->
    add_component_ior(Objref, Component);
add_component(Objref, Component) ->
    add_component_local(Objref, Component, orber:giop_version()).

add_component_local(_, Component, {1,0}) ->
    orber:dbg("[~p] iop_ior:add_component(~p);~n"
	      "IIOP-1.0 objects cannot contain any components.", 
	      [?LINE, Component], ?DEBUG_LEVEL),
    corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
add_component_local(_, #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS} 
		    = Component, {1,1}) ->
    orber:dbg("[~p] iop_ior:add_component(~p);~n"
	      "IIOP-1.1 objects may not contain ALTERNATE_IIOP_ADDRESS components.", 
	      [?LINE, Component], ?DEBUG_LEVEL),
    corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
add_component_local({Mod, Type, Key, UserDef, OrberDef, Flags}, Component, Version) ->
    EnvFlags = orber:get_flags(),
    MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
	     true ->
		 [Component];
	     false ->
		 [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS, 
					 component_data=?DEFAULT_CODESETS},
		  Component]
	 end,
    case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of