diff options
Diffstat (limited to 'lib/orber/COSS')
| -rw-r--r-- | lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl | 93 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl | 751 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/Makefile | 150 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/cos_naming.idl | 77 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/cos_naming_ext.idl | 37 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/lname.erl | 133 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/lname.hrl | 33 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/lname_component.erl | 83 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/orber_cosnaming.hrl | 63 | ||||
| -rw-r--r-- | lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl | 750 |
10 files changed, 2170 insertions, 0 deletions
diff --git a/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl new file mode 100644 index 0000000000..7d1791a785 --- /dev/null +++ b/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl @@ -0,0 +1,93 @@ +%%-------------------------------------------------------------------- +%% +%% %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: CosNaming_BindingIterator_impl.erl +%% +%%----------------------------------------------------------------- +-module('CosNaming_BindingIterator_impl'). + +-include_lib("orber/include/corba.hrl"). +-include("CosNaming.hrl"). +-include("orber_cosnaming.hrl"). + + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([init/1, terminate/2, code_change/3]). +-export([next_one/1, next_n/2, destroy/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External interface functions +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Func: init/1 +%% Args: +%% Returns: +%%----------------------------------------------------------------- +init(State) -> + {ok, State}. + +%%----------------------------------------------------------------- +%% Func: terminate/2 +%% Args: +%% Returns: +%%----------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +next_one([]) -> + NoBinding = #'CosNaming_Binding'{binding_name=[], + binding_type=nobject}, + {reply, {false, NoBinding}, []}; +next_one([Binding]) -> + {reply, {true, Binding}, []}; +next_one([Binding|Rest]) -> + {reply, {true, Binding}, Rest}. + +next_n([], _) -> + {reply, {false, []}, []}; +next_n(List, HowMany) -> + {More, Acc, NewList} = split(List, HowMany, []), + {reply, {More, Acc}, NewList}. + +split([], _, Acc) -> + {false, Acc, []}; +split(Rest, 0, Acc) -> + {true, Acc, Rest}; +split([H|T], N, Acc) -> + split(T, N-1, [H|Acc]). + + +destroy(OE_State) -> + {stop, normal, ok, OE_State}. + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- diff --git a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl new file mode 100644 index 0000000000..84db0b89f8 --- /dev/null +++ b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl @@ -0,0 +1,751 @@ +%%-------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-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: CosNaming_NamingContextExt_impl.erl +%% Modified: +%% +%%----------------------------------------------------------------- +%% README: +%% (1) +%% +%%----------------------------------------------------------------- +-module('CosNaming_NamingContextExt_impl'). + +%%---------------------------------------------------------------------- +%% Include files +%%---------------------------------------------------------------------- +-include_lib("orber/include/corba.hrl"). +-include_lib("orber/src/orber_iiop.hrl"). +-include("CosNaming.hrl"). +-include("CosNaming_NamingContext.hrl"). +-include("CosNaming_NamingContextExt.hrl"). +-include("orber_cosnaming.hrl"). + +%%---------------------------------------------------------------------- +%% External exports +%%---------------------------------------------------------------------- +%% Mandatory callbacks +-export([init/1, + terminate/2, + code_change/3]). + +%% Inherrit from CosNaming::NamingContext +-export([bind/4, + rebind/4, + bind_context/4, + rebind_context/4, + resolve/3, + unbind/3, + new_context/2, + bind_new_context/3, + list/3, + destroy/2]). + +%% CosNaming::NamingContextExt +-export([to_string/3, + to_name/3, + to_url/4, + resolve_str/3]). + +%%---------------------------------------------------------------------- +%% Internal exports +%%---------------------------------------------------------------------- +-export([dump/0, + install/2]). + +%%---------------------------------------------------------------------- +%% Records +%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Macros +%%---------------------------------------------------------------------- +%% DEBUG INFO +-define(DEBUG_LEVEL, 5). + +%%====================================================================== +%% External functions +%%====================================================================== +%%---------------------------------------------------------------------% +%% Function : init/1 +%% Description: Initiates the server +%% Returns : {ok, State} | +%% {ok, State, Timeout} | +%% ignore | +%% {stop, Reason} +%%---------------------------------------------------------------------- +init([]) -> + {ok, term_to_binary('undefined')}; + +init(DBKey) -> + _F = ?write_function(#orber_CosNaming{name_context=DBKey, + nameindex=[]}), + write_result(mnesia:transaction(_F)), + {ok, DBKey}. + +%%---------------------------------------------------------------------% +%% Function : terminate +%% Description: Shutdown the server +%% Returns : any (ignored by gen_server) +%%---------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%---------------------------------------------------------------------% +%% Function : code_change +%% Description: Convert process state when code is changed +%% Returns : {ok, State} +%%---------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%---------------------------------------------------------------------% +%% Function : install +%% Arguments : Timeout - abort if timeout triggered. +%% Options - mnesia options +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +install(Timeout, Options) -> + %% Fetch a list of the defined tables to see if 'CosNaming' is defined. + AllTabs = mnesia:system_info(tables), + DB_tables_created = + case lists:member('orber_CosNaming', AllTabs) of + true -> + case lists:member({local_content, true}, + Options) of + true-> + mnesia:add_table_copy('orber_CosNaming', + node(), + ram_copies); + _-> + mnesia:create_table('orber_CosNaming',[{attributes, + record_info(fields, + 'orber_CosNaming')} + |Options]) + end; + _ -> + mnesia:create_table('orber_CosNaming',[{attributes, + record_info(fields, + 'orber_CosNaming')} + |Options]) + end, + Wait = mnesia:wait_for_tables(['orber_CosNaming'], Timeout), + %% Check if any error has occured yet. If there are errors, return them. + + if + DB_tables_created == {atomic, ok}, + Wait == ok -> + _F = ?write_function(#orber_CosNaming{name_context= + term_to_binary('undefined'), + nameindex=[]}), + write_result(mnesia:transaction(_F)); + true -> + {error, [DB_tables_created, Wait]} + end. + + +%%---------------------------------------------------------------------- +%% Interface CosNaming::NamingContext +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- +%% Function : bind +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +bind(OE_THIS, OE_State, [N], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _BF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = X}] -> + case lists:keysearch(N, 1, X) of + {value, _} -> + {'EXCEPTION', #'CosNaming_NamingContext_AlreadyBound'{}}; + false -> + mnesia:write(#orber_CosNaming{name_context=SubobjKey, + nameindex=[{N, nobject, Obj} | X]}) + end; + Other -> + orber:dbg("[~p] ~p:bind(~p, ~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}} + end + end, + case mnesia:transaction(_BF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:bind(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end; +bind(OE_THIS, OE_State, [H|T], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':bind(NC, T, Obj), OE_State}; + {value, {H, ncontext, NC}} -> + bind(NC, OE_State, T, Obj); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +bind(_OE_THIS, _OE_State, [], _Obj) -> + orber:dbg("[~p] CosNaming_NamingContextExt:bind();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + +%%---------------------------------------------------------------------- +%% Function : rebind +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +rebind(OE_THIS, OE_State, [N], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RBF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = X}] -> + KList = + case lists:keysearch(N, 1, X) of + {value, {N, _, _V}} -> + lists:keyreplace(N, 1, X, {N, nobject, Obj}); + false -> + [{N, nobject, Obj} | X] + end, + mnesia:write(#orber_CosNaming{name_context=SubobjKey, + nameindex=KList}); + Other -> + orber:dbg("[~p] ~p:rebind(~p, ~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}} + end + end, + case mnesia:transaction(_RBF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:rebind(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end; +rebind(OE_THIS, OE_State, [H|T], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':rebind(NC, T, Obj), OE_State}; + {value, {H, ncontext, NC}} -> + rebind(NC, OE_State, T, Obj); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +rebind(_OE_THIS, _OE_State, [], _Obj) -> + orber:dbg("[~p] CosNaming_NamingContextExt:rebind();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + +%%---------------------------------------------------------------------- +%% Function : bind_context +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +bind_context(OE_THIS, OE_State, [N], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _BCF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = X}] -> + case lists:keysearch(N, 1, X) of + {value, _} -> + {'EXCEPTION', #'CosNaming_NamingContext_AlreadyBound'{}}; + false -> + mnesia:write(#orber_CosNaming{name_context=SubobjKey, + nameindex= + [{N, ncontext, Obj} | X]}) + end; + Other -> + orber:dbg("[~p] ~p:bind_context(~p, ~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}} + end + end, + case mnesia:transaction(_BCF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:bind_context(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end; +bind_context(OE_THIS, OE_State, [H|T], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':bind_context(NC, T, Obj), + OE_State}; + {value, {H, ncontext, NC}} -> + bind_context(NC, OE_State, T, Obj); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +bind_context(_OE_THIS, _OE_State, [], _Obj) -> + orber:dbg("[~p] CosNaming_NamingContextExt:bind_context();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + +%%---------------------------------------------------------------------- +%% Function : rebind_context +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +rebind_context(OE_THIS, OE_State, [N], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RBCF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = X}] -> + KList = + case lists:keysearch(N, 1, X) of + {value, {N, _, _V}} -> + lists:keyreplace(N, 1, X, {N, ncontext, Obj}); + false -> + [{N, ncontext, Obj} | X] + end, + mnesia:write(#orber_CosNaming{name_context=SubobjKey, + nameindex= KList}); + Other -> + orber:dbg("[~p] ~p:rebind_context(~p, ~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}} + end + end, + case mnesia:transaction(_RBCF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:rebind_context(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end; +rebind_context(OE_THIS, OE_State, [H|T], Obj) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H,ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':rebind_context(NC, T, Obj), + OE_State}; + {value, {H,ncontext, NC}} -> + rebind_context(NC, OE_State, T, Obj); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +rebind_context(_OE_THIS, _OE_State, [], _Obj) -> + orber:dbg("[~p] CosNaming_NamingContextExt:rebind_context();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + +%%---------------------------------------------------------------------- +%% Function : resolve +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +resolve(OE_THIS, OE_State, [N]) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}); + X -> + case lists:keysearch(N, 1, X) of + {value, {N, _, Value}} -> + {reply, Value, OE_State}; + false -> + corba:raise(#'CosNaming_NamingContext_NotFound' + {rest_of_name=[N], why='not_object'}) + end + end; +resolve(OE_THIS, OE_State, [H|T]) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':resolve(NC, T), OE_State}; + {value, {H, ncontext, NC}} -> + resolve(NC, OE_State, T); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +resolve(_OE_THIS, _OE_State, []) -> + orber:dbg("[~p] CosNaming_NamingContextExt:resolve();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + +%%---------------------------------------------------------------------- +%% Function : unbind +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +unbind(OE_THIS, OE_State, [N]) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _UBF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = X}] -> + KList = lists:keydelete(N, 1, X), + mnesia:write(#orber_CosNaming{name_context=SubobjKey, + nameindex= KList}); + Other -> + orber:dbg("[~p] ~p:unbind(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N], + cxt=OE_THIS}} + end + end, + case mnesia:transaction(_UBF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:unbind(~p, ~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end; +unbind(OE_THIS, OE_State, [H|T]) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T], + cxt=OE_THIS}); + X -> + case lists:keysearch(H, 1, X) of + {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') -> + {reply, 'CosNaming_NamingContext':unbind(NC, T), OE_State}; + {value, {H, ncontext, NC}} -> + unbind(NC, OE_State, T); + _ -> + corba:raise(#'CosNaming_NamingContext_CannotProceed' + {rest_of_name=[H|T], cxt=OE_THIS}) + end + end; +unbind(_OE_THIS, _OE_State, []) -> + orber:dbg("[~p] CosNaming_NamingContextExt:unbind();~n" + "Invoked this operation with an empty list", + [?LINE], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}). + + +%%---------------------------------------------------------------------- +%% Function : new_context +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +new_context(_OE_THIS, OE_State) -> + DBKey = term_to_binary({now(), node()}), + %% Create a record in the table and set the key to a newly + {reply, + 'CosNaming_NamingContextExt':oe_create(DBKey, + [{pseudo, true}|?CREATE_OPTS]), + OE_State}. + +%%---------------------------------------------------------------------- +%% Function : bind_new_context +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +bind_new_context(OE_THIS, OE_State, N) -> + DBKey = term_to_binary({now(), node()}), + %% Create a record in the table and set the key to a newly + %% generated objectkey. + %%?PRINTDEBUG("bind_new_context"), + NewCtx = 'CosNaming_NamingContextExt':oe_create(DBKey, + [{pseudo, true}|?CREATE_OPTS]), + %% Bind the created name context to a name + case catch bind_context(OE_THIS, OE_State, N, NewCtx) of + {'EXCEPTION', E} -> + 'CosNaming_NamingContextExt':destroy(NewCtx), + corba:raise(E); + {reply, ok, _} -> + {reply, NewCtx, OE_State} + end. + + +%%---------------------------------------------------------------------- +%% Function : list +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +list(OE_THIS, OE_State, HowMany) -> + SubobjKey = corba:get_subobject_key(OE_THIS), + _RF = ?read_function({orber_CosNaming, SubobjKey}), + case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of + error -> + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}); + X -> + case convert_list(X, HowMany, 0, []) of + {false, List} -> + {reply, {ok, List, ?ORBER_NIL_OBJREF}, OE_State}; + {true, List, Rest} -> + %% By setting HowMany to '-1' it will never match + %% the Counter. Hence, the whole list will be transformed. + {false, List2} = convert_list(Rest, -1, 0, []), + BIterator = 'CosNaming_BindingIterator': + oe_create(List2, ?CREATE_OPTS), + {reply, {ok, List, BIterator}, OE_State} + end + end. + +convert_list([], _, _, Acc) -> + {false, Acc}; +convert_list(Rest, Counter, Counter, Acc) -> + {true, Acc, Rest}; +convert_list([{N, T, _O}|Rest], HowMany, Counter, Acc) -> + convert_list(Rest, HowMany, Counter+1, + [#'CosNaming_Binding'{binding_name=[N], + binding_type=T}|Acc]). + +%%---------------------------------------------------------------------- +%% Function : destroy +%% Arguments : +%% Description: +%% Returns : +%%---------------------------------------------------------------------- +destroy(OE_THIS, OE_State) -> + case corba:get_subobject_key(OE_THIS) of + <<131,100,0,9,117,110,100,101,102,105,110,101,100>> -> + %% undefined binary. + corba:raise(#'NO_PERMISSION'{completion_status=?COMPLETED_NO}); + SubobjKey -> + _DF = + fun() -> + case mnesia:wread({orber_CosNaming, SubobjKey}) of + [#orber_CosNaming{nameindex = []}] -> + mnesia:delete({orber_CosNaming, SubobjKey}); + Other when is_list(Other) -> + orber:dbg("[~p] ~p:destroy(~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'CosNaming_NamingContext_NotEmpty'{}}; + Other -> + orber:dbg("[~p] ~p:destroy(~p);~n" + "DB access returned ~p", + [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL), + {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}} + end + end, + case mnesia:transaction(_DF) of + {atomic, {'EXCEPTION', E}} -> + corba:raise(E); + {atomic, ok} -> + {reply, ok, OE_State}; + Other -> + orber:dbg("[~p] ~p:destroy(~p);~n" + "DB transaction returned ~p", + [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL), + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}) + end + end. + +%%---------------------------------------------------------------------- +%% Interface CosNaming::NamingContextExt +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- +%% Function : to_string +%% Arguments : Name +%% Description: +%% Returns : StringName | +%% {'EXCEPTION', NamingContext::InvalidName{}} +%%---------------------------------------------------------------------- +to_string(_OE_This, OE_State, Name) -> + {reply, orber_cosnaming_utils:name2string(Name), OE_State}. + + +%%---------------------------------------------------------------------- +%% Function : to_name +%% Arguments : StringName +%% Description: +%% Returns : Name | +%% {'EXCEPTION', NamingContext::InvalidName{}} +%%---------------------------------------------------------------------- +to_name(_OE_This, OE_State, StringName) -> + {reply, orber_cosnaming_utils:string2name(StringName), OE_State}. + + +%%---------------------------------------------------------------------- +%% Function : to_url +%% Arguments : Address +%% StringName +%% Description: +%% Returns : URLString | +%% {'EXCEPTION', NamingContext::InvalidName{}} +%% {'EXCEPTION', NamingContextExt::InvalidAddress{}} +%%---------------------------------------------------------------------- +to_url(_, _, "", _) -> + %% Empty address not allowed. + corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}); +to_url(_OE_This, OE_State, Address, "") -> + %% Empty stringname => use corbaloc + orber_cosnaming_utils:check_addresses(Address), + {reply, "corbaloc:"++orber_cosnaming_utils:escape_string(Address), OE_State}; +to_url(_OE_This, OE_State, Address, StringName) -> + %% Non-empty stringname => use corbaname + orber_cosnaming_utils:check_addresses(Address), + orber_cosnaming_utils:check_name(StringName), + {reply, + "corbaname:"++orber_cosnaming_utils:escape_string(Address)++"#"++ + orber_cosnaming_utils:escape_string(StringName), + OE_State}. + +%%---------------------------------------------------------------------- +%% Function : resolve_str +%% Arguments : StringName +%% Description: +%% Returns : Object | +%% {'EXCEPTION', NamingContext::InvalidName{}} +%% {'EXCEPTION', NamingContext::NotFound{why, rest_of_name}} +%% {'EXCEPTION', NamingContext::CannotProceed{cxt, rest_of_name}} +%%---------------------------------------------------------------------- +resolve_str(OE_This, OE_State, StringName) -> + Name = orber_cosnaming_utils:string2name(StringName), + resolve(OE_This, OE_State, Name). + +%%====================================================================== +%% Internal functions +%%====================================================================== +%% Check a write transaction +write_result({atomic,ok}) -> ok; +write_result(_What) -> + corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}). + + +%%---------------------------------------------------------------------- +%% Debugging functions +%%---------------------------------------------------------------------- +dump() -> + case catch mnesia:dirty_first('orber_CosNaming') of + {'EXIT', R} -> + io:format("Exited with ~p\n",[R]); + Key -> + dump_print(Key), + dump_loop(Key) + end. + +dump_loop(PreviousKey) -> + case catch mnesia:dirty_next('orber_CosNaming', PreviousKey) of + {'EXIT', R} -> + io:format("Exited with ~p\n",[R]); + '$end_of_table' -> + ok; + Key -> + dump_print(Key), + dump_loop(Key) + end. + +dump_print(Key) -> + case catch mnesia:dirty_read({'orber_CosNaming', Key}) of + {'EXIT', R} -> + io:format("Exited with ~p\n",[R]); + [X] -> + io:format("name_context: ~p\n-----------------------------\n" + " nameindex structure\n-----------------------------\n~p\n\n", + [binary_to_term(X#orber_CosNaming.name_context), + X#orber_CosNaming.nameindex]); + _ -> + ok + end. + +%%-------------------------- END OF MODULE ----------------------------- diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile new file mode 100644 index 0000000000..d3deec7600 --- /dev/null +++ b/lib/orber/COSS/CosNaming/Makefile @@ -0,0 +1,150 @@ +# +# %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% +# +# +include $(ERL_TOP)/make/target.mk +EBIN=../../ebin + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(ORBER_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN) +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES = \ + CosNaming_NamingContextExt_impl \ + CosNaming_BindingIterator_impl \ + lname \ + lname_component \ + orber_cosnaming_utils + +ERL_FILES = $(MODULES:%=%.erl) +HRL_FILES = lname.hrl \ + orber_cosnaming.hrl +GEN_ERL_FILES = \ + oe_cos_naming.erl \ + CosNaming_Name.erl \ + CosNaming_NamingContext.erl \ + CosNaming_BindingIterator.erl \ + CosNaming_NameComponent.erl \ + CosNaming_Binding.erl \ + CosNaming_BindingList.erl \ + CosNaming_NamingContext_NotFound.erl \ + CosNaming_NamingContext_AlreadyBound.erl \ + CosNaming_NamingContext_CannotProceed.erl \ + CosNaming_NamingContext_InvalidName.erl \ + CosNaming_NamingContext_NotEmpty.erl + +GEN_EXT_ERL_FILES = \ + oe_cos_naming_ext.erl \ + CosNaming_NamingContextExt.erl \ + CosNaming_NamingContextExt_InvalidAddress.erl + +GEN_HRL_FILES = \ + oe_cos_naming.hrl \ + CosNaming.hrl \ + CosNaming_NamingContext.hrl \ + CosNaming_BindingIterator.hrl + +GEN_EXT_HRL_FILES = \ + oe_cos_naming_ext.hrl \ + CosNaming_NamingContextExt.hrl + +GEN_FILES = $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ + $(GEN_EXT_ERL_FILES) $(GEN_EXT_HRL_FILES) + +TARGET_FILES = \ + $(GEN_EXT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \ + $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \ + $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +IDL_FILE = cos_naming.idl \ + cos_naming_ext.idl + +APP_FILE = +#APP_SRC = $(APP_FILE).src +#APP_TARGET = $(EBIN)/$(APP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin +# The -pa option is just used temporary until erlc can handle +# includes from other directories than ../include . +ERL_COMPILE_FLAGS += \ + $(ERL_IDL_FLAGS) \ + -I$(ERL_TOP)/lib/orber/include \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}' + +YRL_FLAGS = + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +opt: $(TARGET_FILES) $(APP_TARGET) + +debug: + @${MAKE} TYPE=debug + +clean: + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) + rm -f errs core *~ + +$(APP_TARGET): $(APP_SRC) + sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET) + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- +$(GEN_FILES): cos_naming_ext.idl cos_naming.idl + erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' \ + +'{this,"CosNaming::NamingContextExt"}' cos_naming_ext.idl + erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' cos_naming.idl + +# echo "ic:gen(cos_naming, [{this, \"CosNaming::NamingContext\"}]), halt()."| $(ERL) $(ERL_IDL_FLAGS) + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/COSS/CosNaming + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(IDL_FILE) $(RELSYSDIR)/COSS/CosNaming + $(INSTALL_DATA) $(GEN_FILES) $(RELSYSDIR)/COSS/CosNaming + + +release_docs_spec: + diff --git a/lib/orber/COSS/CosNaming/cos_naming.idl b/lib/orber/COSS/CosNaming/cos_naming.idl new file mode 100644 index 0000000000..3cd6c99c23 --- /dev/null +++ b/lib/orber/COSS/CosNaming/cos_naming.idl @@ -0,0 +1,77 @@ +// Naming Service v1.0 described in CORBAservices: +// Common Object Services Specification, chapter 3 +// OMG IDL for CosNaming Module, p 3-6 + +#pragma prefix "omg.org" + +module CosNaming +{ + typedef string Istring; + struct NameComponent { + Istring id; + Istring kind; + }; + + typedef sequence <NameComponent> Name; + + enum BindingType {nobject, ncontext}; + + struct Binding { + Name binding_name; + BindingType binding_type; + }; + + typedef sequence <Binding> BindingList; + + + interface BindingIterator; + interface NamingContext; + + interface NamingContext { + + enum NotFoundReason { missing_node, not_context, not_object}; + + exception NotFound { + NotFoundReason why; + Name rest_of_name; + }; + + exception CannotProceed { + NamingContext cxt; + Name rest_of_name; + }; + + exception InvalidName{}; + exception AlreadyBound {}; + exception NotEmpty{}; + + void bind(in Name n, in Object obj) + raises(NotFound, CannotProceed, InvalidName, AlreadyBound); + void rebind(in Name n, in Object obj) + raises(NotFound, CannotProceed, InvalidName); + void bind_context(in Name n, in NamingContext nc) + raises(NotFound, CannotProceed,InvalidName, AlreadyBound); + void rebind_context(in Name n, in NamingContext nc) + raises(NotFound, CannotProceed, InvalidName); + Object resolve (in Name n) + raises(NotFound, CannotProceed, InvalidName); + void unbind(in Name n) + raises(NotFound, CannotProceed, InvalidName); + NamingContext new_context(); + NamingContext bind_new_context(in Name n) + raises(NotFound, AlreadyBound, CannotProceed, InvalidName); + void destroy( ) + raises(NotEmpty); + void list (in unsigned long how_many, + out BindingList bl, + out BindingIterator bi); + }; + + interface BindingIterator { + boolean next_one(out Binding b); + boolean next_n(in unsigned long how_many, + out BindingList bl); + void destroy(); + }; +}; + diff --git a/lib/orber/COSS/CosNaming/cos_naming_ext.idl b/lib/orber/COSS/CosNaming/cos_naming_ext.idl new file mode 100644 index 0000000000..8099a0005c --- /dev/null +++ b/lib/orber/COSS/CosNaming/cos_naming_ext.idl @@ -0,0 +1,37 @@ +// Naming Service v1.0 described in CORBAservices: +// Common Object Services Specification, chapter 3 +// OMG IDL for CosNaming Module, p 3-6 + +#ifndef _COSNAMINGEXT_IDL_ +#define _COSNAMINGEXT_IDL_ + + +#include<cos_naming.idl> + +#pragma prefix "omg.org" + +module CosNaming +{ + interface NamingContextExt:NamingContext { + + typedef string StringName; + typedef string Address; + typedef string URLString; + + StringName to_string(in Name n) + raises(InvalidName); + + Name to_name(in StringName sn) + raises(InvalidName); + + exception InvalidAddress{}; + + URLString to_url(in Address addr,in StringName sn) + raises(InvalidAddress, InvalidName); + + Object resolve_str(in StringName n) + raises(NotFound, CannotProceed, InvalidName); + }; +}; + +#endif//_COSNAMINGEXT_IDL_ diff --git a/lib/orber/COSS/CosNaming/lname.erl b/lib/orber/COSS/CosNaming/lname.erl new file mode 100644 index 0000000000..9f060d3296 --- /dev/null +++ b/lib/orber/COSS/CosNaming/lname.erl @@ -0,0 +1,133 @@ +%%-------------------------------------------------------------------- +%% +%% %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: lname.erl +%%----------------------------------------------------------------- +-module(lname). + +-include_lib("orber/include/corba.hrl"). +-include("CosNaming.hrl"). +-include("lname.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([create/0, insert_component/3, get_component/2, delete_component/2, + num_component/1, equal/2, less_than/2, + to_idl_form/1, from_idl_form/1, check_name/1, new/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%% DEBUG INFO +-define(DEBUG_LEVEL, 5). + +%%----------------------------------------------------------------- +%% External interface functions +%%----------------------------------------------------------------- +create() -> + []. + +insert_component(_, I, _) when I < 1-> + corba:raise(#'LName_NoComponent'{}); +insert_component([], I, _) when I > 1-> + corba:raise(#'LName_NoComponent'{}); +insert_component(Name, 1, Component) when is_record(Component, + 'CosNaming_NameComponent') -> + [Component |Name]; +insert_component([H|T], I, Component) when is_record(Component, + 'CosNaming_NameComponent') -> + [H |insert_component(T, I-1, Component)]; +insert_component(_, _, Component) -> + orber:dbg("[~p] ~p:insert_component(~p); Not a NameComponent.~n", + [?LINE, ?MODULE, Component], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + +get_component(_, I) when I < 1-> + corba:raise(#'LName_NoComponent'{}); +get_component([], _) -> + corba:raise(#'LName_NoComponent'{}); +get_component([H|_T], 1) -> + H; +get_component([_|T], I) -> + get_component(T, I-1). + +delete_component(_, I) when I < 1-> + corba:raise(#'LName_NoComponent'{}); +delete_component([], _) -> + corba:raise(#'LName_NoComponent'{}); +delete_component([_|T], 1) -> + T; +delete_component([H|T], I) -> + [H | delete_component(T, I-1)]. + +num_component(Name) -> + num_component(Name, 0). + +equal(Name, N) -> + N == Name. + +less_than(Name, N) -> + Name < N. + +to_idl_form(Name) -> + case check_name(Name) of + false -> + corba:raise(#'LName_InvalidName'{}); + true -> + Name + end. + +from_idl_form(Name) -> + Name. + +%%destroy() -> % not needed in erlang +%% ok. + +%%----------------------------------------------------------------- +%% External Functions not in the CosNaming standard +%%----------------------------------------------------------------- +new([]) -> + []; +new([{Id, Kind} | List]) -> + [lname_component:new(Id, Kind) | new(List)]; +new([Id |List]) when is_list(Id) -> + [lname_component:new(Id) | new(List)]. + +%%----------------------------------------------------------------- +%% Internal Functions +%%----------------------------------------------------------------- +num_component([], N) -> + N; +num_component([_|T], N) -> + num_component(T, N+1). + +check_name([]) -> + true; +check_name([H|T]) -> + case catch lname_component:get_id(H) of + {'EXCEPTION', _E} -> + false; + _ -> + check_name(T) + end. diff --git a/lib/orber/COSS/CosNaming/lname.hrl b/lib/orber/COSS/CosNaming/lname.hrl new file mode 100644 index 0000000000..de78e4bfc0 --- /dev/null +++ b/lib/orber/COSS/CosNaming/lname.hrl @@ -0,0 +1,33 @@ +%%-------------------------------------------------------------------- +%% +%% %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: lname.hrl +%%----------------------------------------------------------------- + +%% LName interface exceptions +-record('LName_NoComponent', {'OE_ID'="PIDL:LName/NoComponent:1.0"}). +-record('LName_InvalidName', {'OE_ID'="PIDL:LName/InvalidName:1.0"}). +% This exception is not used in our implementation. +-record('LName_Overflow', {'OE_ID'="PIDL:LName/Overflow:1.0"}). + +%% LNameComponent interface exceptions +-record('LNameComponent_NotSet', + {'OE_ID'="PIDL:LNameComponent/NotSet:1.0"}). diff --git a/lib/orber/COSS/CosNaming/lname_component.erl b/lib/orber/COSS/CosNaming/lname_component.erl new file mode 100644 index 0000000000..9ded1d7e49 --- /dev/null +++ b/lib/orber/COSS/CosNaming/lname_component.erl @@ -0,0 +1,83 @@ +%%-------------------------------------------------------------------- +%% +%% %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: lname_component.erl +%%----------------------------------------------------------------- +-module(lname_component). + +-include_lib("orber/include/corba.hrl"). +-include("lname.hrl"). +-include("CosNaming.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([get_id/1, set_id/2, get_kind/1, set_kind/2, create/0, new/1, new/2]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External interface functions +%%----------------------------------------------------------------- +create() -> + #'CosNaming_NameComponent'{id="", kind=""}. + +get_id(NC) when is_record(NC, 'CosNaming_NameComponent'), + NC#'CosNaming_NameComponent'.id == undefined -> + corba:raise(#'LNameComponent_NotSet'{}); +get_id(NC) when is_record(NC, 'CosNaming_NameComponent'), + NC#'CosNaming_NameComponent'.id == "" -> + corba:raise(#'LNameComponent_NotSet'{}); +get_id(NC) when is_record(NC, 'CosNaming_NameComponent') -> + NC#'CosNaming_NameComponent'.id. + +set_id(NC, Id) when is_record(NC, 'CosNaming_NameComponent') andalso is_list(Id)-> + NC#'CosNaming_NameComponent'{id=Id}. + +get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') andalso + NC#'CosNaming_NameComponent'.kind == undefined -> + corba:raise(#'LNameComponent_NotSet'{}); +get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') andalso + NC#'CosNaming_NameComponent'.kind == "" -> + corba:raise(#'LNameComponent_NotSet'{}); +get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') -> + NC#'CosNaming_NameComponent'.kind. + +set_kind(NC, Kind) when is_record(NC, 'CosNaming_NameComponent') andalso is_list(Kind) -> + NC#'CosNaming_NameComponent'{kind=Kind}. + +%%destroy() -> % not needed in erlang +%% true. + +%%----------------------------------------------------------------- +%% External Functions not in the CosNaming standard +%%----------------------------------------------------------------- +new(Id) when is_list(Id) -> + #'CosNaming_NameComponent'{id=Id, kind=""}. +new(Id, Kind) when is_list(Id) andalso is_list(Kind) -> + #'CosNaming_NameComponent'{id=Id, kind=Kind}. + +%%----------------------------------------------------------------- +%% Internal Functions +%%----------------------------------------------------------------- diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming.hrl b/lib/orber/COSS/CosNaming/orber_cosnaming.hrl new file mode 100644 index 0000000000..073158ed6a --- /dev/null +++ b/lib/orber/COSS/CosNaming/orber_cosnaming.hrl @@ -0,0 +1,63 @@ +%%-------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-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% +%% +%% +%%-------------------------------------------------------------------- + +-ifndef(ORBER_COSNAMING_HRL). +-define(ORBER_COSNAMING_HRL, true). + +%%----------------------------------------------------------------- +%% Mnesia Table definition record +%%----------------------------------------------------------------- +-record('orber_CosNaming', {name_context, nameindex}). + +%%----------------------------------------------------------------- +%% Macros +%%----------------------------------------------------------------- + +-define(CREATE_OPTS, [{no_security, orber:partial_security()}]). + +%%-define(dirty_query_context, true). + +%% This macro returns a read fun suitable for evaluation in a transaction +-define(read_function(Objkey), + fun() -> + mnesia:read(Objkey) + end). + +%% This macro returns a write fun suitable for evaluation in a transaction +-define(write_function(R), + fun() -> + mnesia:write(R) + end). + +%% This macro returns a delete fun suitable for evaluation in a transaction +-define(delete_function(R), + fun() -> + mnesia:delete(R) + end). + +-ifdef(dirty_query_context). +-define(query_check(Q_res), Q_res). +-else. +-define(query_check(Q_res), {atomic, Q_res}). +-endif. + +-endif. diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl new file mode 100644 index 0000000000..7792839e22 --- /dev/null +++ b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl @@ -0,0 +1,750 @@ +%%-------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-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: 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"). + + +%%----------------------------------------------------------------- +%% 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, [$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; +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 -> + 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} -> + [_Header, Body] = re:split(Acc,"\r\n\r\n",[{return,list}]), + Body; + {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 ----------------------------- |