orber_cosnaming_utils.erl

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

file(File) ->
    {file, File}.

%%----------------------------------------------------------------------
%% Function   : ftp
%% Arguments  : A string describing connection parameters.
%% Description: 
%% Returns    : A tuple consisting of data extracted from the given string.
%%----------------------------------------------------------------------
ftp(Address) ->
    %% Perhaps we should run some checks here?
    {ftp, Address}.

%%----------------------------------------------------------------------
%% Function   : http
%% Arguments  : A string describing connection parameters.
%% Description: 
%% Returns    : A tuple consisting of data extracted from the given string.
%%----------------------------------------------------------------------
http(Address) ->
    case string:tokens(Address, ":") of
	[Host, Rest] ->
	    %% At his stage we know that address contains a Port number.
	    {Port, Key} = split_to_slash(Rest, []),
	    case catch list_to_integer(Port) of
		PortInt when integer(PortInt) ->
		    {http, Host, PortInt, Key};
		_ ->
		    orber:dbg("[~p] orber_cosnaming_utils:http(~p);~n"
			      "Malformed key; should be http://Host:Port/path/name.html~n"
			      "or http://Host/path/name.html", 
			      [?LINE, Address], ?DEBUG_LEVEL),
		    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
	    end;
	[Address] ->
	    %% Use default port
	    {Host, Key} = split_to_slash(Address, []),
	    {http, Host, ?HTTP_DEF_PORT, Key};
	_What ->
	    orber:dbg("[~p] orber_cosnaming_utils:http(~p);~n"
		      "Malformed key; should be http://Host:Port/path/name.html~n"
		      "or http://Host/path/name.html", 
		      [?LINE, Address], ?DEBUG_LEVEL),
	    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
    end.

split_to_slash([], _Acc) ->
    orber:dbg("[~p] orber_cosnaming_utils:split_to_slash();~n"
	      "No Key given Host:Port/Key.html", [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
split_to_slash([$/|Rest], Acc) ->
    {lists:reverse(Acc), [$/|Rest]};
split_to_slash([H|T], Acc) ->
    split_to_slash(T, [H|Acc]).

%%----------------------------------------------------------------------
%% Function   : lookup
%% Arguments  : A tuple which contain data about what connection we want to use.
%% Description: 
%% Returns    : Object |
%%              {'EXCEPTION', E}
%%----------------------------------------------------------------------
lookup(Data) ->
    lookup(Data, []).

lookup({corbaname, rir, _Key, []}, Ctx) ->
    %% If no object key supplied NameService is defined to be default.
    corba:resolve_initial_references("NameService", Ctx);
lookup({corbaname, rir, Key, Name}, Ctx) ->
    NS = corba:resolve_initial_references(Key, Ctx),
    'CosNaming_NamingContext':resolve(NS, Ctx, Name);

lookup({corbaloc, rir, Key}, Ctx) ->
     corba:resolve_initial_references(Key, Ctx);

lookup({corbaname, [], _Key, _Name}, _Ctx) ->
    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
lookup({corbaname, Addresses, Key, ""}, Ctx) ->
    %% Not Name-string defined, which is the same as corbaloc.
    lookup({corbaloc, Addresses, Key}, Ctx);
lookup({corbaname, [[iiop, Vers, Host, Port]|Addresses], Key, Name}, Ctx) ->
    NS = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key),
    case catch 'CosNaming_NamingContext':resolve(NS, Ctx, Name) of
	{'EXCEPTION', _} ->
	    lookup({corbaname, Addresses, Key, Name}, Ctx);
	Obj ->
	    Obj
    end;
lookup({corbaname, [_|Addresses], Key, Name}, Ctx) ->
    lookup({corbaname, Addresses, Key, Name}, Ctx);

lookup({corbaloc, [], _Key}, _Ctx) ->
    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
lookup({corbaloc, [[iiop, Vers, Host, Port]|Addresses], Key}, Ctx) ->
    ObjRef = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key),
    OldVal = put(orber_forward_notify, true),
    case catch corba_object:non_existent(ObjRef, Ctx) of
	{location_forward, Result} ->
	    put(orber_forward_notify, OldVal),
	    Result;
	false ->
	    put(orber_forward_notify, OldVal),
	    ObjRef;
	true ->
	    put(orber_forward_notify, OldVal),
	    lookup({corbaloc, Addresses, Key}, Ctx);
	_ ->
	    %% May be located on a version using '_not_existent'
            %% see CORBA2.3.1 page 15-34 try again.
	    case catch corba_object:not_existent(ObjRef, Ctx) of
		{location_forward, Result} ->
		    put(orber_forward_notify, OldVal),
		    Result;
		false ->
		    put(orber_forward_notify, OldVal),
		    ObjRef;
		_ ->
		    put(orber_forward_notify, OldVal),
		    lookup({corbaloc, Addresses, Key}, Ctx)
	    end
    end;
		
lookup({corbaloc, [_|Addresses], Key}, Ctx) ->
    lookup({corbaloc, Addresses, Key}, Ctx);
    

lookup({file, File}, _Ctx) ->
    case file:read_file(File) of
	{ok, IOR} ->
	    binary_to_list(IOR);
	{error, Reason} ->
	    orber:dbg("[~p] orber_cosnaming_utils:lookup(~p);~n"
		      "Failed to access file: ~p.", 
		      [?LINE, File, Reason], ?DEBUG_LEVEL),
	    corba:raise(#'CosNaming_NamingContext_InvalidName'{})
    end;
lookup({http, Host, Port, Key}, _Ctx) ->
    SetupTimeout = orber:iiop_setup_connection_timeout(),
    SendTimeout = orber:iiop_timeout(),
    {ok, Socket} = create_connection(Host, Port, SetupTimeout),
    Request = "GET " ++ Key ++ " HTTP/1.0\r\n\r\n",   
    case gen_tcp:send(Socket, Request) of
	ok ->
	    _HdrMSG = receive_msg(Socket, false, SendTimeout),
	    receive_msg(Socket, true, SendTimeout);
	{error, Reason} ->
	    orber:dbg("[~p] orber_cosnaming_utils:lookup();~n"
		      "Failed to send request: ~p.", 
		      [?LINE, Reason], ?DEBUG_LEVEL),
	    corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
    end;
lookup({ftp, _Address}, _Ctx) ->
    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
lookup(_, _Ctx) ->
    corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}).


receive_msg(Socket, Close, Timeout) ->
    receive 
	{tcp_closed, Socket} ->
	    orber:dbg("[~p] orber_cosnaming_utils:receive_msg();~n"
		      "HTTP-server closed connection.", [?LINE], ?DEBUG_LEVEL),
	    corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
	{tcp, Socket, Response} when Close == true ->
	    gen_tcp:close(Socket),
	    Response;
	{tcp, Socket, Response} ->
	    Response;
	{tcp_error, Socket, Reason} ->
	    orber:dbg("[~p] orber_cosnaming_utils:receive_msg();~n"
		      "connection failed: ~p.", 
		      [?LINE, Reason], ?DEBUG_LEVEL),
	    gen_tcp:close(Socket),
	    corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
    after Timeout ->
	    gen_tcp:close(Socket),
	    corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
    end.
   

create_connection(Host, Port, Timeout) ->
    case gen_tcp:connect(Host,Port,[{packet,0},{reuseaddr,true}], Timeout) of
	{ok,Socket} ->
	    {ok,Socket};
	Error ->
	    orber:dbg("[~p] orber_cosnaming_utils:create_connection(~p, ~p, ~p);~n"
		      "Reason: ~p", 
		      [?LINE, Host, Port, Timeout, Error], ?DEBUG_LEVEL),
	    corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
    end.

%%----------------------------------------------------------------------
%% Function   : key2id
%% Arguments  : An objectkey (e.g. NameService)
%% Description: 
%% Returns    : The associated IFR-id
%%----------------------------------------------------------------------
key2id(Key) ->
    %% We need this test to avoid returning an exit if an XX:typeID()
    %% fails (e.g. the module doesn't exist).
    case catch key2id_helper(Key) of
	{ok, Id} ->
	    Id;
	_ ->
	    ""
    end.


key2id_helper("NameService") -> 
    {ok, 'CosNaming_NamingContext':typeID()};
key2id_helper("RootPOA") -> 
    {ok, "IDL:omg.org/PortableServer/POA:1.0"};
key2id_helper("POACurrent") -> 
    {ok, "IDL:omg.org/PortableServer/Current:1.0"};
key2id_helper("InterfaceRepository") -> 
    {ok, "IDL:omg.org/CORBA/Repository:1.0"};
key2id_helper("TradingService") -> 
    {ok, "IDL:omg.org/CosTrading/Lookup:1.0"};
key2id_helper("TransactionCurrent") -> 
    {ok, "IDL:omg.org/CosTransactions/Current:1.0"};
key2id_helper("DynAnyFactory") -> 
    {ok, "IDL:omg.org/DynamicAny/DynAnyFactory:1.0"};
key2id_helper("ORBPolicyManager") -> 
    {ok, "IDL:omg.org/CORBA/PolicyManager:1.0"};
key2id_helper("PolicyCurrent") -> 
    {ok, "IDL:omg.org/CORBA/PolicyCurrent:1.0"};
key2id_helper("NotificationService") -> 
    {ok, 'CosNotifyChannelAdmin_EventChannelFactory':typeID()};
key2id_helper("TypedNotificationService") -> 
    {ok, "IDL:omg.org/CosTypedNotifyChannelAdmin::TypedEventChannelFactory:1.0"};
key2id_helper("CodecFactory") -> 
    {ok, "IDL:omg.org/IOP/CodecFactory:1.0"};
key2id_helper("PICurrent") -> 
    {ok, "IDL:omg.org/PortableInterceptors/Current:1.0"};
%% Should we use SecurityLevel1 instead?? This key can be either.
key2id_helper("SecurityCurrent") -> 
    {ok, "IDL:omg.org/SecurityLevel2/Current:1.0"};
%% Unknown - use the empty string. Might not work for all other ORB's but it's
%% the only option we've got.
key2id_helper(_) -> 
    {ok, ""}.
    


%%----------------------------------------------------------------------
%% Function   : name2string
%% Arguments  : A sequence of NameComponents
%% Description: 
%% Returns    : A string describing the sequence.
%%----------------------------------------------------------------------
name2string(Name) ->
    name2string(lists:reverse(Name), []).
name2string([], Acc) ->
    lists:flatten(Acc);
name2string([#'CosNaming_NameComponent'{id="", kind=""}], Acc) ->
    name2string([], [$.|Acc]);
name2string([#'CosNaming_NameComponent'{id=ID, kind=""}], Acc) ->
    name2string([], [convert_reserved(ID)|Acc]);
name2string([#'CosNaming_NameComponent'{id=ID, kind=Kind}], Acc) ->
    name2string([], [convert_reserved(ID), $., convert_reserved(Kind)|Acc]);
name2string([#'CosNaming_NameComponent'{id="", kind=""}|T], Acc) ->
    name2string(T, [$/, $.|Acc]);
name2string([#'CosNaming_NameComponent'{id=ID, kind=""}|T], Acc) ->
    name2string(T, [$/, convert_reserved(ID)|Acc]);
name2string([#'CosNaming_NameComponent'{id=ID, kind=Kind}|T], Acc) ->
    name2string(T, [$/, convert_reserved(ID), $., convert_reserved(Kind)|Acc]);
name2string(What, Acc) ->
    orber:dbg("[~p] orber_cosnaming_utils:name2string(~p)~n"
	      "Malformed NameComponent: ~p", 
	      [?LINE, Acc, What], ?DEBUG_LEVEL),
    corba:raise(#'CosNaming_NamingContext_InvalidName'{}).

%% '/' and '.' are reserved as separators but can be overridden by using '\'.
convert_reserved([]) ->
    [];
convert_reserved([$/|T]) ->
    [$\\, $/|convert_reserved(T)];
convert_reserved([$.|T]) ->
    [$\\, $.|convert_reserved(T)];
convert_reserved([$\\, H|T]) ->
    [$\\, H|convert_reserved(T)];
convert_reserved([H|T]) ->
    [H|convert_reserved(T)].


%%----------------------------------------------------------------------
%% Function   : string2name
%% Arguments  : A string describing a sequence of NameComponents.
%% Description: 
%% Returns    : A sequence of NameComponents
%%----------------------------------------------------------------------
string2name([]) ->
    [];
string2name(Str) ->
    {NC, Rest} = get_NC(id, Str, [], []),
    [NC|string2name(Rest)].
    
get_NC(id, [], ID, _Kind) ->
    {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=""}, []};
get_NC(kind, [], ID, Kind) ->
    {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=lists:reverse(Kind)}, []};
%% // is not allowed; must be /./
get_NC(id, [$/|_T], [], _) ->
    orber:dbg("[~p] orber_cosnaming_utils:get_NC();~n"
	      "'//' not allowed, use '/./'", [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'CosNaming_NamingContext_InvalidName'{});
get_NC(id, [$., $/|T], [], _) ->
    {#'CosNaming_NameComponent'{id="", kind=""}, T};
%% End of this ID/Kind; in this case kind eq. "".
get_NC(id, [$/|T], ID, _Kind) ->
    {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=""}, T};
get_NC(kind, [$/|T], ID, Kind) ->
    {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=lists:reverse(Kind)}, T};
%% ID exist but it's not allowed to write "id1./id2.kind2".
get_NC(id, [$., $/|_T], _, _) ->
    orber:dbg("[~p] orber_cosnaming_utils:get_NC();~n"
	      "'id1./id2.kind2' not allowed, use 'id1/id2.kind2'", 
	      [?LINE], ?DEBUG_LEVEL),
    corba:raise(#'CosNaming_NamingContext_InvalidName'{});
get_NC(id, [$\\, $., H|T], ID, Kind) ->
    get_NC(id, T, [H, $.|ID], Kind);
get_NC(id, [$\\, $/, H|T], ID, Kind) ->
    get_NC(id, T, [H, $/|ID], Kind);
get_NC(kind, [$\\, $., H|T], ID, Kind) ->
    get_NC(kind, T, ID, [H|Kind]);
get_NC(kind, [$\\, $/, H|T], ID, Kind) ->
    get_NC(kind, T, ID, [H|Kind]);
get_NC(id, [$.|T], ID, Kind) ->
    get_NC(kind, T, ID, Kind);
get_NC(id, [H|T], ID, Kind) ->
    get_NC(id, T, [H|ID], Kind);
get_NC(kind, [H|T], ID, Kind) ->
    get_NC(kind, T, ID, [H|Kind]);
get_NC(Type, Data, ID, Kind) ->
    orber:dbg("[~p] orber_cosnaming_utils:get_NC(~p, ~p, ~p, ~p);~n"
	      "Unknown", [?LINE, Type, Data, ID, Kind], ?DEBUG_LEVEL),
    corba:raise(#'CosNaming_NamingContext_InvalidName'{}).


%% Converts \< to '%3c' 
escape_string(Str) ->
    escape_string(Str, []).
escape_string([], Acc) ->
    lists:reverse(Acc);
escape_string([$\\, Char |T], Acc) ->
    escape_string(T, [code_character(16#0f band Char), 
		      code_character(16#0f band (Char bsr 4)),$%|Acc]);
escape_string([Char|T], Acc) ->
    escape_string(T, [Char|Acc]).


code_character(N) when N < 10 ->
    $0 + N;
code_character(N) ->
    $a + (N - 10).

%% Converts '%3c' to \<
unescape_string(Str) ->
    unescape_string(Str, []).
unescape_string([], Acc) ->    
    lists:reverse(Acc);
unescape_string([$%, H1, H2 |T], Acc) ->
    I1 = hex2int(H1),
    I2 = hex2int(H2),
    I = I1 * 16 + I2,
    unescape_string(T, [I, $\\|Acc]);
unescape_string([H|T], Acc) ->
    unescape_string(T, [H|Acc]).

hex2int(H) when H >= $a ->
    10 + H - $a;
hex2int(H) when H >= $A ->
    10 + H -$A;
hex2int(H) ->
    H - $0.

%%-------------------------- END OF MODULE -----------------------------