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/common_test.app.src | 11 | ||||
-rw-r--r-- | lib/common_test/src/ct.erl | 45 | ||||
-rw-r--r-- | lib/common_test/src/ct_framework.erl | 51 | ||||
-rw-r--r-- | lib/common_test/src/ct_gen_conn.erl | 5 | ||||
-rw-r--r-- | lib/common_test/src/ct_logs.erl | 24 | ||||
-rw-r--r-- | lib/common_test/src/ct_netconfc.erl | 157 | ||||
-rw-r--r-- | lib/common_test/src/ct_run.erl | 130 | ||||
-rw-r--r-- | lib/common_test/src/ct_telnet.erl | 97 | ||||
-rw-r--r-- | lib/common_test/src/ct_telnet_client.erl | 4 | ||||
-rw-r--r-- | lib/common_test/src/ct_testspec.erl | 34 | ||||
-rw-r--r-- | lib/common_test/src/ct_util.hrl | 1 | ||||
-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 |
15 files changed, 1653 insertions, 199 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/common_test.app.src b/lib/common_test/src/common_test.app.src index 580d5dbd7b..0be1466fc9 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -63,9 +63,10 @@ ct_master_logs]}, {applications, [kernel,stdlib]}, {env, []}, - {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", - "test_server-3.7.1","stdlib-2.0","ssh-3.0.1", - "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", - "kernel-3.0","inets-5.10","erts-6.0", - "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. + {runtime_dependencies,["xmerl-1.3.8","tools-2.8", + "test_server-3.9","stdlib-2.5","ssh-4.0", + "snmp-5.1.2","sasl-2.4.2","runtime_tools-1.8.16", + "kernel-4.0","inets-6.0","erts-7.0", + "debugger-4.1","crypto-3.6","compiler-6.0", + "observer-2.1"]}]}. diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 9d8fce2789..5ed1346f1e 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -79,6 +79,7 @@ %% Other interface functions -export([get_status/0, abort_current_testcase/1, get_event_mgr_ref/0, + get_testspec_terms/0, get_testspec_terms/1, encrypt_config_file/2, encrypt_config_file/3, decrypt_config_file/2, decrypt_config_file/3]). @@ -463,6 +464,50 @@ reload_config(Required)-> ct_config:reload_config(Required). %%%----------------------------------------------------------------- +%%% @spec get_testspec_terms() -> TestSpecTerms | undefined +%%% TestSpecTerms = [{Tag,Value}] +%%% Value = [term()] +%%% +%%% @doc Get a list of all test specification terms used to +%%% configure and run this test. +%%% +get_testspec_terms() -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(CurrSpecRec) + end. + +%%%----------------------------------------------------------------- +%%% @spec get_testspec_terms(Tags) -> TestSpecTerms | undefined +%%% Tags = [Tag] | Tag +%%% Tag = atom() +%%% TestSpecTerms = [{Tag,Value}] | {Tag,Value} +%%% Value = [{Node,term()}] | [term()] +%%% Node = atom() +%%% +%%% @doc Read one or more terms from the test specification used +%%% to configure and run this test. Tag is any valid test specification +%%% tag, such as e.g. <c>label</c>, <c>config</c>, <c>logdir</c>. +%%% User specific terms are also available to read if the +%%% <c>allow_user_terms</c> option has been set. Note that all value tuples +%%% returned, except user terms, will have the node name as first element. +%%% Note also that in order to read test terms, use <c>Tag = tests</c> +%%% (rather than <c>suites</c>, <c>groups</c> or <c>cases</c>). Value is +%%% then the list of *all* tests on the form: +%%% <c>[{Node,Dir,[{TestSpec,GroupsAndCases1},...]},...], where +%%% GroupsAndCases = [{Group,[Case]}] | [Case]</c>. +get_testspec_terms(Tags) -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(Tags, CurrSpecRec) + end. + + +%%%----------------------------------------------------------------- %%% @spec log(Format) -> ok %%% @equiv log(default,50,Format,[]) log(Format) -> diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 498950c9d1..91368d3137 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -113,6 +113,7 @@ init_tc1(?MODULE,_,error_in_suite,[Config0]) when is_list(Config0) -> ct_event:notify(#event{name=tc_start, node=node(), data={?MODULE,error_in_suite}}), + ct_suite_init(?MODULE, error_in_suite, [], Config0), case ?val(error, Config0) of undefined -> {fail,"unknown_error_in_suite"}; @@ -635,7 +636,20 @@ try_set_default(Name,Key,Info,Where) -> end_tc(Mod, Fun, Args) -> %% Have to keep end_tc/3 for backwards compatibility issues end_tc(Mod, Fun, Args, '$end_tc_dummy'). -end_tc(?MODULE,error_in_suite,_, _) -> % bad start! +end_tc(?MODULE,error_in_suite,{Result,[Args]},Return) -> + %% this clause gets called if CT has encountered a suite that + %% can't be executed + FinalNotify = + case ct_hooks:end_tc(?MODULE, error_in_suite, Args, Result, Return) of + '$ct_no_change' -> + Result; + HookResult -> + HookResult + end, + Event = #event{name=tc_done, + node=node(), + data={?MODULE,error_in_suite,tag(FinalNotify)}}, + ct_event:sync_notify(Event), ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> end_tc(Mod,Func,TCPid,Result,Args,Return); @@ -873,8 +887,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> end, PrintErr = fun(ErrFormat, ErrArgs) -> - Div = "~n- - - - - - - - - - - - - - - - " - "- - - - - - - - - -~n", + Div = "~n- - - - - - - - - - - - - - - - - - - " + "- - - - - - - - - - - - - - - - - - - - -~n", io:format(user, lists:concat([Div,ErrFormat,Div,"~n"]), ErrArgs), Link = @@ -1062,9 +1076,32 @@ get_all_cases1(_, []) -> get_all(Mod, ConfTests) -> case catch apply(Mod, all, []) of - {'EXIT',_} -> - Reason = - list_to_atom(atom_to_list(Mod)++":all/0 is missing"), + {'EXIT',{undef,[{Mod,all,[],_} | _]}} -> + Reason = + case code:which(Mod) of + non_existing -> + list_to_atom(atom_to_list(Mod)++ + " can not be compiled or loaded"); + _ -> + list_to_atom(atom_to_list(Mod)++":all/0 is missing") + end, + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Reason properly + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {'EXIT',ExitReason} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:all/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(user, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":all/0 failed"), %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Reason properly [{?MODULE,error_in_suite,[[{error,Reason}]]}]; @@ -1287,6 +1324,8 @@ report(What,Data) -> end, ct_logs:unregister_groupleader(ReportingPid), case {Func,Result} of + {error_in_suite,_} when Suite == ?MODULE -> + ok; {init_per_suite,_} -> ok; {end_per_suite,_} -> diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 56082086f6..8da10ee0f3 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -24,10 +24,9 @@ -module(ct_gen_conn). --compile(export_all). - --export([start/4, stop/1, get_conn_pid/1]). +-export([start/4, stop/1, get_conn_pid/1, check_opts/1]). -export([call/2, call/3, return/2, do_within_time/2]). +-export([log/3, start_log/1, cont_log/2, end_log/0]). %%---------------------------------------------------------------------- %% Exported types diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 12749a8cc4..7c8c720e13 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -1910,13 +1910,14 @@ sort_all_runs(Dirs) -> sort_ct_runs(Dirs) -> %% Directory naming: <Prefix>.NodeName.Date_Time[/...] %% Sort on Date_Time string: "YYYY-MM-DD_HH.MM.SS" - lists:sort(fun(Dir1,Dir2) -> - [_Prefix,_Node1,DateHH1,MM1,SS1] = - string:tokens(filename:dirname(Dir1),[$.]), - [_Prefix,_Node2,DateHH2,MM2,SS2] = - string:tokens(filename:dirname(Dir2),[$.]), - {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2} - end, Dirs). + lists:sort( + fun(Dir1,Dir2) -> + [SS1,MM1,DateHH1 | _] = + lists:reverse(string:tokens(filename:dirname(Dir1),[$.])), + [SS2,MM2,DateHH2 | _] = + lists:reverse(string:tokens(filename:dirname(Dir2),[$.])), + {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2} + end, Dirs). dir_diff_all_runs(Dirs, LogCache) -> case LogCache#log_cache.all_runs of @@ -2053,6 +2054,13 @@ runentry(Dir, Totals={Node,Label,Logs, ?testname_width-3)), lists:flatten(io_lib:format("~ts...",[Trunc])) end, + TotMissingStr = + if NotBuilt > 0 -> + ["<font color=\"red\">", + integer_to_list(NotBuilt),"</font>"]; + true -> + integer_to_list(NotBuilt) + end, Total = TotSucc+TotFail+AllSkip, A = xhtml(["<td align=center><font size=\"-1\">",Node, "</font></td>\n", @@ -2072,7 +2080,7 @@ runentry(Dir, Totals={Node,Label,Logs, "<td align=right>",TotFailStr,"</td>\n", "<td align=right>",integer_to_list(AllSkip), " (",UserSkipStr,"/",AutoSkipStr,")</td>\n", - "<td align=right>",integer_to_list(NotBuilt),"</td>\n"], + "<td align=right>",TotMissingStr,"</td>\n"], TotalsStr = A++B++C, XHTML = [xhtml("<tr>\n", ["<tr class=\"",odd_or_even(),"\">\n"]), 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 4a12481214..0eafe72020 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -77,7 +77,8 @@ multiply_timetraps = 1, scale_timetraps = false, create_priv_dir, - testspecs = [], + testspec_files = [], + current_testspec, tests, starter}). @@ -225,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. @@ -244,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, @@ -330,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; _ -> @@ -364,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}. @@ -485,8 +493,11 @@ execute_one_spec(TS, Opts, Args) -> case check_and_install_configfiles(AllConfig, TheLogDir, Opts) of ok -> % read tests from spec {Run,Skip} = ct_testspec:prepare_tests(TS, node()), - do_run(Run, Skip, Opts#opts{config=AllConfig, - logdir=TheLogDir}, Args); + Result = do_run(Run, Skip, Opts#opts{config=AllConfig, + logdir=TheLogDir, + current_testspec=TS}, Args), + ct_util:delete_testdata(testspec), + Result; Error -> Error end. @@ -577,7 +588,7 @@ combine_test_opts(TS, Specs, Opts) -> Opts#opts{label = Label, profile = Profile, - testspecs = Specs, + testspec_files = Specs, cover = Cover, cover_stop = CoverStop, logdir = which(logdir, LogDir), @@ -702,7 +713,7 @@ script_start4(#opts{label = Label, profile = Profile, logopts = LogOpts, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, - logdir = LogDir, testspecs = Specs}, _Args) -> + logdir = LogDir, testspec_files = Specs}, _Args) -> %% label - used by ct_logs application:set_env(common_test, test_label, Label), @@ -757,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" @@ -831,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 @@ -1103,7 +1114,7 @@ run_test2(StartOpts) -> undefined -> case lists:keysearch(prepared_tests, 1, StartOpts) of {value,{_,{Run,Skip},Specs}} -> % use prepared tests - run_prepared(Run, Skip, Opts#opts{testspecs = Specs}, + run_prepared(Run, Skip, Opts#opts{testspec_files = Specs}, StartOpts); false -> run_dir(Opts, StartOpts) @@ -1111,11 +1122,11 @@ run_test2(StartOpts) -> Specs -> Relaxed = get_start_opt(allow_user_terms, value, false, StartOpts), %% using testspec(s) as input for test - run_spec_file(Relaxed, Opts#opts{testspecs = Specs}, StartOpts) + run_spec_file(Relaxed, Opts#opts{testspec_files = Specs}, StartOpts) end. run_spec_file(Relaxed, - Opts = #opts{testspecs = Specs}, + Opts = #opts{testspec_files = Specs}, StartOpts) -> Specs1 = case Specs of [X|_] when is_integer(X) -> [Specs]; @@ -1154,7 +1165,10 @@ run_all_specs([{Specs,TS} | TSs], Opts, StartOpts, TotResult) -> log_ts_names(Specs), Combined = #opts{config = TSConfig} = combine_test_opts(TS, Specs, Opts), AllConfig = merge_vals([Opts#opts.config, TSConfig]), - try run_one_spec(TS, Combined#opts{config = AllConfig}, StartOpts) of + try run_one_spec(TS, + Combined#opts{config = AllConfig, + current_testspec=TS}, + StartOpts) of Result -> run_all_specs(TSs, Opts, StartOpts, [Result | TotResult]) catch @@ -1399,7 +1413,7 @@ run_testspec2(TestSpec) -> case check_and_install_configfiles( Opts#opts.config, LogDir1, Opts) of ok -> - Opts1 = Opts#opts{testspecs = [], + Opts1 = Opts#opts{testspec_files = [], logdir = LogDir1, include = AllInclude}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), @@ -1620,11 +1634,15 @@ groups_and_cases(Gs, Cs) -> tests(TestDir, Suites, []) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suites),ensure_atom(Suites),all}]; tests(TestDir, Suite, Cases) when is_list(TestDir), is_integer(hd(TestDir)) -> + [{?testdir(TestDir,Suite),ensure_atom(Suite),Cases}]; +tests([TestDir], Suite, Cases) when is_list(TestDir), is_integer(hd(TestDir)) -> [{?testdir(TestDir,Suite),ensure_atom(Suite),Cases}]. tests([{Dir,Suite}],Cases) -> [{?testdir(Dir,Suite),ensure_atom(Suite),Cases}]; tests(TestDir, Suite) when is_list(TestDir), is_integer(hd(TestDir)) -> - tests(TestDir, ensure_atom(Suite), all). + tests(TestDir, ensure_atom(Suite), all); +tests([TestDir], Suite) when is_list(TestDir), is_integer(hd(TestDir)) -> + tests(TestDir, ensure_atom(Suite), all). tests(DirSuites) when is_list(DirSuites), is_tuple(hd(DirSuites)) -> [{?testdir(Dir,Suite),ensure_atom(Suite),all} || {Dir,Suite} <- DirSuites]; tests(TestDir) when is_list(TestDir), is_integer(hd(TestDir)) -> @@ -1706,6 +1724,9 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), %% save logopts ct_util:set_testdata({logopts,Opts#opts.logopts}), + %% save info about current testspec (testspec record or undefined) + ct_util:set_testdata({testspec,Opts#opts.current_testspec}), + %% enable silent connections case Opts#opts.silent_connections of [] -> @@ -1720,7 +1741,7 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_logs:log("Silent connections", "~p", [Conns]) end end, - log_ts_names(Opts#opts.testspecs), + log_ts_names(Opts#opts.testspec_files), TestSuites = suite_tuples(Tests), {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = @@ -1969,22 +1990,7 @@ final_tests(Tests, Skip, Bad) -> final_tests1([{TestDir,Suites,_}|Tests], Final, Skip, Bad) when is_list(Suites), is_atom(hd(Suites)) -> -% Separate = -% fun(S,{DoSuite,Dont}) -> -% case lists:keymember({TestDir,S},1,Bad) of -% false -> -% {[S|DoSuite],Dont}; -% true -> -% SkipIt = {TestDir,S,"Make failed"}, -% {DoSuite,Dont++[SkipIt]} -% end -% end, - -% {DoSuites,Skip1} = -% lists:foldl(Separate,{[],Skip},Suites), -% Do = {TestDir,lists:reverse(DoSuites),all}, - - Skip1 = [{TD,S,"Make failed"} || {{TD,S},_} <- Bad, S1 <- Suites, + Skip1 = [{TD,S,make_failed} || {{TD,S},_} <- Bad, S1 <- Suites, S == S1, TD == TestDir], Final1 = [{TestDir,S,all} || S <- Suites], final_tests1(Tests, lists:reverse(Final1)++Final, Skip++Skip1, Bad); @@ -1997,7 +2003,7 @@ final_tests1([{TestDir,all,all}|Tests], Final, Skip, Bad) -> false -> [] end, - Missing = [{TestDir,S,"Make failed"} || S <- MissingSuites], + Missing = [{TestDir,S,make_failed} || S <- MissingSuites], Final1 = [{TestDir,all,all}|Final], final_tests1(Tests, Final1, Skip++Missing, Bad); @@ -2009,7 +2015,7 @@ final_tests1([{TestDir,Suite,GrsOrCs}|Tests], Final, Skip, Bad) when is_list(GrsOrCs) -> case lists:keymember({TestDir,Suite}, 1, Bad) of true -> - Skip1 = Skip ++ [{TestDir,Suite,all,"Make failed"}], + Skip1 = Skip ++ [{TestDir,Suite,all,make_failed}], final_tests1(Tests, [{TestDir,Suite,all}|Final], Skip1, Bad); false -> GrsOrCs1 = diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index d906a267a1..b14731e74f 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -29,7 +29,7 @@ %% Command timeout = 10 sec (time to wait for a command to return) %% Max no of reconnection attempts = 3 %% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle) +%% Keep alive = true (will send NOP to the server every 8 sec if connection is idle) %% Polling limit = 0 (max number of times to poll to get a remaining string terminated) %% Polling interval = 1 sec (sleep time between polls)</pre> %% <p>These parameters can be altered by the user with the following @@ -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, @@ -1007,7 +1021,7 @@ silent_teln_expect(Name,Pid,Data,Pattern,Prx,Opts) -> put(silent,Old), Result. -%% teln_expect/5 +%% teln_expect/6 %% %% This function implements the expect functionality over telnet. In %% general there are three possible ways to go: @@ -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_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index b0734d8d65..757ccc0aae 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -39,7 +39,7 @@ -define(TELNET_PORT, 23). -define(OPEN_TIMEOUT,10000). --define(IDLE_TIMEOUT,10000). +-define(IDLE_TIMEOUT,8000). %% telnet control characters -define(SE, 240). @@ -114,7 +114,7 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0}], Timeout) of + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 10a9bdac67..10c3f2a938 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -27,6 +27,8 @@ collect_tests_from_list/2, collect_tests_from_list/3, collect_tests_from_file/2, collect_tests_from_file/3]). +-export([testspec_rec2list/1, testspec_rec2list/2]). + -include("ct_util.hrl"). -define(testspec_fields, record_info(fields, testspec)). @@ -973,7 +975,8 @@ add_tests([Term={Tag,all_nodes,Data}|Ts],Spec) -> should_be_added(Tag,Node,Data,Spec)], add_tests(Tests++Ts,Spec); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% create one test entry per node in Nodes and reinsert add_tests([{Tag,[],Data}|Ts],Spec) -> @@ -1001,7 +1004,8 @@ add_tests([Term={Tag,NodeOrOther,Data}|Ts],Spec) -> handle_data(Tag,Node,Data,Spec), add_tests(Ts,mod_field(Spec,Tag,NodeIxData)); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; false -> add_tests([{Tag,all_nodes,{NodeOrOther,Data}}|Ts],Spec) @@ -1012,13 +1016,15 @@ add_tests([Term={Tag,Data}|Ts],Spec) -> valid -> add_tests([{Tag,all_nodes,Data}|Ts],Spec); invalid -> - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% some other data than a tuple add_tests([Other|Ts],Spec) -> case get(relaxed) of - true -> - add_tests(Ts,Spec); + true -> + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Other]}); false -> throw({error,{undefined_term_in_spec,Other}}) end; @@ -1149,6 +1155,24 @@ per_node([N|Ns],Tag,Data,Refs) -> per_node([],_,_,_) -> []. +%% Change the testspec record "back" to a list of tuples +testspec_rec2list(Rec) -> + {Terms,_} = lists:mapfoldl(fun(unknown, Pos) -> + {element(Pos, Rec),Pos+1}; + (F, Pos) -> + {{F,element(Pos, Rec)},Pos+1} + end,2,?testspec_fields), + lists:flatten(Terms). + +%% Extract one or more values from a testspec record and +%% return the result as a list of tuples +testspec_rec2list(Field, Rec) when is_atom(Field) -> + [Term] = testspec_rec2list([Field], Rec), + Term; +testspec_rec2list(Fields, Rec) -> + Terms = testspec_rec2list(Rec), + [{Field,proplists:get_value(Field, Terms)} || Field <- Fields]. + %% read the value for FieldName in record Rec#testspec read_field(Rec, FieldName) -> catch lists:foldl(fun(F, Pos) when F == FieldName -> diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 845bb55486..f4cf407856 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -55,6 +55,7 @@ create_priv_dir=[], alias=[], tests=[], + unknown=[], merge_tests=true}). -record(cover, {app=none, 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 |