From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl | 750 +++++++++++++++++++++ 1 file changed, 750 insertions(+) create mode 100644 lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl (limited to 'lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl') 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 ----------------------------- -- cgit v1.2.3