%%-------------------------------------------------------------------- %% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2001-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_web.erl %% Purpose : %%---------------------------------------------------------------------- -module(orber_web). -export([menu/2, configure/2, info/2, nameservice/2, ifr_select/2, ifr_data/2, create/2, delete_ctx/2, add_ctx/2, delete_obj/2]). %%---------------------------------------------------------------------- %%-------------- Defines & Includes ------------------------------------ %%---------------------------------------------------------------------- -include("ifr_objects.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming.hrl"). -include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl"). -include_lib("orber/include/corba.hrl"). -include_lib("orber/src/orber_iiop.hrl"). -define(DEBUG_LEVEL, 5). -define(INFO_DATA, [{iiop_timeout, "IIOP Request Timeout"}, {iiop_connection_timeout, "IIOP Connection Timeout"}, {iiop_setup_connection_timeout, "IIOP Setup Connection Timeout"}, {iiop_port, "IIOP Port"}, {domain, "Orber Domain"}, {orber_nodes, "Nodes in Domain"}, {giop_version, "Default GIOP Version"}, {objectkeys_gc_time, "Objectkeys GC"}, {get_interceptors, "Using Interceptors"}, {get_debug_level, "Debug Level"}, {get_ORBInitRef, "ORBInitRef"}, {get_ORBDefaultInitRef, "ORBDefaultInitRef"}]). -define(IFR_DATA, [{"ir_ModuleDef", "Modules"}, {"ir_InterfaceDef", "Interfaces"}, {"ir_StructDef", "Structs"}, {"ir_UnionDef", "Unions"}, {"ir_ExceptionDef", "Exceptions"}, {"ir_ConstantDef", "Constants"}, {"ir_EnumDef", "Enumerants"}, {"ir_AliasDef", "Aliases"}, {"ir_AttributeDef", "Attributes"}, {"ir_OperationDef", "Operations"}, {"ir_Contained", "Contained"}, {"ir_TypedefDef", "Typedef"}]). %%---------------------------------------------------------------------- %%-------------- External API ------------------------------------------ %%---------------------------------------------------------------------- %% Function : create %% Returns : %% Description: %%---------------------------------------------------------------------- create(_Env, [{"node",NodeStr}]) -> Node = list_to_atom(NodeStr), is_running(Node, NodeStr), ["
Create a New Object
Module
Arguments
Options
Name String
Operation to use    Bind    Rebind
"]; create(_Env, [{"node",NodeStr}, {"module", ModStr}, {"arguments",ArgsStr}, {"options",OptionsStr}, {"namestr", Name}, {"bind", How}]) -> Node = list_to_atom(NodeStr), Mod = list_to_atom(ModStr), Args = parse_data(ArgsStr), Options = parse_data(OptionsStr), case catch rpc:call(Node, Mod, oe_create, [Args, [{sup_child, true}|Options]]) of {ok, Pid, Object} -> case catch bind(Node, Object, Name, How) of {ok, IOR} -> ["
Successfully created the object:

", IOR]; {ok, IOR, Path} -> ["
Successfully created and stored the object as: \"", Path, "\" (", pid_to_list(Pid), ")

", IOR]; What -> rpc:call(Node, corba, dispose, [Object]), orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p); Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL), ["Unable to bind object in the NameService using: ", Name] end; Object when element(2, Object) == pseudo -> case catch bind(Node, Object, Name, How) of {ok, IOR} -> ["
Successfully created the object:

", IOR]; {ok, IOR, _} -> ["
Successfully created and stored the object as :\"", Name, "\"

", IOR]; What -> rpc:call(Node, corba, dispose, [Object]), orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p); Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL), ["Unable to bind object in the NameService using: ", Name] end; What-> orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p); Unable to create object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL), ["Unable to create the object."] end. bind(Node, Obj, "", _) -> IOR = rpc:call(Node, corba, object_to_string, [Obj]), {ok, IOR}; bind(Node, Obj, NameStr, How) -> NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])), case How of "bind" -> check(rpc:call(Node, 'CosNaming_NamingContext', bind, [NS, Name, Obj])), IOR = rpc:call(Node, corba, object_to_string, [Obj]), {ok, IOR, NameStr}; "rebind" -> check(rpc:call(Node, 'CosNaming_NamingContext', rebind, [NS, Name, Obj])), IOR = rpc:call(Node, corba, object_to_string, [Obj]), {ok, IOR, NameStr} end. %%---------------------------------------------------------------------- %% Function : delete_ctx %% Returns : %% Description: %%---------------------------------------------------------------------- delete_ctx(_Env, [{"node",NodeStr}, {"context", Ref}]) -> Node = list_to_atom(NodeStr), {Ctx, NS} = remote_resolve(Node, Ref), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])), check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])), check(rpc:call(Node, 'CosNaming_NamingContextExt', destroy, [Ctx])), ["
Successfully deleted the Context: ", Ref, "\n
\n
"]. %%---------------------------------------------------------------------- %% Function : add_ctx %% Returns : %% Description: %%---------------------------------------------------------------------- add_ctx(_Env, [{"node",_NodeStr}, {"context", "root"}, {"id", ""}]) -> ["
You must supply a NameString such as:
See also 'Interoperable Naming Service' in the User's Guide.\n
\n
"]; add_ctx(_Env, [{"node",NodeStr}, {"context", "root"}, {"id", Id}]) -> Node = list_to_atom(NodeStr), NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Id])), check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])), ["
Successfully bound the new Context: ", Id, "\n
\n
"]; add_ctx(_Env, [{"node",NodeStr}, {"context", Ref}, {"id", Id}]) -> NameStr = Ref ++ "/" ++ Id, Node = list_to_atom(NodeStr), NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])), check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])), ["
Successfully bound the new Context: ", NameStr, "\n
\n
"]. %%---------------------------------------------------------------------- %% Function : delete_obj %% Returns : %% Description: %%---------------------------------------------------------------------- delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "unbind"}]) -> Node = list_to_atom(NodeStr), NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])), check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])), ["
Successfully unbound the Object: ", Ref, "\n
\n
"]; delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "both"}]) -> Node = list_to_atom(NodeStr), {Obj, NS} = remote_resolve(Node, Ref), check(rpc:call(Node, corba, dispose, [Obj])), Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])), check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])), ["
Successfully disposed an unbound the Object: ", Ref, "\n
\n
"]. %%---------------------------------------------------------------------- %% Function : nameservice %% Returns : %% Description: %%---------------------------------------------------------------------- nameservice(_Env, [{"node",NodeStr}, {"context", "root"}]) -> Node = list_to_atom(NodeStr), is_running(Node, NodeStr), Object = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])), Prefix = " [" ", Data, "
NameService\n
Root Context\n
"]; Why -> orber:dbg("[~p] orber_web:nameservice(~p, root); Unable to create context list: ~p", [?LINE, NodeStr, Why], ?DEBUG_LEVEL), throw({error, "Unable to create a look up the Root Context data"}) end; nameservice(_Env, [{"node",NodeStr}, {"context", Ref}]) -> Node = list_to_atom(NodeStr), {Object, _NS} = remote_resolve(Node, Ref), Prefix = " [" ", Data, "
NameService
", Ref, "
"]; Why -> orber:dbg("[~p] orber_web:nameservice(~p, ~p); Unable to create context list: ~p", [?LINE, NodeStr, Ref, Why], ?DEBUG_LEVEL), throw({error, ["Unable to look up the Context: ", Ref, "

If You just deleted it, use the 'Go Back' button next time."]}) end; nameservice(_Env, [{"node",NodeStr}, {"context", Ref}, {"object", Obj}]) -> case catch create_object_data(NodeStr, Ref, Obj) of {ok, Data} -> Data; Why -> orber:dbg("[~p] orber_web:nameservice(~p, ~p, ~p); Unable to create data for object: ~p", [?LINE, NodeStr, Ref, Obj, Why], ?DEBUG_LEVEL), throw({error, ["Unable to look up the Object stored as: ", Ref, "

If You just unbound it, use the 'Go Back' button next time."]}) end. create_context_list(Node, NodeStr, Prefix, Object, Ref) -> case check(rpc:call(Node, 'CosNaming_NamingContext', list, [Object, 100])) of {ok, [], BI} when Ref == "root" -> catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]), {ok, "EMPTY"}; {ok, [], BI} -> catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]), {ok, "EMPTY
"}; {ok, BL, BI} when length(BL) < 100 -> catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]), {ok, convert_contexts(BL, [], Prefix, Object, Node)}; {ok, BL, BI} -> Data = convert_contexts(BL, [], Prefix, Object, Node), {ok, create_context_list_helper(Node, BI, Data, Object, Prefix)} end. create_context_list_helper(Node, BI, Acc, Ctx, Prefix) -> case check(rpc:call(Node, 'CosNaming_BindingIterator', next_n, [BI, 100])) of {true, BL} -> NewAcc = convert_contexts(BL, Acc, Prefix, Ctx, Node), create_context_list_helper(Node, BI, NewAcc, Ctx, Prefix); {false, BL} -> catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]), convert_contexts(BL, Acc, Prefix, Ctx, Node) end. convert_contexts([], Acc, _Prefix, _Ctx, _Node) -> Acc; convert_contexts([#'CosNaming_Binding'{binding_name = Name, binding_type = ncontext}|T], Acc, Prefix, Ctx, Node) -> NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])), convert_contexts(T, [Prefix, NameStr, "\" TARGET=main>", NameStr, "ncontext"|Acc], Prefix, Ctx, Node); convert_contexts([#'CosNaming_Binding'{binding_name = Name, binding_type = nobject}|T], Acc, Prefix, Ctx, Node) -> NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])), convert_contexts(T, [Prefix, NameStr, "&object=o \" TARGET=main>", NameStr, "nobject"|Acc], Prefix, Ctx, Node). create_object_data(NodeStr, Ref, _Obj) -> Node = list_to_atom(NodeStr), {Object, _NS} = remote_resolve(Node, Ref), LongIORStr = check(rpc:call(Node, corba, object_to_string, [Object])), IFRId = check(rpc:call(Node, iop_ior, get_typeID, [Object])), Exists = check(rpc:call(Node, corba_object, non_existent, [Object])), IORStr = split_IOR(1, LongIORStr, []), {Data, External} = case rpc:call(Node, iop_ior, get_key, [Object]) of {external, {Host, Port, _OK, _, _, #host_data{version = {Ma, Mi}}}} -> {[{"IFR Id", IFRId}, {"Stored As", Ref}, {"External Object", "true"}, {"Non Existent", atom_to_list(Exists)}, {"Host", Host}, {"Port", integer_to_list(Port)}, {"IIOP Version", integer_to_list(Ma) ++"."++ integer_to_list(Mi)}, {"IOR String", IORStr}], true}; {'internal', _Key, _, _, _} -> Pid = check(rpc:call(Node, corba, get_pid, [Object])), Interface = check(rpc:call(Node, corba, request_from_iiop, [Object, oe_get_interface, false, false, false, []])), InterfaceData = parse_interface(Interface, []), {[{"IFR Id", IFRId}, {"Stored As", Ref}, {"External Object", "false"}, {"Non Existent", atom_to_list(Exists)}, {"Pid", pid_to_list(Pid)}, {"IOR String", IORStr}|InterfaceData], false}; {'internal_registered', {pseudo, Key}, _, _, _} -> Interface = check(rpc:call(Node, corba, request_from_iiop, [Object, oe_get_interface, false, false, false, []])), InterfaceData = parse_interface(Interface, []), {[{"IFR Id", IFRId}, {"Stored As", Ref}, {"External Object", "false"}, {"Non Existent", atom_to_list(Exists)}, {"Pseudo Object", atom_to_list(Key)}, {"IOR", IORStr}|InterfaceData], false}; {'internal_registered', Key, _, _, _} -> Pid = check(rpc:call(Node, corba, get_pid, [Object])), Interface = check(rpc:call(Node, corba, request_from_iiop, [Object, oe_get_interface, false, false, false, []])), InterfaceData = parse_interface(Interface, []), {[{"IFR Id", IFRId}, {"Stored As", Ref}, {"External Object", "false"}, {"Non Existent", atom_to_list(Exists)}, {"Locally Registered", atom_to_list(Key)}, {"Pid", pid_to_list(Pid)}, {"IOR String", IORStr}|InterfaceData], false} end, Buttons = case {Exists, External} of {false, false} -> ["
"]; _ -> ["
"] end, {ok, ["", simple_table("2", "NameService", [{"Key", "Value"}|Data]), Buttons]}. parse_interface([], [{_, Op}|Acc]) -> [{"Operations", Op}|Acc]; parse_interface([], []) -> [{"Operations", "-"}]; parse_interface([{Operation,{_,Args,_}}|T], Acc) -> parse_interface(T, [{"", Operation ++ "/" ++ integer_to_list(length(Args))}|Acc]). split_IOR(_, [], Acc) -> lists:reverse(Acc); split_IOR(50, Str, Acc) -> split_IOR(1, Str, ["
"|Acc]); split_IOR(N, [H|T], Acc) -> split_IOR(N+1, T, [H|Acc]). %%---------------------------------------------------------------------- %% Function : configure %% Returns : %% Description: %%---------------------------------------------------------------------- configure(_Env, [{"node",NodeStr}, {"data", DataStr}]) -> Node = list_to_atom(NodeStr), Data = parse_data(DataStr), case catch rpc:call(Node, orber, multi_configure, [Data]) of ok -> "Configuration successfull."; Why -> orber:dbg("[~p] orber_web:configure(~p, ~p); Unable to change configuration due to: ~p", [?LINE, NodeStr, DataStr, Why], ?DEBUG_LEVEL), "Unable to change the configuration.
Check the spelling and/or if it is possible to update all the keys if Orber is started." end. %%---------------------------------------------------------------------- %% Function : ifr_select %% Returns : %% Description: %%---------------------------------------------------------------------- ifr_select(_Env, [{"node",NodeStr}]) -> Node = list_to_atom(NodeStr), is_running(Node, NodeStr), [" ", create_ifr_table(?IFR_DATA, NodeStr, []), "
Interface Repository
"]. %%---------------------------------------------------------------------- %% Function : ifr_data %% Returns : %% Description: %%---------------------------------------------------------------------- ifr_data(_Env, [{"node",NodeStr}, {"table", TableStr}]) -> Node = list_to_atom(NodeStr), Table = list_to_atom(TableStr), WildPattern = get_wild_pattern(Table, Node), Records = check(rpc:call(Node, mnesia, dirty_match_object, [WildPattern])), Data = extract_ids(Records, []), ["", simple_table("1", "Interface Repository", [TableStr|Data]), "
"]. extract_ids([], Acc) -> lists:sort(Acc); extract_ids([#ir_ModuleDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_InterfaceDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_StructDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_UnionDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_ExceptionDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_ConstantDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_EnumDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_AliasDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_AttributeDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_OperationDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_Contained{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]); extract_ids([#ir_TypedefDef{id=Id}|T], Acc) -> extract_ids(T, [Id|Acc]). get_wild_pattern(ir_ModuleDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_ModuleDef, wild_pattern])), P#ir_ModuleDef{id='$1'}; get_wild_pattern(ir_InterfaceDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_InterfaceDef, wild_pattern])), P#ir_InterfaceDef{id='$1'}; get_wild_pattern(ir_StructDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_StructDef, wild_pattern])), P#ir_StructDef{id='$1'}; get_wild_pattern(ir_UnionDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_UnionDef, wild_pattern])), P#ir_UnionDef{id='$1'}; get_wild_pattern(ir_ExceptionDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_ExceptionDef, wild_pattern])), P#ir_ExceptionDef{id='$1'}; get_wild_pattern(ir_ConstantDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_ConstantDef, wild_pattern])), P#ir_ConstantDef{id='$1'}; get_wild_pattern(ir_EnumDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_EnumDef, wild_pattern])), P#ir_EnumDef{id='$1'}; get_wild_pattern(ir_AliasDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_AliasDef, wild_pattern])), P#ir_AliasDef{id='$1'}; get_wild_pattern(ir_AttributeDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_AttributeDef, wild_pattern])), P#ir_AttributeDef{id='$1'}; get_wild_pattern(ir_OperationDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_OperationDef, wild_pattern])), P#ir_OperationDef{id='$1'}; get_wild_pattern(ir_Contained, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_Contained, wild_pattern])), P#ir_Contained{id='$1'}; get_wild_pattern(ir_TypedefDef, Node) -> P = check(rpc:call(Node, mnesia, table_info, [ir_TypedefDef, wild_pattern])), P#ir_TypedefDef{id='$1'}. create_ifr_table([], _Node, Result) -> lists:append(lists:reverse(Result)); create_ifr_table([{Table,Desc}|Rest], Node, Result) -> create_ifr_table(Rest, Node, ["" ++ Desc ++""|Result]). %%---------------------------------------------------------------------- %% Function : info %% Returns : %% Description: %%---------------------------------------------------------------------- info(_Env, [{"node",NodeStr}]) -> Node = list_to_atom(NodeStr), is_running(Node, NodeStr), Data = create_info_data(?INFO_DATA, Node, []), ["", simple_table("2", "Configuration", [{"Key", "Value"}|Data], ["
"])]. create_info_data([], _Node, Result) -> lists:reverse(Result); create_info_data([{Func,Desc}|Rest], Node, Result) -> Data = convert_type(check(rpc:call(Node, orber, Func, []))), create_info_data(Rest, Node, [{Desc, Data}|Result]). convert_type(Data) when is_integer(Data) -> integer_to_list(Data); convert_type(Data) when is_atom(Data) -> atom_to_list(Data); convert_type(Data) when is_float(Data) -> float_to_list(Data); convert_type(Data) when is_pid(Data) -> pid_to_list(Data); convert_type(Data) when is_port(Data) -> erlang:port_to_list(Data); convert_type(Data) when is_tuple(Data) -> io_lib:write(Data); convert_type([]) -> []; convert_type(Data) when is_list(Data) -> case io_lib:printable_list(Data) of true-> Data; _-> io_lib:write(Data) end; convert_type(_Data) -> []. %%---------------------------------------------------------------------- %% Function : menu %% Returns : %% Description: %%---------------------------------------------------------------------- menu(_Env, Args)-> ["", node_selections_javascripts(), node_body(Args, [node()|nodes()])]. menu_title()-> "
Menu
\n". node_body([], Nodes)-> Node = node(), [node_selections_javascripts(), node_selection(Node, Nodes), menu_title(), menu_options(atom_to_list(Node))]; node_body([{"node",Node}|_], Nodes)-> [node_selections_javascripts(), node_selection(list_to_atom(Node), Nodes), menu_title(), menu_options(Node)]; node_body([_|Rest], Nodes) -> node_body(Rest, Nodes). %%---------------------------------------------------------------------- %% Function : node_selections_javascripts %% Returns : %% Description: %%---------------------------------------------------------------------- node_selections_javascripts()-> "". %%---------------------------------------------------------------------- %% Function : node_selection %% Returns : %% Description: %%---------------------------------------------------------------------- node_selection(Node, Nodes)-> ["
\n \n \n
\n \n
\n
"]. %%---------------------------------------------------------------------- %% Function : print_nodes %% Returns : %% Description: %%---------------------------------------------------------------------- print_nodes(Node,Nodes)-> print_nodes_helper([Node|lists:delete(Node,Nodes)]). print_nodes_helper([])-> []; print_nodes_helper([Node|Rest])-> NodeStr = atom_to_list(Node), ["