diff options
Diffstat (limited to 'lib/common_test/src')
| -rw-r--r-- | lib/common_test/src/Makefile | 2 | ||||
| -rw-r--r-- | lib/common_test/src/ct_netconfc.erl | 157 | ||||
| -rw-r--r-- | lib/common_test/src/ct_run.erl | 71 | ||||
| -rw-r--r-- | lib/common_test/src/ct_telnet.erl | 93 | ||||
| -rw-r--r-- | lib/common_test/src/ct_webtool.erl | 1207 | ||||
| -rw-r--r-- | lib/common_test/src/ct_webtool_sup.erl | 74 | ||||
| -rw-r--r-- | lib/common_test/src/vts.erl | 10 |
7 files changed, 1476 insertions, 138 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 2723b066f0..e3d5102db8 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -62,6 +62,8 @@ MODULES= \ ct_telnet_client \ ct_make \ vts \ + ct_webtool \ + ct_webtool_sup \ unix_telnet \ ct_config \ ct_config_plain \ diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index af82f2dcbf..cca08bd063 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -172,6 +172,7 @@ only_open/2, hello/1, hello/2, + hello/3, close_session/1, close_session/2, kill_session/2, @@ -457,23 +458,35 @@ only_open(KeyOrName, ExtraOpts) -> %%---------------------------------------------------------------------- %% @spec hello(Client) -> Result -%% @equiv hello(Client, infinity) +%% @equiv hello(Client, [], infinity) hello(Client) -> - hello(Client,?DEFAULT_TIMEOUT). + hello(Client,[],?DEFAULT_TIMEOUT). %%---------------------------------------------------------------------- -spec hello(Client,Timeout) -> Result when Client :: handle(), Timeout :: timeout(), Result :: ok | {error,error_reason()}. +%% @spec hello(Client, Timeout) -> Result +%% @equiv hello(Client, [], Timeout) +hello(Client,Timeout) -> + hello(Client,[],Timeout). + +%%---------------------------------------------------------------------- +-spec hello(Client,Options,Timeout) -> Result when + Client :: handle(), + Options :: [{capability, [string()]}], + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. %% @doc Exchange `hello' messages with the server. %% -%% Sends a `hello' message to the server and waits for the return. -%% +%% Adds optional capabilities and sends a `hello' message to the +%% server and waits for the return. %% @end %%---------------------------------------------------------------------- -hello(Client,Timeout) -> - call(Client, {hello, Timeout}). +hello(Client,Options,Timeout) -> + call(Client, {hello, Options, Timeout}). + %%---------------------------------------------------------------------- %% @spec get_session_id(Client) -> Result @@ -1075,9 +1088,9 @@ terminate(_, #state{connection=Connection}) -> ok. %% @private -handle_msg({hello,Timeout}, From, +handle_msg({hello, Options, Timeout}, From, #state{connection=Connection,hello_status=HelloStatus} = State) -> - case do_send(Connection, client_hello()) of + case do_send(Connection, client_hello(Options)) of ok -> case HelloStatus of undefined -> @@ -1154,7 +1167,9 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) -> close_session -> stop; _ -> noreply end, - {R,State#state{pending=Pending1}}. + %% Halfhearted try to get in correct state, this matches + %% the implementation before this patch + {R,State#state{pending=Pending1, buff= <<>>}}. %% @private %% Called by ct_util_server to close registered connections before terminate. @@ -1258,10 +1273,14 @@ set_request_timer(T) -> %%%----------------------------------------------------------------- -client_hello() -> +client_hello(Options) when is_list(Options) -> + UserCaps = [{capability, UserCap} || + {capability, UserCap} <- Options, + is_list(hd(UserCap))], {hello, ?NETCONF_NAMESPACE_ATTR, [{capabilities, - [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}]}]}. + [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}| + UserCaps]}]}. %%%----------------------------------------------------------------- @@ -1344,72 +1363,54 @@ to_xml_doc(Simple) -> %%%----------------------------------------------------------------- %%% Parse and handle received XML data -handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> +handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> log(Connection,recv,NewData), - Data = <<Buff/binary,NewData/binary>>, - case xmerl_sax_parser:stream(<<>>, - [{continuation_fun,fun sax_cont/1}, - {continuation_state,{Data,Connection,false}}, - {event_fun,fun sax_event/3}, - {event_state,[]}]) of - {ok, Simple, Rest} -> - decode(Simple,State#state{buff=Rest}); - {fatal_error,_Loc,Reason,_EndTags,_EventState} -> - ?error(Connection#connection.name,[{parse_error,Reason}, - {buffer,Buff}, - {new_data,NewData}]), - case Reason of - {could_not_fetch_data,Msg} -> - handle_msg(Msg,State#state{buff = <<>>}); - _Other -> - Pending1 = - case State#state.pending of - [] -> - []; - Pending -> - %% Assuming the first request gets the - %% first answer - P=#pending{tref=TRef,caller=Caller} = - lists:last(Pending), - _ = timer:cancel(TRef), - Reason1 = {failed_to_parse_received_data,Reason}, - ct_gen_conn:return(Caller,{error,Reason1}), - lists:delete(P,Pending) - end, - {noreply,State#state{pending=Pending1,buff = <<>>}} - end - end. - -%%%----------------------------------------------------------------- -%%% Parsing of XML data -%% Contiuation function for the sax parser -sax_cont(done) -> - {<<>>,done}; -sax_cont({Data,Connection,false}) -> + Data = append_wo_initial_nl(Buff0,NewData), case binary:split(Data,[?END_TAG],[]) of - [All] -> - %% No end tag found. Remove what could be a part - %% of an end tag from the data and save for next - %% iteration - SafeSize = size(All)-5, - <<New:SafeSize/binary,Save:5/binary>> = All, - {New,{Save,Connection,true}}; - [_Msg,_Rest]=Msgs -> - %% We have at least one full message. Any excess data will - %% be returned from xmerl_sax_parser:stream/2 in the Rest - %% parameter. - {list_to_binary(Msgs),done} - end; -sax_cont({Data,Connection,true}) -> - case ssh_receive_data() of - {ok,Bin} -> - log(Connection,recv,Bin), - sax_cont({<<Data/binary,Bin/binary>>,Connection,false}); - {error,Reason} -> - throw({could_not_fetch_data,Reason}) + [_NoEndTagFound] -> + {noreply, State0#state{buff=Data}}; + [FirstMsg,Buff1] -> + SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], + case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of + {ok, Simple, _Thrash} -> + case decode(Simple, State0#state{buff=Buff1}) of + {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> + %% Recurse if we have more data in buffer + handle_data(<<>>, State); + Other -> + Other + end; + {fatal_error,_Loc,Reason,_EndTags,_EventState} -> + ?error(Connection#connection.name, + [{parse_error,Reason}, + {buffer, Buff0}, + {new_data,NewData}]), + handle_error(Reason, State0#state{buff= <<>>}) + end end. - +%% xml does not accept a leading nl and some netconf server add a nl after +%% each ?END_TAG, ignore them +append_wo_initial_nl(<<>>,NewData) -> NewData; +append_wo_initial_nl(<<"\n", Data/binary>>, NewData) -> + append_wo_initial_nl(Data, NewData); +append_wo_initial_nl(Data, NewData) -> + <<Data/binary, NewData/binary>>. + +handle_error(Reason, State) -> + Pending1 = case State#state.pending of + [] -> []; + Pending -> + %% Assuming the first request gets the + %% first answer + P=#pending{tref=TRef,caller=Caller} = + lists:last(Pending), + _ = timer:cancel(TRef), + Reason1 = {failed_to_parse_received_data,Reason}, + ct_gen_conn:return(Caller,{error,Reason1}), + lists:delete(P,Pending) + end, + {noreply, State#state{pending=Pending1}}. %% Event function for the sax parser. It builds a simple XML structure. %% Care is taken to keep namespace attributes and prefixes as in the original XML. @@ -1873,16 +1874,6 @@ get_tag([]) -> %%%----------------------------------------------------------------- %%% SSH stuff -ssh_receive_data() -> - receive - {ssh_cm, CM, {data, Ch, _Type, Data}} -> - ssh_connection:adjust_window(CM,Ch,size(Data)), - {ok, Data}; - {ssh_cm, _CM, {Closed, _Ch}} = X when Closed == closed; Closed == eof -> - {error,X}; - {_Ref,timeout} = X -> - {error,X} - end. ssh_open(#options{host=Host,timeout=Timeout,port=Port,ssh=SshOpts,name=Name}) -> case ssh:connect(Host, Port, diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 33c4f352b0..b37baa9f3e 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -226,18 +226,24 @@ finish(Tracing, ExitStatus, Args) -> if ExitStatus == interactive_mode -> interactive_mode; true -> - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> - {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) + case get_start_opt(vts, true, Args) of + true -> + %% VTS mode, don't halt the node + ok; + _ -> + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end end. @@ -245,7 +251,7 @@ script_start1(Parent, Args) -> %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), - Vts = get_start_opt(vts, true, Args), + Vts = get_start_opt(vts, true, undefined, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), CoverStop = get_start_opt(cover_stop, @@ -331,8 +337,8 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - BasicHtml = case proplists:get_value(basic_html, Args) of - undefined -> + BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of + {undefined,undefined} -> application:set_env(common_test, basic_html, false), undefined; _ -> @@ -365,9 +371,10 @@ script_start1(Parent, Args) -> scale_timetraps = ScaleTT, create_priv_dir = CreatePrivDir, starter = script}, - + %% check if log files should be refreshed or go on to run tests... Result = run_or_refresh(Opts, Args), + %% send final results to starting process waiting in script_start/0 Parent ! {self(), Result}. @@ -761,21 +768,6 @@ script_start4(Opts = #opts{tests = Tests}, Args) -> %%% @doc Print usage information for <code>ct_run</code>. script_usage() -> io:format("\n\nUsage:\n\n"), - io:format("Run tests in web based GUI:\n\n" - "\tct_run -vts [-browser Browser]" - "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" - "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" - "\n\t[-suite Suite [-case Case]]" - "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" - "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" - "\n\t[-no_auto_compile]" - "\n\t[-abort_if_missing_suites]" - "\n\t[-multiply_timetraps N]" - "\n\t[-scale_timetraps]" - "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" - "\n\t[-basic_html]\n\n"), io:format("Run tests from command line:\n\n" "\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |" "\n\t[[-dir TestDir] -suite Suite1 Suite2 .. SuiteN" @@ -835,7 +827,22 @@ script_usage() -> io:format("Run CT in interactive mode:\n\n" "\tct_run -shell" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"). + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"), + io:format("Run tests in web based GUI:\n\n" + "\tct_run -vts [-browser Browser]" + "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" + "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" + "\n\t[-suite Suite [-case Case]]" + "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" + "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" + "\n\t[-multiply_timetraps N]" + "\n\t[-scale_timetraps]" + "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" + "\n\t[-basic_html]\n\n"). %%%----------------------------------------------------------------- %%% @hidden diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 96af55195f..b14731e74f 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -486,7 +486,8 @@ expect(Connection,Patterns) -> %%% Opts = [Opt] %%% Opt = {idle_timeout,IdleTimeout} | {total_timeout,TotalTimeout} | %%% repeat | {repeat,N} | sequence | {halt,HaltPatterns} | -%%% ignore_prompt | no_prompt_check +%%% ignore_prompt | no_prompt_check | wait_for_prompt | +%%% {wait_for_prompt,Prompt} %%% IdleTimeout = infinity | integer() %%% TotalTimeout = infinity | integer() %%% N = integer() @@ -499,9 +500,9 @@ expect(Connection,Patterns) -> %%% %%% @doc Get data from telnet and wait for the expected pattern. %%% -%%% <p><code>Pattern</code> can be a POSIX regular expression. If more -%%% than one pattern is given, the function returns when the first -%%% match is found.</p> +%%% <p><code>Pattern</code> can be a POSIX regular expression. The function +%%% returns as soon as a pattern has been successfully matched (at least one, +%%% in the case of multiple patterns).</p> %%% %%% <p><code>RxMatch</code> is a list of matched strings. It looks %%% like this: <code>[FullMatch, SubMatch1, SubMatch2, ...]</code> @@ -524,10 +525,13 @@ expect(Connection,Patterns) -> %%% milliseconds, <code>{error,timeout}</code> is returned. The default %%% value is <code>infinity</code> (i.e. no time limit).</p> %%% -%%% <p>The function will always return when a prompt is found, unless -%%% any of the <code>ignore_prompt</code> or -%%% <code>no_prompt_check</code> options are used, in which case it -%%% will return when a match is found or after a timeout.</p> +%%% <p>The function will return when a prompt is received, even if no +%%% pattern has yet been matched. In this event, +%%% <code>{error,{prompt,Prompt}}</code> is returned. +%%% However, this behaviour may be modified with the +%%% <code>ignore_prompt</code> or <code>no_prompt_check</code> option, which +%%% tells <code>expect</code> to return only when a match is found or after a +%%% timeout.</p> %%% %%% <p>If the <code>ignore_prompt</code> option is used, %%% <code>ct_telnet</code> will ignore any prompt found. This option @@ -541,6 +545,13 @@ expect(Connection,Patterns) -> %%% is useful if, for instance, the <code>Pattern</code> itself %%% matches the prompt.</p> %%% +%%% <p>The <code>wait_for_prompt</code> option forces <code>ct_telnet</code> +%%% to wait until the prompt string has been received before returning +%%% (even if a pattern has already been matched). This is equal to calling: +%%% <code>expect(Conn, Patterns++[{prompt,Prompt}], [sequence|Opts])</code>. +%%% Note that <code>idle_timeout</code> and <code>total_timeout</code> +%%% may abort the operation of waiting for prompt.</p> +%%% %%% <p>The <code>repeat</code> option indicates that the pattern(s) %%% shall be matched multiple times. If <code>N</code> is given, the %%% pattern(s) will be matched <code>N</code> times, and the function @@ -653,18 +664,21 @@ handle_msg({cmd,Cmd,Opts},State) -> start_gen_log(heading(cmd,State#state.name)), log(State,cmd,"Cmd: ~p",[Cmd]), + %% whatever is in the buffer from previous operations + %% will be ignored as we go ahead with this telnet cmd + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), case {State#state.type,State#state.prompt} of - {ts,_} -> + {ts,_} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, prompt, State#state.prx, [{idle_timeout,2000}]); - {ip,false} -> + {ip,false} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, @@ -1029,10 +1043,12 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end, PromptCheck = get_prompt_check(Opts), - Seq = get_seq(Opts), - Pattern = convert_pattern(Pattern0,Seq), - {IdleTimeout,TotalTimeout} = get_timeouts(Opts), + {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts), + + Seq = get_seq(Opts1), + Pattern2 = convert_pattern(Pattern1,Seq), + {IdleTimeout,TotalTimeout} = get_timeouts(Opts1), EO = #eo{teln_pid=Pid, prx=Prx, @@ -1042,9 +1058,16 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> haltpatterns=HaltPatterns, prompt_check=PromptCheck}, - case get_repeat(Opts) of + case get_repeat(Opts1) of false -> - case teln_expect1(Name,Pid,Data,Pattern,[],EO) of + case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of + {ok,Matched,Rest} when WaitForPrompt -> + case lists:reverse(Matched) of + [{prompt,_},Matched1] -> + {ok,Matched1,Rest}; + [{prompt,_}|Matched1] -> + {ok,lists:reverse(Matched1),Rest} + end; {ok,Matched,Rest} -> {ok,Matched,Rest}; {halt,Why,Rest} -> @@ -1054,7 +1077,7 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end; N -> EO1 = EO#eo{repeat=N}, - repeat_expect(Name,Pid,Data,Pattern,[],EO1) + repeat_expect(Name,Pid,Data,Pattern2,[],EO1) end. convert_pattern(Pattern,Seq) @@ -1118,6 +1141,40 @@ get_ignore_prompt(Opts) -> get_prompt_check(Opts) -> not lists:member(no_prompt_check,Opts). +wait_for_prompt(Pattern, Opts) -> + case lists:member(wait_for_prompt, Opts) of + true -> + wait_for_prompt1(prompt, Pattern, + lists:delete(wait_for_prompt,Opts)); + false -> + case proplists:get_value(wait_for_prompt, Opts) of + undefined -> + {false,Pattern,Opts}; + PromptStr -> + wait_for_prompt1({prompt,PromptStr}, Pattern, + proplists:delete(wait_for_prompt,Opts)) + end + end. + +wait_for_prompt1(Prompt, [Ch|_] = Pattern, Opts) when is_integer(Ch) -> + wait_for_prompt2(Prompt, [Pattern], Opts); +wait_for_prompt1(Prompt, Pattern, Opts) when is_list(Pattern) -> + wait_for_prompt2(Prompt, Pattern, Opts); +wait_for_prompt1(Prompt, Pattern, Opts) -> + wait_for_prompt2(Prompt, [Pattern], Opts). + +wait_for_prompt2(Prompt, Pattern, Opts) -> + Pattern1 = case lists:reverse(Pattern) of + [prompt|_] -> Pattern; + [{prompt,_}|_] -> Pattern; + _ -> Pattern ++ [Prompt] + end, + Opts1 = case lists:member(sequence, Opts) of + true -> Opts; + false -> [sequence|Opts] + end, + {true,Pattern1,Opts1}. + %% Repeat either single or sequence. All match results are accumulated %% and returned when a halt condition is fulllfilled. repeat_expect(_Name,_Pid,Rest,_Pattern,Acc,#eo{repeat=0}) -> @@ -1210,7 +1267,7 @@ get_data1(Pid) -> %% 1) Single expect. %% First the whole data chunk is searched for a prompt (to avoid doing %% a regexp match for the prompt at each line). -%% If we are searching for anyting else, the datachunk is split into +%% If we are searching for anything else, the datachunk is split into %% lines and each line is matched against each pattern. %% one_expect: split data chunk at prompts @@ -1227,7 +1284,7 @@ one_expect(Name,Pid,Data,Pattern,EO) -> log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]), {match,{prompt,PromptType},Rest}; [{prompt,_OtherPromptType}] -> - %% Only searching for one specific prompt, not thisone + %% Only searching for one specific prompt, not this one log_lines(Name,Pid,UptoPrompt), {nomatch,Rest}; _ -> diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl new file mode 100644 index 0000000000..b67a7c2a92 --- /dev/null +++ b/lib/common_test/src/ct_webtool.erl @@ -0,0 +1,1207 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2010. 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% +%% +-module(ct_webtool). +-behaviour(gen_server). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The general idea is: %% +%% %% +%% %% +%% 1. Scan through the path for *.tool files and find all the web %% +%% based tools. Query each tool for configuration data. %% +%% 2. Add Alias for Erlscript and html for each tool to %% +%% the webserver configuration data. %% +%% 3. Start the webserver. %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% API functions +-export([start/0, start/2, stop/0]). + +%% Starting Webtool from a shell script +-export([script_start/0, script_start/1]). + +%% Web api +-export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). + +%% API against other tools +-export([is_localhost/0]). + +%% Debug export s +-export([get_tools1/1]). +-export([debug/1, stop_debug/0, debug_app/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-include_lib("kernel/include/file.hrl"). +-include_lib("stdlib/include/ms_transform.hrl"). + +-record(state,{priv_dir,app_data,supvis,web_data,started=[]}). + +-define(MAX_NUMBER_OF_WEBTOOLS,256). +-define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix +-define(DEFAULT_ADDR,{127,0,0,1}). + +-define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}). +-define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). +-define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). +-define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool + </TITLE>\r\n</HEAD>\r\n + <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). + +-define(HTML_END,"</BODY></HTML>"). + +-define(SEND_URL_TIMEOUT,5000). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% For debugging only. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Start tracing with +%% debug(Functions). +%% Functions = local | global | FunctionList +%% FunctionList = [Function] +%% Function = {FunctionName,Arity} | FunctionName | +%% {Module, FunctionName, Arity} | {Module,FunctionName} +debug(F) -> + ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + tp(F,MS), + ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func + ok. +tp(local,MS) -> % all functions + ttb:tpl(?MODULE,MS); +tp(global,MS) -> % all exported functions + ttb:tp(?MODULE,MS); +tp([{M,F,A}|T],MS) -> % Other module + ttb:tpl(M,F,A,MS), + tp(T,MS); +tp([{M,F}|T],MS) when is_atom(F) -> % Other module + ttb:tpl(M,F,MS), + tp(T,MS); +tp([{F,A}|T],MS) -> % function/arity + ttb:tpl(?MODULE,F,A,MS), + tp(T,MS); +tp([F|T],MS) -> % function + ttb:tpl(?MODULE,F,MS), + tp(T,MS); +tp([],_MS) -> + ok. +stop_debug() -> + ttb:stop([format]). + +debug_app(Mod) -> + ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + ttb:tp(Mod,MS), + ok. + +out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) + when W==webtool;W==mod_esi-> + io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]), + [{M,F,length(A)}|S]; +out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> + io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]), + S; +out(_,_,_,_) -> + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Functions called via script. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +script_start() -> + usage(), + halt(). +script_start([App]) -> + DefaultBrowser = + case os:type() of + {win32,_} -> iexplore; + _ -> firefox + end, + script_start([App,DefaultBrowser]); +script_start([App,Browser]) -> + io:format("Starting webtool...\n"), + start(), + AvailableApps = get_applications(), + {OSType,_} = os:type(), + case lists:keysearch(App,1,AvailableApps) of + {value,{App,StartPage}} -> + io:format("Starting ~w...\n",[App]), + start_tools([],"app=" ++ atom_to_list(App)), + PortStr = integer_to_list(get_port()), + Url = case StartPage of + "/" ++ Page -> + "http://localhost:" ++ PortStr ++ "/" ++ Page; + _ -> + "http://localhost:" ++ PortStr ++ "/" ++ StartPage + end, + case Browser of + none -> + ok; + iexplore when OSType == win32-> + io:format("Starting internet explorer...\n"), + {ok,R} = win32reg:open(""), + Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", + win32reg:change_key(R,Key), + {ok,Val} = win32reg:value(R,"Path"), + IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), + os:cmd("\"" ++ IExplore ++ "\" " ++ Url); + _ when OSType == win32 -> + io:format("Starting ~w...\n",[Browser]), + os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); + B when B==firefox; B==mozilla -> + io:format("Sending URL to ~w...",[Browser]), + BStr = atom_to_list(Browser), + SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ + Url ++ ")\'", + Port = open_port({spawn,SendCmd},[exit_status]), + receive + {Port,{exit_status,0}} -> + io:format("done\n"), + ok; + {Port,{exit_status,_Error}} -> + io:format(" not running, starting ~w...\n", + [Browser]), + os:cmd(BStr ++ " " ++ Url), + ok + after ?SEND_URL_TIMEOUT -> + io:format(" failed, starting ~w...\n",[Browser]), + erlang:port_close(Port), + os:cmd(BStr ++ " " ++ Url) + end; + _ -> + io:format("Starting ~w...\n",[Browser]), + os:cmd(atom_to_list(Browser) ++ " " ++ Url) + end, + ok; + false -> + stop(), + io:format("\n{error,{unknown_app,~p}}\n",[App]), + halt() + end. + +usage() -> + io:format("Starting webtool...\n"), + start(), + Apps = lists:map(fun({A,_}) -> A end,get_applications()), + io:format( + "\nUsage: start_webtool application [ browser ]\n" + "\nAvailable applications are: ~p\n" + "Default browser is \'iexplore\' (Internet Explorer) on Windows " + "or else \'firefox\'\n", + [Apps]), + stop(). + + +get_applications() -> + gen_server:call(ct_web_tool,get_applications). + +get_port() -> + gen_server:call(ct_web_tool,get_port). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Api functions to the genserver. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% +%---------------------------------------------------------------------- + +start()-> + start(standard_path,standard_data). + +start(Path,standard_data)-> + case get_standard_data() of + {error,Reason} -> + {error,Reason}; + Data -> + start(Path,Data) + end; + +start(standard_path,Data)-> + Path=get_path(), + start(Path,Data); + +start(Path,Port) when is_integer(Port)-> + Data = get_standard_data(Port), + start(Path,Data); + +start(Path,Data0)-> + Data = Data0 ++ rest_of_standard_data(), + gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]). + +stop()-> + gen_server:call(ct_web_tool,stoppit). + +%---------------------------------------------------------------------- +%Web Api functions called by the web +%---------------------------------------------------------------------- +started_tools(Env,Input)-> + gen_server:call(ct_web_tool,{started_tools,Env,Input}). + +toolbar(Env,Input)-> + gen_server:call(ct_web_tool,{toolbar,Env,Input}). + +start_tools(Env,Input)-> + gen_server:call(ct_web_tool,{start_tools,Env,Input}). + +stop_tools(Env,Input)-> + gen_server:call(ct_web_tool,{stop_tools,Env,Input}). +%---------------------------------------------------------------------- +%Support API for other tools +%---------------------------------------------------------------------- + +is_localhost()-> + gen_server:call(ct_web_tool,is_localhost). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%%The gen_server callback functions that builds the webbpages %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_call(get_applications,_,State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), + Tools = ets:select(State#state.app_data,MS), + {reply,Tools,State}; + +handle_call(get_port,_,State)-> + {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), + {reply,Port,State}; + +handle_call({started_tools,_Env,_Input},_,State)-> + {reply,started_tools_page(State),State}; + +handle_call({toolbar,_Env,_Input},_,State)-> + {reply,toolbar(),State}; + +handle_call({start_tools,Env,Input},_,State)-> + {NewState,Page}=start_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call({stop_tools,Env,Input},_,State)-> + {NewState,Page}=stop_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call(stoppit,_From,Data)-> + {stop,normal,ok,Data}; + +handle_call(is_localhost,_From,Data)-> + Result=case proplists:get_value(bind_address, Data#state.web_data) of + ?DEFAULT_ADDR -> + true; + _IpNumber -> + false + end, + {reply,Result,Data}. + + +handle_info(_Message,State)-> + {noreply,State}. + +handle_cast(_Request,State)-> + {noreply,State}. + +code_change(_,State,_)-> + {ok,State}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% The other functions needed by the gen_server behaviour +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% Start the gen_server +%---------------------------------------------------------------------- +init({Path,Config})-> + case filelib:is_dir(Path) of + true -> + {ok, Table} = get_tool_files_data(), + insert_app(?WEBTOOL_ALIAS, Table), + case ct_webtool_sup:start_link() of + {ok, Pid} -> + case start_webserver(Table, Path, Config) of + {ok, _} -> + print_url(Config), + {ok,#state{priv_dir=Path, + app_data=Table, + supvis=Pid, + web_data=Config}}; + {error, Error} -> + {stop, {error, Error}} + end; + Error -> + {stop,Error} + end; + false -> + {stop, {error, error_dir}} + end. + +terminate(_Reason,Data)-> + %%shut down the webbserver + shutdown_server(Data), + %%Shutdown the different tools that are started with application:start + shutdown_apps(Data), + %%Shutdown the supervisor and its children will die + shutdown_supervisor(Data), + ok. + +print_url(ConfigData)-> + Server=proplists:get_value(server_name,ConfigData,"undefined"), + Port=proplists:get_value(port,ConfigData,"undefined"), + {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), + io:format("WebTool is available at http://~s:~w/~n",[Server,Port]), + io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% begin build the pages +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +%The page that shows the started tools +%---------------------------------------------------------------------- +started_tools_page(State)-> + [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. + +toolbar()-> + [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. + + +start_tools_page(_Env,Input,State)-> + %%io:format("~n======= ~n ~p ~n============~n",[Input]), + case get_tools(Input) of + {tools,Tools}-> + %%io:format("~n======= ~n ~p ~n============~n",[Tools]), + {ok,NewState}=handle_apps(Tools,State,start), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_unstarted_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} + end. + +stop_tools_page(_Env,Input,State)-> + case get_tools(Input) of + {tools,Tools}-> + {ok,NewState}=handle_apps(Tools,State,stop), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_started_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} + end. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Functions that start and config the webserver +%% 1. Collect the config data +%% 2. Start webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Start the webserver +%---------------------------------------------------------------------- +start_webserver(Data,Path,Config)-> + case get_conf_data(Data,Path,Config) of + {ok,Conf_data}-> + %%io:format("Conf_data: ~p~n",[Conf_data]), + start_server(Conf_data); + {error,Error} -> + {error,{error_server_conf_file,Error}} + end. + +start_server(Conf_data)-> + case inets:start(httpd, Conf_data, stand_alone) of + {ok,Pid}-> + {ok,Pid}; + Error-> + {error,{server_error,Error}} + end. + +%---------------------------------------------------------------------- +% Create config data for the webserver +%---------------------------------------------------------------------- +get_conf_data(Data,Path,Config)-> + Aliases=get_aliases(Data), + ServerRoot = filename:join([Path,"root"]), + MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), + case httpd_conf:load_mime_types(MimeTypesFile) of + {ok,MimeTypes} -> + Config1 = Config ++ Aliases, + Config2 = [{server_root,ServerRoot}, + {document_root,filename:join([Path,"root/doc"])}, + {mime_types,MimeTypes} | + Config1], + {ok,Config2}; + Error -> + Error + end. + +%---------------------------------------------------------------------- +% Control the path for *.tools files +%---------------------------------------------------------------------- +get_tool_files_data()-> + Tools=get_tools1(code:get_path()), + %%io:format("Data : ~p ~n",[Tools]), + get_file_content(Tools). + +%---------------------------------------------------------------------- +%Control that the data in the file really is erlang terms +%---------------------------------------------------------------------- +get_file_content(Tools)-> + Get_data=fun({tool,ToolData}) -> + %%io:format("Data : ~p ~n",[ToolData]), + case proplists:get_value(config_func,ToolData) of + {M,F,A}-> + case catch apply(M,F,A) of + {'EXIT',_} -> + bad_data; + Data when is_tuple(Data) -> + Data; + _-> + bad_data + end; + _ -> + bad_data + end + end, + insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). + +%---------------------------------------------------------------------- +%Insert the data from the file in to the ets:table +%---------------------------------------------------------------------- +insert_file_content(Content)-> + Table=ets:new(app_data,[bag]), + lists:foreach(fun(X)-> + insert_app(X,Table) + end,Content), + {ok,Table}. + +%---------------------------------------------------------------------- +%Control that we got a a tuple of a atom and a list if so add the +%elements in the list to the ets:table +%---------------------------------------------------------------------- +insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> + %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), + lists:foreach( + fun({alias,{erl_alias,Alias,Mods}}) -> + Key_val = {erl_script_alias,{Alias,Mods}}, + %%io:format("Insert: ~p~n",[Key_val]), + ets:insert(Table,{Name,Key_val}); + (Key_val_pair)-> + %%io:format("Insert: ~p~n",[Key_val_pair]), + ets:insert(Table,{Name,Key_val_pair}) + end, + Key_val_list); + +insert_app(_,_)-> + ok. + +%---------------------------------------------------------------------- +% Select all the alias in the database +%---------------------------------------------------------------------- +get_aliases(Data)-> + MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> + {erl_script_alias,Alias}; + ({_,{alias,Alias}}) -> + {alias,Alias} + end), + ets:select(Data,MS). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Helper functions %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +get_standard_data(Port)-> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ]. + +get_standard_data()-> + case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of + {error,Reason} -> {error,Reason}; + Port -> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ] + end. + +get_free_port(_Port,0) -> + {error,no_free_port_found}; +get_free_port(Port,N) -> + case gen_tcp:connect("localhost",Port,[]) of + {error, _Reason} -> + Port; + {ok,Sock} -> + gen_tcp:close(Sock), + get_free_port(Port+1,N-1) + end. + +rest_of_standard_data() -> + [ + %% Do not allow the server to be crashed by malformed http-request + {max_header_siz,1024}, + {max_header_action,reply414}, + %% Go on a straight ip-socket + {com_type,ip_comm}, + %% Do not change the order of these module names!! + {modules,[mod_alias, + mod_auth, + mod_esi, + mod_actions, + mod_cgi, + mod_include, + mod_dir, + mod_get, + mod_head, + mod_log, + mod_disk_log]}, + {directory_index,["index.html"]}, + {default_type,"text/plain"} + ]. + + +get_path()-> + code:priv_dir(webtool). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% These functions is used to shutdown the webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Shut down the webbserver +%---------------------------------------------------------------------- +shutdown_server(State)-> + {Addr,Port} = get_addr_and_port(State#state.web_data), + inets:stop(httpd,{Addr,Port}). + +get_addr_and_port(Config) -> + Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), + Port = proplists:get_value(port,Config,?DEFAULT_PORT), + {Addr,Port}. + +%---------------------------------------------------------------------- +% Select all apps in the table and close them +%---------------------------------------------------------------------- +shutdown_apps(State)-> + Data=State#state.app_data, + MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), + lists:foreach(fun(Start_app)-> + stop_app(Start_app) + end, + ets:select(Data,MS)). + +%---------------------------------------------------------------------- +%Shuts down the supervisor that supervises tools that is not +%Designed as applications +%---------------------------------------------------------------------- +shutdown_supervisor(State)-> + %io:format("~n==================~n"), + ct_webtool_sup:stop(State#state.supvis). + %io:format("~n==================~n"). + +%---------------------------------------------------------------------- +%close the individual apps. +%---------------------------------------------------------------------- +stop_app({child,_Real_name})-> + ok; + +stop_app({app,Real_name})-> + application:stop(Real_name); + +stop_app({func,_Start,Stop})-> + case Stop of + {M,F,A} -> + catch apply(M,F,A); + _NoStop -> + ok + end. + + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webpage where the user can select if +%% to start apps or to stop apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +toolbar_page()-> + "<TABLE> + <TR> + <TD> + <B>Select Action</B> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> + </TD> + </TR> + </TABLE>". +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webbpage that shows the started apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% started_tools(State)->String (html table) +% State is a record of type state +%---------------------------------------------------------------------- +started_tools(State)-> + Names=get_started_apps(State#state.app_data,State#state.started), + "<TABLE BORDER=1 WIDTH=100%> + "++ make_rows(Names,[],0) ++" + </TABLE>". +%---------------------------------------------------------------------- +%get_started_apps(Data,Started)-> [{web_name,link}] +%selects the started apps from the ets table of apps. +%---------------------------------------------------------------------- + +get_started_apps(Data,Started)-> + SelectData=fun({Name,Link}) -> + {Name,Link} + end, + MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), + + [{"WebTool","/tool_management.html"} | + [SelectData(X) || X <- ets:select(Data,MS)]]. + +%---------------------------------------------------------------------- +% make_rows(List,Result,Fields)-> String (The rows of a htmltable +% List a list of tupler discibed above +% Result an accumulator for the result +% Field, counter that counts the number of cols in each row. +%---------------------------------------------------------------------- +make_rows([],Result,Fields)-> + Result ++ fill_out(Fields); +make_rows([Data|Paths],Result,Field)when Field==0-> + make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); + +make_rows([Path|Paths],Result,Field)when Field==4-> + make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); + +make_rows([Path|Paths],Result,Field)-> + make_rows(Paths,Result ++ make_field(Path),Field+1). + +%---------------------------------------------------------------------- +% make_fields(Path)-> String that is a field i a html table +% Path is a name url tuple {Name,url} +%---------------------------------------------------------------------- +make_field(Path)-> + "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". + + +%---------------------------------------------------------------------- +%get_name({Nae,Url})->String that represents a <A> tag in html. +%---------------------------------------------------------------------- +get_name({Name,Url})-> + "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". + + +%---------------------------------------------------------------------- +% fill_out(Nr)-> String, that represent Nr fields in a html-table. +%---------------------------------------------------------------------- +fill_out(Nr)when Nr==0-> + []; +fill_out(Nr)when Nr==4-> + "<TD WIDTH=\"20%\" > </TD></TR>"; + +fill_out(Nr)-> + "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%%These functions starts applicatons and builds the page showing tools +%%to start +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +%Controls whether the user selected a tool to start +%---------------------------------------------------------------------- +get_tools(Input)-> + case httpd:parse_query(Input) of + []-> + no_tools; + Tools-> + FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, + SelectData= + fun({Name,_Data}) -> string:equal(Name,"app") end, + {tools,[FormatData(X)||X<-Tools,SelectData(X)]} + end. + +%---------------------------------------------------------------------- +% Selects the data to start the applications the user has ordered +% starting of +%---------------------------------------------------------------------- +handle_apps([],State,_Cmd)-> + {ok,State}; + +handle_apps([Tool|Tools],State,Cmd)-> + case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of + []-> + Started = case Cmd of + start -> + [Tool|State#state.started]; + stop -> + lists:delete(Tool,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + ToStart -> + case handle_apps2(ToStart,State,Cmd) of + {ok,NewState}-> + handle_apps(Tools,NewState,Cmd); + _-> + handle_apps(Tools,State,Cmd) + end + end. + +%---------------------------------------------------------------------- +%execute every start or stop data about a tool. +%---------------------------------------------------------------------- +handle_apps2([{Name,Start_data}],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of + ok-> + Started = case Cmd of + start -> + [Name|State#state.started]; + stop -> + + lists:delete(Name,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + _-> + error + end; + +handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of + ok-> + handle_apps2(Rest,State,Cmd); + _-> + error + end. + + +%---------------------------------------------------------------------- +% Handle start and stop of applications +%---------------------------------------------------------------------- + +handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> + Action = case Cmd of + start -> + Start; + _ -> + Stop + end, + case Action of + {M,F,A} -> + case catch apply(M,F,A) of + {'EXIT',_} = Exit-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "~w:~w(~s) ->\n" + "~p\n\n", + [?LINE,Name,M,F,format_args(A),Exit]), + ets:delete(Data,Name); + _OK-> + ok + end; + _NoStart -> + ok + end; + + +handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> + case Cmd of + start -> + case catch supervisor:start_child(Pid,ChildSpec) of + {ok,_}-> + ok; + {ok,_,_}-> + ok; + {error,Reason}-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,{error,Reason}]), + ets:delete(Data,Name); + Error -> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,Error]), + ets:delete(Data,Name) + end; + stop -> + case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of + ok -> + supervisor:delete_child(websup,element(1,ChildSpec)); + _ -> + error + end + end; + + + +handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> + case Cmd of + start -> + case application:start(Real_name,temporary) of + ok-> + io:write(Name), + ok; + {error,{already_started,_}}-> + %% Remove it from the database so we dont start + %% anything already started + ets:match_delete(Data,{Name,{start,{app,Real_name}}}), + ok; + {error,_Reason}=Error-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "application:start(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Real_name,temporary,Error]), + ets:delete(Data,Name) + end; + + stop -> + application:stop(Real_name) + end; + +%---------------------------------------------------------------------- +% If the data is incorrect delete the app +%---------------------------------------------------------------------- +handle_app({Name,Incorrect},Data,_Pid,Cmd)-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not ~w application \'~p\'\n\n" + "Incorrect data: ~p\n\n", + [?LINE,Cmd,Name,Incorrect]), + ets:delete(Data,Name). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% this functions creates the page that shows the unstarted tools %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +reload_started_apps()-> + "<script> + function reloadCompiledList() + { + parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; + } + </script>". + +show_unstarted_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_available_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Start\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + To Start a Tool: + <UL> + <LI>Select the + checkbox for each tool to + start.</LI> + <LI>Click on the + button marked <EM>Start</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + + + +list_available_apps(State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), + Unstarted_apps= + lists:filter( + fun({Tool,_})-> + false==lists:member(Tool,State#state.started) + end, + ets:select(State#state.app_data,MS)), + case Unstarted_apps of + []-> + "<TR><TD>All tools are started</TD></TR>"; + _-> + list_apps(Unstarted_apps) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% these functions creates the page that shows the started apps %% +%% the user can select to shutdown %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +show_started_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_started_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Stop\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + Stop a Tool: + <UL> + <LI>Select the + checkbox for each tool to + stop.</LI> + <LI>Click on the + button marked <EM>Stop</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + +list_started_apps(State)-> + MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, + State#state.started), + Started_apps= ets:select(State#state.app_data,MS), + case Started_apps of + []-> + "<TR><TD>No tool is started yet.</TD></TR>"; + _-> + list_apps(Started_apps) + end. + + +list_apps(Apps) -> + lists:map(fun({Tool,Name})-> + "<TR><TD> + <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" + ++ atom_to_list(Tool) ++ "\"> + " ++ Name ++ " + </TD></TR>" + end, + Apps). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Collecting the data from the *.tool files %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------- +% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] +% Dirs - [string()] Directory names +% Calls get_tools2/2 recursively for a number of directories +% to retireve the configuration data for the web based tools. +%---------------------------------------- +get_tools1(Dirs)-> + get_tools1(Dirs,[]). + +get_tools1([Dir|Rest],Data) when is_list(Dir) -> + Tools=case filename:basename(Dir) of + %% Dir is an 'ebin' directory, check in '../priv' as well + "ebin" -> + [get_tools2(filename:join(filename:dirname(Dir),"priv")) | + get_tools2(Dir)]; + _ -> + get_tools2(Dir) + end, + get_tools1(Rest,[Tools|Data]); + +get_tools1([],Data) -> + lists:flatten(Data). + +%---------------------------------------- +% get_tools2(Directory) => DataList +% DataList : [WebTuple]|[] +% WebTuple: {tool,[{web,M,F,A}]} +% +%---------------------------------------- +get_tools2(Dir)-> + get_tools2(tool_files(Dir),[]). + +get_tools2([ToolFile|Rest],Data) -> + case get_tools3(ToolFile) of + {tool,WebData} -> + get_tools2(Rest,[{tool,WebData}|Data]); + {error,_Reason} -> + get_tools2(Rest,Data); + nodata -> + get_tools2(Rest,Data) + end; + +get_tools2([],Data) -> + Data. + +%---------------------------------------- +% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata +% Tool: {tool,[KeyValTuple]} +% ToolFile - string() A .tool file +% Now we have the file get the data and sort it out +%---------------------------------------- +get_tools3(ToolFile) -> + case file:consult(ToolFile) of + {error,open} -> + {error,nofile}; + {error,read} -> + {error,format}; + {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> + webdata(ToolInfo); + {ok,[{version,_Vsn},_Info]} -> + {error,old_version}; + {ok,_Other} -> + {error,format} + end. + + +%---------------------------------------------------------------------- +% webdata(TupleList)-> ToolTuple| nodata +% ToolTuple: {tool,[{config_func,{M,F,A}}]} +% +% There are a little unneccesary work in this format but it is extendable +%---------------------------------------------------------------------- +webdata(TupleList)-> + case proplists:get_value(config_func,TupleList,nodata) of + {M,F,A} -> + {tool,[{config_func,{M,F,A}}]}; + _ -> + nodata + end. + + +%============================================================================= +% Functions for getting *.tool configuration files +%============================================================================= + +%---------------------------------------- +% tool_files(Dir) => ToolFiles +% Dir - string() Directory name +% ToolFiles - [string()] +% Return the list of all files in Dir ending with .tool (appended to Dir) +%---------------------------------------- +tool_files(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> + filter_tool_files(Dir,Files); + {error,_Reason} -> + [] + end. + +%---------------------------------------- +% filter_tool_files(Dir,Files) => ToolFiles +% Dir - string() Directory name +% Files, ToolFiles - [string()] File names +% Filters out the files in Files ending with .tool and append them to Dir +%---------------------------------------- +filter_tool_files(_Dir,[]) -> + []; +filter_tool_files(Dir,[File|Rest]) -> + case filename:extension(File) of + ".tool" -> + [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; + _ -> + filter_tool_files(Dir,Rest) + end. + + +%%%----------------------------------------------------------------- +%%% format functions +ffunc({M,F,A}) when is_list(A) -> + io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]); +ffunc({M,F,A}) when is_integer(A) -> + io_lib:format("~w:~w/~w\n",[M,F,A]). + +format_args([]) -> + ""; +format_args(Args) -> + Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]), + io_lib:format(Str,Args). diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl new file mode 100644 index 0000000000..1d612a2d18 --- /dev/null +++ b/lib/common_test/src/ct_webtool_sup.erl @@ -0,0 +1,74 @@ +%% +%% %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% +%% +-module(ct_webtool_sup). + +-behaviour(supervisor). + +%% External exports +-export([start_link/0,stop/1]). + +%% supervisor callbacks +-export([init/1]). + +%%%---------------------------------------------------------------------- +%%% API +%%%---------------------------------------------------------------------- +start_link() -> + supervisor:start_link({local,ct_websup},ct_webtool_sup, []). + +stop(Pid)-> + exit(Pid,normal). +%%%---------------------------------------------------------------------- +%%% Callback functions from supervisor +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, {SupFlags, [ChildSpec]}} | +%% ignore | +%% {error, Reason} +%%---------------------------------------------------------------------- +init(_StartArgs) -> + %%Child1 = + %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, + %%{ok,{{simple_one_for_one,5,10},[Child1]}}. + {ok,{{one_for_one,100,10},[]}}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + + + + + + + + + + + + + + + + + + + diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index b340c6fdd1..ab13e7d0ee 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -63,21 +63,21 @@ %%%----------------------------------------------------------------- %%% User API start() -> - webtool:start(), - webtool:start_tools([],"app=vts"). + ct_webtool:start(), + ct_webtool:start_tools([],"app=vts"). init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) -> call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}). stop() -> - webtool:stop_tools([],"app=vts"), - webtool:stop(). + ct_webtool:stop_tools([],"app=vts"), + ct_webtool:stop(). report(What,Data) -> call({report,What,Data}). %%%----------------------------------------------------------------- -%%% Return config data used by webtool +%%% Return config data used by ct_webtool config_data() -> {ok,LogDir} = case lists:keysearch(logdir,1,init:get_arguments()) of |