orber_cosnaming_utils.erl

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

%%--------------------------------------------------------------------
%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
%%-----------------------------------------------------------------
%% File: CosNaming_BindingIterator_impl.erl
%% Creation date: 970902
%% 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 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 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 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.
%%----------------------------------------------------------------------