%%--------------------------------------------------------------------
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1999-2013. 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: orber_cosnaming_utils.erl
%% Modified:
%%
%%-----------------------------------------------------------------
-module(orber_cosnaming_utils).
-include("orber_cosnaming.hrl").
-include("CosNaming.hrl").
-include("CosNaming_NamingContext.hrl").
-include("CosNaming_NamingContextExt.hrl").
-include_lib("orber/include/corba.hrl").
-include_lib("orber/src/orber_iiop.hrl").
%%-----------------------------------------------------------------
%% External exports
%%-----------------------------------------------------------------
-export([query_result/1]).
%%-----------------------------------------------------------------
%% Internal exports
%%-----------------------------------------------------------------
-export([addresses/1, name/1,
check_addresses/1, check_name/1,
key/1, select_type/1, lookup/1, lookup/2,
escape_string/1, unescape_string/1,
name2string/1, string2name/1]).
%%-----------------------------------------------------------------
%% Records
%%-----------------------------------------------------------------
%%-----------------------------------------------------------------
%% Defines
%%-----------------------------------------------------------------
%% DEFAULT VALUES:
%%
%% IIOP:
%% - port: 2809
%% - iiop version: 1.0
-define(DEF_VERS, {1,0}).
-define(DEF_PORT, 2809).
-define(DEF_KEY, "NameService").
-define(HTTP_DEF_PORT, 80).
%% DEBUG INFO
-define(DEBUG_LEVEL, 5).
%%-----------------------------------------------------------------
%% External interface functions
%%-----------------------------------------------------------------
%% Check a read transaction
query_result({atomic, Qres}) ->
case Qres of
[Hres] ->
Hres#orber_CosNaming.nameindex;
[Hres|Tres] ->
orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
"Multiple Hits: ~p", [?LINE, Qres, [Hres|Tres]], ?DEBUG_LEVEL),
error;
[] ->
orber:dbg("[~p] orber_cosnaming_utils:query_result();~n"
"No hit", [?LINE], ?DEBUG_LEVEL),
error;
Other ->
orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
"Mnesia Access Failed ~p", [?LINE, Qres, Other], ?DEBUG_LEVEL),
error
end;
query_result({aborted, Qres}) ->
orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
"Mnesia Access Aborted", [?LINE, Qres], ?DEBUG_LEVEL),
error;
query_result(What) ->
orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
"Mnesia Access Failed", [?LINE, What], ?DEBUG_LEVEL),
error.
%%----------------------------------------------------------------------
%% Function : check_addresses
%% Arguments :
%% Description:
%% Returns :
%%----------------------------------------------------------------------
check_addresses(Str) ->
{_, Rest2} = addresses(Str),
case key(Rest2) of
{_, []} ->
ok;
What ->
orber:dbg("[~p] orber_cosnaming_utils:check_addresses(~p);~n"
"Key ~p", [?LINE, Str, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end.
%%----------------------------------------------------------------------
%% Function : check_name
%% Arguments :
%% Description:
%% Returns :
%%----------------------------------------------------------------------
check_name(Str) ->
name(Str).
%%----------------------------------------------------------------------
%% Function : select_type
%% Arguments : A corbaloc/corbaname-string.
%% Description:
%% Returns : A tuple which contain data about what connection we want to use |
%% {'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}}
%%----------------------------------------------------------------------
select_type([$c, $o, $r, $b, $a, $l, $o, $c, $:|Rest1]) ->
{Addresses, Rest2} = addresses(Rest1),
case key(Rest2) of
{Key, []} ->
{corbaloc, Addresses, Key};
What ->
orber:dbg("[~p] orber_cosnaming_utils:select_type(~p);~n"
"Key ~p", [?LINE, Rest1, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end;
select_type([$c, $o, $r, $b, $a, $n, $a, $m, $e, $:|Rest1]) ->
{Addresses, Rest2} = addresses(Rest1),
{Key, Rest3} = key(Rest2),
Name = name(Rest3),
{corbaname, Addresses, Key, string2name(Name)};
select_type([$f, $i, $l, $e, $:, $/ |Rest]) ->
file(Rest);
select_type([$f, $t, $p, $:, $/, $/ |Rest]) ->
ftp(Rest);
select_type([$h, $t, $t, $p, $:, $/, $/ |Rest]) ->
http(Rest);
select_type(What) ->
orber:dbg("[~p] orber_cosnaming_utils:select_type(~p);~n"
"Malformed or unsupported type.",
[?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}).
%%----------------------------------------------------------------------
%% Function : addresses
%% Arguments : A corbaloc string.
%% Description:
%% Returns : A list of addresses an the remaining part possibly containg
%% a Key and a stringified Name
%%----------------------------------------------------------------------
addresses(Str) ->
addresses(address(protocol, Str, [], []), []).
addresses({false, rir, Rest}, []) ->
{rir, Rest};
addresses({false, Adr, Rest}, Addresses) ->
{lists:reverse([Adr|Addresses]), Rest};
addresses({true, Adr, Rest}, Addresses) ->
addresses(address(protocol, Rest, [], []), [Adr|Addresses]).
%% Which protocol.
address(protocol, [$:|T], [], []) ->
address(version, T, [], [iiop]);
address(protocol, [$i, $i, $o, $p, $:|T], [], []) ->
address(version, T, [], [iiop]);
address(protocol, [$s,$s,$l, $i, $o, $p, $:|T], [], []) ->
address(version, T, [], [ssliop]);
address(protocol, [$r, $i, $r, $:|T], [], []) ->
{false, rir, T};
address(protocol, What, _, _) ->
orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
"Malformed or unsupported protocol.",
[?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
%% Parsed one address, no version found or port found.
address(version, [$,|T], Acc, Previous) ->
{true, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), T};
address(version, [$/|T], Acc, Previous) ->
{false, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), T};
%% Found iiop version.
address(version, [$@|T], Acc, Previous) ->
case Acc of
[Minor, $., Major] ->
address(address, T, [], [{Major-$0, Minor-$0}|Previous]);
What ->
orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
"Malformed or unsupported version.",
[?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end;
%% Found no iiop version, switch to port. In this case Acc contains the
%% Host.
address(version, [$:|T], Acc, Previous) ->
case check_ip_version(T, [$:|Acc]) of
false ->
address(port, T, [], [lists:reverse(Acc), ?DEF_VERS|Previous]);
{ok, NewAcc, NewT, Type} ->
address(Type, NewT, [], [lists:reverse(NewAcc), ?DEF_VERS|Previous])
end;
%% Parsed one address, port not found.
address(address, [$,|T], [], Previous) ->
{true, lists:reverse([?DEF_PORT|Previous]), T};
address(address, [$/|T], [], Previous) ->
{false, lists:reverse([?DEF_PORT|Previous]), T};
address(address, [$,|T], Acc, Previous) ->
{true, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), T};
address(address, [$/|T], Acc, Previous) ->
{false, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), T};
%% Parsed one address.
address(port, [$/|T], Acc, Previous) ->
case catch list_to_integer(lists:reverse(Acc)) of
Port when is_integer(Port) ->
{false, lists:reverse([Port|Previous]), T};
What ->
orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
"Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end;
address(port, [$,|T], Acc, Previous) ->
case catch list_to_integer(lists:reverse(Acc)) of
Port when is_integer(Port) ->
{true, lists:reverse([Port|Previous]), T};
What ->
orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
"Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end;
%% EOS, check how far we have reached so far and add necessary default values.
address(version, [], Acc, Previous) ->
{false, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), []};
address(port, [], [], Previous) ->
{false, lists:reverse([?DEF_PORT|Previous]), []};
address(port, [], Acc, Previous) ->
case catch list_to_integer(lists:reverse(Acc)) of
Port when is_integer(Port) ->
{false, lists:reverse([Port|Previous]), []};
What ->
orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
"Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
end;
address(address, [], [], Previous) ->
{false, lists:reverse([?DEF_PORT|Previous]), []};
address(address, [], Acc, Previous) ->
{false, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), []};
%% Found port
address(address, [$:|T], Acc, Previous) ->
case check_ip_version(T, [$:|Acc]) of
false ->
address(port, T, [], [lists:reverse(Acc)|Previous]);
{ok, NewAcc, NewT, Type} ->
address(Type, NewT, [], [lists:reverse(NewAcc)|Previous])
end;
address(Type, [H|T], Acc, Previous) ->
address(Type, T, [H|Acc], Previous).
check_ip_version(T, Acc) ->
case orber_env:ip_version() of
inet ->
false;
inet6 ->
case search_for_delimiter(1, T, Acc, $:) of
{ok, NewAcc, NewT, Type} ->
{ok, NewAcc, NewT, Type};
_ ->
false
end
end.
%% An IPv6 address may look like (x == hex, d == dec):
%% * "0:0:0:0:0:0:10.1.1.1" - x:x:x:x:x:x:d.d.d.d
%% * "0:0:0:0:8:800:200C:417A" - x:x:x:x:x:x:x:x
%% We cannot allow compressed addresses (::10.1.1.1) since we it is not
%% possible to know if the last part is a port number or part of the address.
search_for_delimiter(7, [], Acc, $:) ->
{ok, Acc, [], address};
search_for_delimiter(9, [], Acc, $.) ->
{ok, Acc, [], address};
search_for_delimiter(_, [], _, _) ->
false;
search_for_delimiter(7, [$/|T], Acc, $:) ->
{ok, Acc, [$/|T], address};
search_for_delimiter(9, [$/|T], Acc, $.) ->
{ok, Acc, [$/|T], address};
search_for_delimiter(_, [$/|_T], _Acc, _) ->
false;
search_for_delimiter(7, [$,|T], Acc, $:) ->
{ok, Acc, [$,|T], address};
search_for_delimiter(9, [$,|T], Acc, $.) ->
{ok, Acc, [$,|T], address};
search_for_delimiter(_, [$,|_T], _Acc, _) ->
false;
search_for_delimiter(7, [$:|T], Acc, $:) ->
{ok, Acc, T, port};
search_for_delimiter(9, [$:|T], Acc, $.) ->
{ok, Acc, T, port};
search_for_delimiter(N, [$:|T], Acc, $:) ->
search_for_delimiter(N+1, T, [$:|Acc], $:);
search_for_delimiter(N, [$.|T], Acc, $.) when N > 6, N < 9 ->
search_for_delimiter(N+1, T, [$.|Acc], $.);
search_for_delimiter(6, [$.|T], Acc, $:) ->
search_for_delimiter(7, T, [$.|Acc], $.);
search_for_delimiter(N, [H|T], Acc, LookingFor) ->
search_for_delimiter(N, T, [H|Acc], LookingFor).
%%----------------------------------------------------------------------
%% Function : key
%% Arguments : A string which contain a Key we want to use and, if defined,
%% stringified NameComponent sequence.
%% Description:
%% Returns : The Key and the remaining part, i.e., a stringified
%% NameComponent sequence.
%%----------------------------------------------------------------------
key(Str) ->
key(Str, []).
key([], []) ->
{?DEF_KEY, []};
key([], Acc) ->
{lists:reverse(Acc), []};
key([$#|T], []) ->
{?DEF_KEY, T};
key([$#|T], Acc) ->
{lists:reverse(Acc), T};
key([$/|T], []) ->
key(T, []);
key([H|T], Acc) ->
key(T, [H|Acc]).
%%----------------------------------------------------------------------
%% Function : name
%% Arguments : A string describing a NameComponent sequence.
%% Description:
%% Returns : The input string |
%% {'EXCEPTION', #'CosNaming_NamingContext_InvalidName'{}}
%%----------------------------------------------------------------------
name(Str) ->
name(Str, []).
name([], Acc) ->
lists:reverse(Acc);
name([$., $/|_T], _) ->
corba:raise(#'CosNaming_NamingContext_InvalidName'{});
name([$/, $/|_T], _) ->
corba:raise(#'CosNaming_NamingContext_InvalidName'{});
name([$/|T], []) ->
name(T, []);
name([H|T], Acc) ->
name(T, [H|Acc]).
%%----------------------------------------------------------------------
%% Function : file
%% Arguments : A string describing connection parameters.
%% Description:
%% Returns : A tuple consisting of data extracted from the given string.
%%----------------------------------------------------------------------
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 is_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;
%%% Corbaname via SSL
lookup({corbaname, [[ssliop, Vers, Host, Port]|Addresses], Key, Name}, Ctx) ->
SSLComponent =
#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
component_data=#'SSLIOP_SSL'{target_supports = 2,
target_requires = 2,
port = Port}},
NS = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key, [SSLComponent]),
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;
%%% Corbaloc via SSL
lookup({corbaloc, [[ssliop, Vers, Host, Port]|Addresses], Key}, Ctx) ->
SSLComponent =
#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
component_data=#'SSLIOP_SSL'{target_supports = 2,
target_requires = 2,
port = Port}},
ObjRef = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key, [SSLComponent]),
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 ->
receive_msg(Socket, [], 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, Acc, Timeout) ->
receive
{tcp_closed, Socket} ->
case re:split(Acc,"\r\n\r\n",[{return,list}]) of
[_Header, Body] ->
Body;
What ->
orber:dbg("[~p] orber_cosnaming_utils:receive_msg();~n"
"HTTP server closed the connection before sending a complete reply: ~p.",
[?LINE, What], ?DEBUG_LEVEL),
corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
end;
{tcp, Socket, Response} ->
receive_msg(Socket, Acc ++ Response, Timeout);
{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, "IDL:omg.org/CosNotifyChannelAdmin/EventChannelFactory:1.0"};
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 -----------------------------
