diff options
Diffstat (limited to 'lib/common_test/src')
24 files changed, 5035 insertions, 1375 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 125aa828fb..f7dce195d7 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2011. All Rights Reserved. +# Copyright Ericsson AB 2003-2012. 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 @@ -69,14 +69,19 @@ MODULES= \ ct_slave \ ct_hooks\ ct_hooks_lock\ - cth_log_redirect + cth_log_redirect\ + cth_surefire \ + ct_netconfc \ + ct_conn_log_h \ + cth_conn_log TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) ERL_FILES= $(MODULES:=.erl) HRL_FILES = \ - ct_util.hrl + ct_util.hrl \ + ct_netconfc.hrl EXTERNAL_HRL_FILES = \ ../include/ct.hrl \ ../include/ct_event.hrl @@ -132,12 +137,12 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(RELSYSDIR)/include + $(INSTALL_DIR) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) "$(RELSYSDIR)/include" release_tests_spec: opt $(INSTALL_DIR) $(RELEASE_PATH)/common_test_test diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 7fba484b18..18c1dec784 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% Copyright Ericsson AB 2009-2012. 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 @@ -25,12 +25,16 @@ ct_framework, ct_ftp, ct_gen_conn, + ct_hooks, + ct_hooks_lock, ct_logs, ct_make, ct_master, ct_master_event, ct_master_logs, ct_master_status, + ct_netconfc, + ct_conn_log_h, ct_repeat, ct_rpc, ct_run, @@ -45,7 +49,10 @@ ct_config, ct_config_plain, ct_config_xml, - ct_slave + ct_slave, + cth_log_redirect, + cth_conn_log, + cth_surefire ]}, {registered, [ct_logs, ct_util_server, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 63a8adbc63..8d4721ab63 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -51,6 +51,8 @@ -module(ct). +-include("ct.hrl"). + %% Command line user interface for running tests -export([install/1, run/1, run/2, run/3, run_test/1, run_testspec/1, step/3, step/4, @@ -60,13 +62,15 @@ -export([require/1, require/2, get_config/1, get_config/2, get_config/3, reload_config/1, - log/1, log/2, log/3, - print/1, print/2, print/3, - pal/1, pal/2, pal/3, + log/1, log/2, log/3, log/4, + print/1, print/2, print/3, print/4, + pal/1, pal/2, pal/3, pal/4, capture_start/0, capture_stop/0, capture_get/0, capture_get/1, fail/1, fail/2, comment/1, comment/2, make_priv_dir/0, testcases/2, userdata/2, userdata/3, - timetrap/1, get_timetrap_info/0, sleep/1]). + timetrap/1, get_timetrap_info/0, sleep/1, + notify/2, sync_notify/2, + break/1, break/2, continue/0, continue/1]). %% New API for manipulating with config handlers -export([add_config/2, remove_config/2]). @@ -146,11 +150,14 @@ run(TestDirs) -> %%% {silent_connections,Conns} | {stylesheet,CSSFile} | %%% {cover,CoverSpecFile} | {step,StepOpts} | %%% {event_handler,EventHandlers} | {include,InclDirs} | -%%% {auto_compile,Bool} | {multiply_timetraps,M} | {scale_timetraps,Bool} | +%%% {auto_compile,Bool} | {create_priv_dir,CreatePrivDir} | +%%% {multiply_timetraps,M} | {scale_timetraps,Bool} | %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,Bool} | {decrypt,DecryptKeyOrFile} | -%%% {refresh_logs,LogDir} | {logopts,LogOpts} | {basic_html,Bool} | -%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} +%%% {refresh_logs,LogDir} | {logopts,LogOpts} | +%%% {verbosity,VLevels} | {basic_html,Bool} | +%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} | +%%% {noinput,Bool} %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() @@ -171,6 +178,7 @@ run(TestDirs) -> %%% EH = atom() | {atom(),InitArgs} | {[atom()],InitArgs} %%% InitArgs = [term()] %%% InclDirs = [string()] | string() +%%% CreatePrivDir = auto_per_run | auto_per_tc | manual_per_tc %%% M = integer() %%% N = integer() %%% DurTime = string(HHMMSS) @@ -180,6 +188,9 @@ run(TestDirs) -> %%% DecryptFile = string() %%% LogOpts = [LogOpt] %%% LogOpt = no_nl | no_src +%%% VLevels = VLevel | [{Category,VLevel}] +%%% VLevel = integer() +%%% Category = atom() %%% CTHs = [CTHModule | {CTHModule, CTHInitArgs}] %%% CTHModule = atom() %%% CTHInitArgs = term() @@ -419,25 +430,41 @@ reload_config(Required)-> %%%----------------------------------------------------------------- %%% @spec log(Format) -> ok -%%% @equiv log(default,Format,[]) +%%% @equiv log(default,50,Format,[]) log(Format) -> - log(default,Format,[]). + log(default,?STD_IMPORTANCE,Format,[]). %%%----------------------------------------------------------------- %%% @spec log(X1,X2) -> ok -%%% X1 = Category | Format +%%% X1 = Category | Importance | Format %%% X2 = Format | Args -%%% @equiv log(Category,Format,Args) +%%% @equiv log(Category,Importance,Format,Args) log(X1,X2) -> - {Category,Format,Args} = - if is_atom(X1) -> {X1,X2,[]}; - is_list(X1) -> {default,X1,X2} + {Category,Importance,Format,Args} = + if is_atom(X1) -> {X1,?STD_IMPORTANCE,X2,[]}; + is_integer(X1) -> {default,X1,X2,[]}; + is_list(X1) -> {default,?STD_IMPORTANCE,X1,X2} end, - log(Category,Format,Args). + log(Category,Importance,Format,Args). %%%----------------------------------------------------------------- -%%% @spec log(Category,Format,Args) -> ok +%%% @spec log(X1,X2,X3) -> ok +%%% X1 = Category | Importance +%%% X2 = Importance | Format +%%% X3 = Format | Args +%%% @equiv log(Category,Importance,Format,Args) +log(X1,X2,X3) -> + {Category,Importance,Format,Args} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3}; + is_integer(X1) -> {default,X1,X2,X3} + end, + log(Category,Importance,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec log(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -446,30 +473,52 @@ log(X1,X2) -> %%% <p>This function is meant for printing a string directly from a %%% test case to the test case log file.</p> %%% -%%% <p>Default <code>Category</code> is <code>default</code> and -%%% default <code>Args</code> is <code>[]</code>.</p> -log(Category,Format,Args) -> - ct_logs:tc_log(Category,Format,Args). +%%% <p>Default <code>Category</code> is <code>default</code>, +%%% default <code>Importance</code> is <code>?STD_IMPORTANCE</code>, +%%% and default value for <code>Args</code> is <code>[]</code>.</p> +%%% <p>Please see the User's Guide for details on <code>Category</code> +%%% and <code>Importance</code>.</p> +log(Category,Importance,Format,Args) -> + ct_logs:tc_log(Category,Importance,Format,Args). %%%----------------------------------------------------------------- %%% @spec print(Format) -> ok -%%% @equiv print(default,Format,[]) +%%% @equiv print(default,50,Format,[]) print(Format) -> - print(default,Format,[]). + print(default,?STD_IMPORTANCE,Format,[]). %%%----------------------------------------------------------------- -%%% @equiv print(Category,Format,Args) +%%% @spec print(X1,X2) -> ok +%%% X1 = Category | Importance | Format +%%% X2 = Format | Args +%%% @equiv print(Category,Importance,Format,Args) print(X1,X2) -> - {Category,Format,Args} = - if is_atom(X1) -> {X1,X2,[]}; - is_list(X1) -> {default,X1,X2} + {Category,Importance,Format,Args} = + if is_atom(X1) -> {X1,?STD_IMPORTANCE,X2,[]}; + is_integer(X1) -> {default,X1,X2,[]}; + is_list(X1) -> {default,?STD_IMPORTANCE,X1,X2} end, - print(Category,Format,Args). + print(Category,Importance,Format,Args). %%%----------------------------------------------------------------- -%%% @spec print(Category,Format,Args) -> ok +%%% @spec print(X1,X2,X3) -> ok +%%% X1 = Category | Importance +%%% X2 = Importance | Format +%%% X3 = Format | Args +%%% @equiv print(Category,Importance,Format,Args) +print(X1,X2,X3) -> + {Category,Importance,Format,Args} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3}; + is_integer(X1) -> {default,X1,X2,X3} + end, + print(Category,Importance,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec print(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -478,33 +527,52 @@ print(X1,X2) -> %%% <p>This function is meant for printing a string from a test case %%% to the console.</p> %%% -%%% <p>Default <code>Category</code> is <code>default</code> and -%%% default <code>Args</code> is <code>[]</code>.</p> -print(Category,Format,Args) -> - ct_logs:tc_print(Category,Format,Args). +%%% <p>Default <code>Category</code> is <code>default</code>, +%%% default <code>Importance</code> is <code>?STD_IMPORTANCE</code>, +%%% and default value for <code>Args</code> is <code>[]</code>.</p> +%%% <p>Please see the User's Guide for details on <code>Category</code> +%%% and <code>Importance</code>.</p> +print(Category,Importance,Format,Args) -> + ct_logs:tc_print(Category,Importance,Format,Args). %%%----------------------------------------------------------------- %%% @spec pal(Format) -> ok -%%% @equiv pal(default,Format,[]) +%%% @equiv pal(default,50,Format,[]) pal(Format) -> - pal(default,Format,[]). + pal(default,?STD_IMPORTANCE,Format,[]). %%%----------------------------------------------------------------- %%% @spec pal(X1,X2) -> ok -%%% X1 = Category | Format +%%% X1 = Category | Importance | Format %%% X2 = Format | Args -%%% @equiv pal(Category,Format,Args) +%%% @equiv pal(Category,Importance,Format,Args) pal(X1,X2) -> - {Category,Format,Args} = - if is_atom(X1) -> {X1,X2,[]}; - is_list(X1) -> {default,X1,X2} + {Category,Importance,Format,Args} = + if is_atom(X1) -> {X1,?STD_IMPORTANCE,X2,[]}; + is_integer(X1) -> {default,X1,X2,[]}; + is_list(X1) -> {default,?STD_IMPORTANCE,X1,X2} end, - pal(Category,Format,Args). + pal(Category,Importance,Format,Args). %%%----------------------------------------------------------------- -%%% @spec pal(Category,Format,Args) -> ok +%%% @spec pal(X1,X2,X3) -> ok +%%% X1 = Category | Importance +%%% X2 = Importance | Format +%%% X3 = Format | Args +%%% @equiv pal(Category,Importance,Format,Args) +pal(X1,X2,X3) -> + {Category,Importance,Format,Args} = + if is_atom(X1), is_integer(X2) -> {X1,X2,X3,[]}; + is_atom(X1), is_list(X2) -> {X1,?STD_IMPORTANCE,X2,X3}; + is_integer(X1) -> {default,X1,X2,X3} + end, + pal(Category,Importance,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec pal(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -513,10 +581,13 @@ pal(X1,X2) -> %%% <p>This function is meant for printing a string from a test case, %%% both to the test case log file and to the console.</p> %%% -%%% <p>Default <code>Category</code> is <code>default</code> and -%%% default <code>Args</code> is <code>[]</code>.</p> -pal(Category,Format,Args) -> - ct_logs:tc_pal(Category,Format,Args). +%%% <p>Default <code>Category</code> is <code>default</code>, +%%% default <code>Importance</code> is <code>?STD_IMPORTANCE</code>, +%%% and default value for <code>Args</code> is <code>[]</code>.</p> +%%% <p>Please see the User's Guide for details on <code>Category</code> +%%% and <code>Importance</code>.</p> +pal(Category,Importance,Format,Args) -> + ct_logs:tc_pal(Category,Importance,Format,Args). %%%----------------------------------------------------------------- %%% @spec capture_start() -> ok @@ -838,8 +909,9 @@ userdata(TestDir, Suite, Case) when is_atom(Case) -> %%%----------------------------------------------------------------- %%% @spec get_status() -> TestStatus | {error,Reason} | no_tests_running %%% TestStatus = [StatusElem] -%%% StatusElem = {current,{Suite,TestCase}} | {successful,Successful} | +%%% StatusElem = {current,TestCaseInfo} | {successful,Successful} | %%% {failed,Failed} | {skipped,Skipped} | {total,Total} +%%% TestCaseInfo = {Suite,TestCase} | [{Suite,TestCase}] %%% Suite = atom() %%% TestCase = atom() %%% Successful = integer() @@ -851,7 +923,8 @@ userdata(TestDir, Suite, Case) when is_atom(Case) -> %%% Reason = term() %%% %%% @doc Returns status of ongoing test. The returned list contains info about -%%% which test case is currently executing, as well as counters for +%%% which test case is currently executing (a list of cases when a +%%% parallel test case group is executing), as well as counters for %%% successful, failed, skipped, and total test cases so far. get_status() -> case get_testdata(curr_tc) of @@ -876,6 +949,8 @@ get_testdata(Key) -> Error; {'EXIT',_Reason} -> no_tests_running; + [CurrTC] when Key == curr_tc -> + {ok,CurrTC}; Data -> {ok,Data} end. @@ -993,13 +1068,21 @@ remove_config(Callback, Config) -> %%%----------------------------------------------------------------- %%% @spec timetrap(Time) -> ok -%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity +%%% Time = {hours,Hours} | {minutes,Mins} | {seconds,Secs} | Millisecs | infinity | Func %%% Hours = integer() %%% Mins = integer() %%% Secs = integer() %%% Millisecs = integer() | float() -%%% -%%% @doc <p>Use this function to set a new timetrap for the running test case.</p> +%%% Func = {M,F,A} | fun() +%%% M = atom() +%%% F = atom() +%%% A = list() +%%% +%%% @doc <p>Use this function to set a new timetrap for the running test case. +%%% If the argument is <code>Func</code>, the timetrap will be triggered +%%% when this function returns. <code>Func</code> may also return a new +%%% <code>Time</code> value, which in that case will be the value for the +%%% new timetrap.</p> timetrap(Time) -> test_server:timetrap_cancel(), test_server:timetrap(Time). @@ -1037,3 +1120,98 @@ sleep({seconds,Ss}) -> sleep(trunc(Ss * 1000)); sleep(Time) -> test_server:adjusted_sleep(Time). + +%%%----------------------------------------------------------------- +%%% @spec notify(Name,Data) -> ok +%%% Name = atom() +%%% Data = term() +%%% +%%% @doc <p>Sends a asynchronous notification of type <c>Name</c> with +%%% <c>Data</c>to the common_test event manager. This can later be +%%% caught by any installed event manager. </p> +%%% @see //stdlib/gen_event +notify(Name,Data) -> + ct_event:notify(Name, Data). + +%%%----------------------------------------------------------------- +%%% @spec sync_notify(Name,Data) -> ok +%%% Name = atom() +%%% Data = term() +%%% +%%% @doc <p>Sends a synchronous notification of type <c>Name</c> with +%%% <c>Data</c>to the common_test event manager. This can later be +%%% caught by any installed event manager. </p> +%%% @see //stdlib/gen_event +sync_notify(Name,Data) -> + ct_event:sync_notify(Name, Data). + +%%%----------------------------------------------------------------- +%%% @spec break(Comment) -> ok | {error,Reason} +%%% Comment = string() +%%% Reason = {multiple_cases_running,TestCases} +%%% TestCases = [atom()] +%%% +%%% @doc <p>This function will cancel all timetraps and pause the +%%% execution of the current test case until the user calls the +%%% <c>continue/0</c> function. It gives the user the opportunity +%%% to interact with the erlang node running the tests, e.g. for +%%% debugging purposes or for manually executing a part of the +%%% test case. If a parallel group is executing, <c>break/2</c> +%%% should be called instead.</p> +break(Comment) -> + case get_testdata(curr_tc) of + {ok,{_,TestCase}} -> + test_server:break(?MODULE, Comment); + {ok,Cases} when is_list(Cases) -> + {error,{multiple_cases_running, + [TC || {_,TC} <- Cases]}}; + Error -> + {error,Error} + end. + +%%%----------------------------------------------------------------- +%%% @spec break(TestCase, Comment) -> ok | {error,Reason} +%%% TestCase = atom() +%%% Comment = string() +%%% Reason = test_case_not_running +%%% +%%% @doc <p>This function works the same way as <c>break/1</c>, +%%% only the <c>TestCase</c> argument makes it possible to +%%% pause a test case executing in a parallel group. The +%%% <c>continue/1</c> function should be used to resume +%%% execution of <c>TestCase</c>.</p> +break(TestCase, Comment) -> + case get_testdata(curr_tc) of + {ok,Cases} when is_list(Cases) -> + case lists:keymember(TestCase, 2, Cases) of + true -> + test_server:break(?MODULE, TestCase, Comment); + false -> + {error,test_case_not_running} + end; + {ok,{_,TestCase}} -> + test_server:break(?MODULE, TestCase, Comment); + Error -> + {error,Error} + end. + +%%%----------------------------------------------------------------- +%%% @spec continue() -> ok +%%% +%%% @doc <p>This function must be called in order to continue after a +%%% test case (not executing in a parallel group) has called +%%% <c>break/1</c>.</p> +continue() -> + test_server:continue(). + +%%%----------------------------------------------------------------- +%%% @spec continue(TestCase) -> ok +%%% TestCase = atom() +%%% +%%% @doc <p>This function must be called in order to continue after a +%%% test case has called <c>break/2</c>. If the paused test case, +%%% <c>TestCase</c>, executes in a parallel group, this +%%% function - rather than <c>continue/0</c> - must be used +%%% in order to let the test case proceed.</p> +continue(TestCase) -> + test_server:continue(TestCase). diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 9277af5bc1..c585fe0995 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -760,13 +760,13 @@ check_config_files(Configs) -> end, lists:keysearch(error, 1, lists:flatten(lists:map(ConfigChecker, Configs))). -prepare_user_configs([ConfigString|UserConfigs], Acc, new) -> +prepare_user_configs([CallbackMod|UserConfigs], Acc, new) -> prepare_user_configs(UserConfigs, - [{list_to_atom(ConfigString), []}|Acc], + [{list_to_atom(CallbackMod),[]}|Acc], cur); prepare_user_configs(["and"|UserConfigs], Acc, _) -> prepare_user_configs(UserConfigs, Acc, new); -prepare_user_configs([ConfigString|UserConfigs], [{LastMod, LastList}|Acc], cur) -> +prepare_user_configs([ConfigString|UserConfigs], [{LastMod,LastList}|Acc], cur) -> prepare_user_configs(UserConfigs, [{LastMod, [ConfigString|LastList]}|Acc], cur); diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl new file mode 100644 index 0000000000..f3b6781971 --- /dev/null +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -0,0 +1,230 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. 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_conn_log_h). + +%%% +%%% A handler that can be connected to the error_logger event +%%% handler. Writes all ct connection events. See comments in +%%% cth_conn_log for more information. +%%% + +-include("ct_util.hrl"). + +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +-record(state, {group_leader,logs=[]}). + +-define(WIDTH,80). + +%%%----------------------------------------------------------------- +%%% Callbacks +init({GL,Logs}) -> + open_files(Logs,#state{group_leader=GL}). + +open_files([{ConnMod,{LogType,Logs}}|T],State) -> + case do_open_files(Logs,[]) of + {ok,Fds} -> + open_files(T,State#state{logs=[{ConnMod,{LogType,Fds}} | + State#state.logs]}); + Error -> + Error + end; +open_files([],State) -> + {ok,State}. + + +do_open_files([{Tag,File}|Logs],Acc) -> + case file:open(File, [write]) of + {ok,Fd} -> + do_open_files(Logs,[{Tag,Fd}|Acc]); + {error,Reason} -> + {error,{could_not_open_log,File,Reason}} + end; +do_open_files([],Acc) -> + {ok,lists:reverse(Acc)}. + +handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> + {ok, State}; +handle_event({_Type,_GL,{Pid,{ct_connection,Action,ConnName},Report}},State) -> + Info = conn_info(Pid,#conn_log{name=ConnName,action=Action}), + write_report(now(),Info,Report,State), + {ok, State}; +handle_event({_Type,_GL,{Pid,Info=#conn_log{},Report}},State) -> + write_report(now(),conn_info(Pid,Info),Report,State), + {ok, State}; +handle_event({error_report,_,{Pid,_,[{ct_connection,ConnName}|R]}},State) -> + %% Error reports from connection + write_error(now(),conn_info(Pid,#conn_log{name=ConnName}),R,State), + {ok, State}; +handle_event(_, State) -> + {ok, State}. + +handle_info(_, State) -> + {ok, State}. + +handle_call(_Query, State) -> + {ok, {error, bad_query}, State}. + +terminate(_,#state{logs=Logs}) -> + [file:close(Fd) || {_,_,Fds} <- Logs, Fd <- Fds], + ok. + + +%%%----------------------------------------------------------------- +%%% Writing reports +write_report(Time,#conn_log{module=ConnMod}=Info,Data,State) -> + {LogType,Fd} = get_log(Info,State), + io:format(Fd,"~n~s~s~s",[format_head(ConnMod,LogType,Time), + format_title(LogType,Info), + format_data(ConnMod,LogType,Data)]). + +write_error(Time,#conn_log{module=ConnMod}=Info,Report,State) -> + case get_log(Info,State) of + {html,_} -> + %% The error will anyway be written in the html log by the + %% sasl error handler, so don't write it again. + ok; + {LogType,Fd} -> + io:format(Fd,"~n~s~s~s",[format_head(ConnMod,LogType,Time," ERROR"), + format_title(LogType,Info), + format_error(LogType,Report)]) + end. + +get_log(Info,State) -> + case proplists:get_value(Info#conn_log.module,State#state.logs) of + {html,_} -> + {html,State#state.group_leader}; + {LogType,Fds} -> + {LogType,get_fd(Info,Fds)}; + undefined -> + {html,State#state.group_leader} + end. + +get_fd(#conn_log{name=undefined},Fds) -> + proplists:get_value(default,Fds); +get_fd(#conn_log{name=ConnName},Fds) -> + case proplists:get_value(ConnName,Fds) of + undefined -> + proplists:get_value(default,Fds); + Fd -> + Fd + end. + +%%%----------------------------------------------------------------- +%%% Formatting +format_head(ConnMod,LogType,Time) -> + format_head(ConnMod,LogType,Time,""). + +format_head(ConnMod,raw,Time,Text) -> + io_lib:format("~n~p, ~p~s, ",[now_to_time(Time),ConnMod,Text]); +format_head(ConnMod,_,Time,Text) -> + Head = pad_char_end(?WIDTH,pretty_head(now_to_time(Time),ConnMod,Text),$=), + io_lib:format("~n~s",[Head]). + +format_title(raw,#conn_log{client=Client}=Info) -> + io_lib:format("Client ~p ~s ~s",[Client,actionstr(Info),serverstr(Info)]); +format_title(_,Info) -> + Title = pad_char_end(?WIDTH,pretty_title(Info),$=), + io_lib:format("~n~s", [Title]). + +format_data(_,_,NoData) when NoData == ""; NoData == <<>> -> + ""; +format_data(ConnMod,LogType,Data) -> + ConnMod:format_data(LogType,Data). + +format_error(raw,Report) -> + io_lib:format("~n~p~n",[Report]); +format_error(pretty,Report) -> + [io_lib:format("~n ~p: ~p",[K,V]) || {K,V} <- Report]. + + + + +%%%----------------------------------------------------------------- +%%% Helpers +conn_info(LoggingProc, #conn_log{client=undefined} = ConnInfo) -> + conn_info(ConnInfo#conn_log{client=LoggingProc}); +conn_info(_, ConnInfo) -> + conn_info(ConnInfo). + +conn_info(#conn_log{client=Client, module=undefined} = ConnInfo) -> + case ets:lookup(ct_connections,Client) of + [#conn{address=Address,callback=Callback}] -> + ConnInfo#conn_log{address=Address,module=Callback}; + [] -> + ConnInfo + end; +conn_info(ConnInfo) -> + ConnInfo. + + +now_to_time({_,_,MicroS}=Now) -> + {calendar:now_to_local_time(Now),MicroS}. + +pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) -> + Text = string:to_upper(atom_to_list(ConnMod) ++ Text0), + io_lib:format("= ~s ==== ~s-~s-~p::~s:~s:~s,~s ", + [Text,t(D),month(Mo),Y,t(H),t(Mi),t(S), + micro2milli(MicroS)]). + +pretty_title(#conn_log{client=Client}=Info) -> + io_lib:format("= Client ~p ~s Server ~s ", + [Client,actionstr(Info),serverstr(Info)]). + +actionstr(#conn_log{action=send}) -> "----->"; +actionstr(#conn_log{action=recv}) -> "<-----"; +actionstr(#conn_log{action=open}) -> "opened session to"; +actionstr(#conn_log{action=close}) -> "closed session to"; +actionstr(_) -> "<---->". + +serverstr(#conn_log{name=undefined,address=Address}) -> + io_lib:format("~p",[Address]); +serverstr(#conn_log{name=Alias,address=Address}) -> + io_lib:format("~p(~p)",[Alias,Address]). + +month(1) -> "Jan"; +month(2) -> "Feb"; +month(3) -> "Mar"; +month(4) -> "Apr"; +month(5) -> "May"; +month(6) -> "Jun"; +month(7) -> "Jul"; +month(8) -> "Aug"; +month(9) -> "Sep"; +month(10) -> "Oct"; +month(11) -> "Nov"; +month(12) -> "Dec". + +micro2milli(X) -> + pad0(3,integer_to_list(X div 1000)). + +t(X) -> + pad0(2,integer_to_list(X)). + +pad0(N,Str) -> + M = length(Str), + lists:duplicate(N-M,$0) ++ Str. + +pad_char_end(N,Str,Char) -> + case length(lists:flatten(Str)) of + M when M<N -> Str ++ lists:duplicate(N-M,Char); + _ -> Str + end. diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl index 3e79898ad1..998be35fda 100644 --- a/lib/common_test/src/ct_event.erl +++ b/lib/common_test/src/ct_event.erl @@ -31,7 +31,7 @@ %% API -export([start_link/0, add_handler/0, add_handler/1, stop/0]). --export([notify/1, sync_notify/1]). +-export([notify/1, notify/2, sync_notify/1,sync_notify/2]). -export([is_alive/0]). %% gen_event callbacks @@ -90,6 +90,13 @@ notify(Event) -> end. %%-------------------------------------------------------------------- +%% Function: notify(Name,Data) -> ok +%% Description: Asynchronous notification to event manager. +%%-------------------------------------------------------------------- +notify(Name, Data) -> + notify(#event{ name = Name, data = Data}). + +%%-------------------------------------------------------------------- %% Function: sync_notify(Event) -> ok %% Description: Synchronous notification to event manager. %%-------------------------------------------------------------------- @@ -102,6 +109,13 @@ sync_notify(Event) -> end. %%-------------------------------------------------------------------- +%% Function: sync_notify(Name,Data) -> ok +%% Description: Synchronous notification to event manager. +%%-------------------------------------------------------------------- +sync_notify(Name,Data) -> + sync_notify(#event{ name = Name, data = Data}). + +%%-------------------------------------------------------------------- %% Function: is_alive() -> true | false %% Description: Check if Event Manager is alive. %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index cdd8a6a596..e8d5d4708b 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. 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 @@ -27,9 +27,10 @@ -export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, get_all_cases/1]). -export([report/2, warn/1, error_notification/4]). --export([get_logopts/0, format_comment/1, get_html_wrapper/3]). +-export([get_logopts/0, format_comment/1, get_html_wrapper/4]). --export([error_in_suite/1, ct_init_per_group/2, ct_end_per_group/2]). +-export([error_in_suite/1, init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2]). -export([make_all_conf/3, make_conf/5]). @@ -54,6 +55,7 @@ init_tc(Mod,Func,Config) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Config), + %% check if previous testcase was interpreted and has left %% a "dead" trace window behind - if so, kill it case ct_util:get_testdata(interpret) of @@ -63,50 +65,46 @@ init_tc(Mod,Func,Config) -> _ -> ok end, - %% check if we need to add defaults explicitly because - %% there's no init_per_suite exported from Mod - {InitFailed,DoInit} = - case ct_util:get_testdata(curr_tc) of - {Suite,{suite0_failed,_}=Failure} -> - {Failure,false}; - {?MODULE,_} -> % should not really happen - {false,false}; - {Suite,_} -> % Func is not 1st case in suite - {false,false}; - _ when Func == init_per_suite -> % defaults will be added anyway - {false,false}; - _ -> % first case in suite - {false,true} - end, - case InitFailed of - false -> - ct_util:set_testdata({curr_tc,{Suite,Func}}), + + case ct_util:get_testdata(curr_tc) of + {Suite,{suite0_failed,{require,Reason}}} -> + {skip,{require_failed_in_suite0,Reason}}; + {Suite,{suite0_failed,_}=Failure} -> + {skip,Failure}; + CurrTC -> + case CurrTC of + undefined -> + ct_util:set_testdata({curr_tc,[{Suite,Func}]}); + _ when is_list(CurrTC) -> + ct_util:update_testdata(curr_tc, + fun(Running) -> + [{Suite,Func}|Running] + end) + end, case ct_util:read_suite_data({seq,Suite,Func}) of undefined -> - init_tc1(Mod,Func,Config,DoInit); + init_tc1(Mod,Suite,Func,Config); Seq when is_atom(Seq) -> case ct_util:read_suite_data({seq,Suite,Seq}) of [Func|TCs] -> % this is the 1st case in Seq - %% make sure no cases in this seq are marked as failed - %% from an earlier execution in the same suite + %% make sure no cases in this seq are + %% marked as failed from an earlier execution + %% in the same suite lists:foreach( fun(TC) -> - ct_util:save_suite_data({seq,Suite,TC},Seq) + ct_util:save_suite_data({seq,Suite,TC}, + Seq) end, TCs); _ -> ok end, - init_tc1(Mod,Func,Config,DoInit); + init_tc1(Mod,Suite,Func,Config); {failed,Seq,BadFunc} -> {skip,{sequence_failed,Seq,BadFunc}} - end; - {_,{require,Reason}} -> - {skip,{require_failed_in_suite0,Reason}}; - _ -> - {skip,InitFailed} + end end. -init_tc1(?MODULE,error_in_suite,[Config0],_) when is_list(Config0) -> +init_tc1(?MODULE,_,error_in_suite,[Config0]) when is_list(Config0) -> ct_logs:init_tc(false), ct_event:notify(#event{name=tc_start, node=node(), @@ -117,14 +115,16 @@ init_tc1(?MODULE,error_in_suite,[Config0],_) when is_list(Config0) -> Reason -> {skip,Reason} end; -init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> + +init_tc1(Mod,Suite,Func,[Config0]) when is_list(Config0) -> Config1 = case ct_util:read_suite_data(last_saved_config) of - {{Mod,LastFunc},SavedConfig} -> % last testcase + {{Suite,LastFunc},SavedConfig} -> % last testcase [{saved_config,{LastFunc,SavedConfig}} | lists:keydelete(saved_config,1,Config0)]; - {{LastSuite,InitOrEnd},SavedConfig} when InitOrEnd == init_per_suite ; - InitOrEnd == end_per_suite -> + {{LastSuite,InitOrEnd}, + SavedConfig} when InitOrEnd == init_per_suite ; + InitOrEnd == end_per_suite -> %% last suite [{saved_config,{LastSuite,SavedConfig}} | lists:keydelete(saved_config,1,Config0)]; @@ -133,13 +133,14 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> end, ct_util:delete_suite_data(last_saved_config), Config = lists:keydelete(watchdog,1,Config1), - if Func /= init_per_suite, DoInit /= true -> - ok; - true -> + + if Func == init_per_suite -> %% delete all default values used in previous suite ct_config:delete_default_config(suite), %% release all name -> key bindings (once per suite) - ct_config:release_allocated() + ct_config:release_allocated(); + Func /= init_per_suite -> + ok end, GroupPath = ?val(tc_group_path, Config, []), @@ -154,9 +155,7 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> true -> ct_config:delete_default_config(testcase) end, - %% in case Mod == ct_framework, lookup the suite name - Suite = get_suite_name(Mod, Config), - case add_defaults(Mod,Func,AllGroups,DoInit) of + case add_defaults(Mod,Func,AllGroups) of Error = {suite0_failed,_} -> ct_logs:init_tc(false), ct_event:notify(#event{name=tc_start, @@ -166,35 +165,25 @@ init_tc1(Mod,Func,[Config0],DoInit) when is_list(Config0) -> {error,Error}; {SuiteInfo,MergeResult} -> case MergeResult of - {error,Reason} when DoInit == false -> + {error,Reason} -> ct_logs:init_tc(false), ct_event:notify(#event{name=tc_start, node=node(), data={Mod,FuncSpec}}), {skip,Reason}; _ -> - init_tc2(Mod,Func,SuiteInfo,MergeResult, - Config,DoInit) + init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) end end; -init_tc1(_Mod,_Func,Args,_DoInit) -> - {ok,Args}. -init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> - %% if first testcase fails when there's no init_per_suite - %% we must do suite/0 configurations before skipping test - MergedInfo = - case MergeResult of - {error,_} when DoInit == true -> - SuiteInfo; - _ -> - MergeResult - end, +init_tc1(_Mod,_Suite,_Func,Args) -> + {ok,Args}. +init_tc2(Mod,Suite,Func,SuiteInfo,MergeResult,Config) -> %% timetrap must be handled before require - MergedInfo1 = timetrap_first(MergedInfo, [], []), + MergedInfo = timetrap_first(MergeResult, [], []), %% tell logger to use specified style sheet - case lists:keysearch(stylesheet,1,MergedInfo++Config) of + case lists:keysearch(stylesheet,1,MergeResult++Config) of {value,{stylesheet,SSFile}} -> ct_logs:set_stylesheet(Func,add_data_dir(SSFile,Config)); _ -> @@ -209,7 +198,7 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> %% list of {Type,Bool} tuples, e.g. {telnet,true}), case ct_util:get_overridden_silenced_connections() of undefined -> - case lists:keysearch(silent_connections,1,MergedInfo++Config) of + case lists:keysearch(silent_connections,1,MergeResult++Config) of {value,{silent_connections,Conns}} -> ct_util:silence_connections(Conns); _ -> @@ -218,61 +207,67 @@ init_tc2(Mod,Func,SuiteInfo,MergeResult,Config,DoInit) -> Conns -> ct_util:silence_connections(Conns) end, - if Func /= init_per_suite, DoInit /= true -> - ct_logs:init_tc(false); - true -> - ct_logs:init_tc(true) - end, + ct_logs:init_tc(Func == init_per_suite), FuncSpec = group_or_func(Func,Config), ct_event:notify(#event{name=tc_start, node=node(), data={Mod,FuncSpec}}), - case catch configure(MergedInfo1,MergedInfo1,SuiteInfo, - {FuncSpec,DoInit},Config) of + case catch configure(MergedInfo,MergedInfo,SuiteInfo, + FuncSpec,[],Config) of {suite0_failed,Reason} -> - ct_util:set_testdata({curr_tc,{Mod,{suite0_failed,{require,Reason}}}}), + ct_util:set_testdata({curr_tc,{Mod,{suite0_failed, + {require,Reason}}}}), {skip,{require_failed_in_suite0,Reason}}; {error,Reason} -> {auto_skip,{require_failed,Reason}}; {'EXIT',Reason} -> {auto_skip,Reason}; - {ok,FinalConfig} -> - case MergeResult of - {error,Reason} -> - %% suite0 configure finished now, report that - %% first test case actually failed - {skip,Reason}; - _ -> - case get('$test_server_framework_test') of - undefined -> - ct_suite_init(Mod, FuncSpec, FinalConfig); - Fun -> - case Fun(init_tc, FinalConfig) of - NewConfig when is_list(NewConfig) -> - {ok,NewConfig}; - Else -> - Else - end + {ok,PostInitHook,Config1} -> + case get('$test_server_framework_test') of + undefined -> + ct_suite_init(Suite, FuncSpec, PostInitHook, Config1); + Fun -> + PostInitHookResult = do_post_init_hook(PostInitHook, + Config1), + case Fun(init_tc, [PostInitHookResult ++ Config1]) of + NewConfig when is_list(NewConfig) -> + {ok,NewConfig}; + Else -> + Else end end end. -ct_suite_init(Mod, Func, [Config]) when is_list(Config) -> - case ct_hooks:init_tc( Mod, Func, Config) of +ct_suite_init(Suite, Func, PostInitHook, Config) when is_list(Config) -> + case ct_hooks:init_tc(Suite, Func, Config) of NewConfig when is_list(NewConfig) -> - {ok, [NewConfig]}; + PostInitHookResult = do_post_init_hook(PostInitHook, NewConfig), + {ok, [PostInitHookResult ++ NewConfig]}; Else -> Else end. -add_defaults(Mod,Func, GroupPath, DoInit) -> +do_post_init_hook(PostInitHook, Config) -> + lists:flatmap(fun({Tag,Fun}) -> + case lists:keysearch(Tag,1,Config) of + {value,_} -> + []; + false -> + case Fun() of + {error,_} -> []; + Result -> [{Tag,Result}] + end + end + end, PostInitHook). + +add_defaults(Mod,Func, GroupPath) -> Suite = get_suite_name(Mod, GroupPath), case (catch Suite:suite()) of {'EXIT',{undef,_}} -> SuiteInfo = merge_with_suite_defaults(Suite,[]), SuiteInfoNoCTH = [I || I <- SuiteInfo, element(1,I) =/= ct_hooks], - case add_defaults1(Mod,Func, GroupPath, SuiteInfoNoCTH, DoInit) of + case add_defaults1(Mod,Func, GroupPath, SuiteInfoNoCTH) of Error = {error,_} -> {SuiteInfo,Error}; MergedInfo -> {SuiteInfo,MergedInfo} end; @@ -292,7 +287,7 @@ add_defaults(Mod,Func, GroupPath, DoInit) -> SuiteInfoNoCTH = [I || I <- SuiteInfo1, element(1,I) =/= ct_hooks], case add_defaults1(Mod,Func, GroupPath, - SuiteInfoNoCTH, DoInit) of + SuiteInfoNoCTH) of Error = {error,_} -> {SuiteInfo1,Error}; MergedInfo -> {SuiteInfo1,MergedInfo} end; @@ -313,7 +308,7 @@ add_defaults(Mod,Func, GroupPath, DoInit) -> {suite0_failed,bad_return_value} end. -add_defaults1(Mod,Func, GroupPath, SuiteInfo, DoInit) -> +add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> Suite = get_suite_name(Mod, GroupPath), %% GroupPathInfo (for subgroup on level X) = %% [LevelXGroupInfo, LevelX-1GroupInfo, ..., TopLevelGroupInfo] @@ -325,8 +320,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo, DoInit) -> _ -> [] end end, GroupPath), - Args = if Func == init_per_group; Func == ct_init_per_group; - Func == end_per_group; Func == ct_end_per_group -> + Args = if Func == init_per_group ; Func == end_per_group -> [?val(name, hd(GroupPath))]; true -> [] @@ -347,7 +341,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo, DoInit) -> (default_config == element(1,SDDef)))], case check_for_clashes(TestCaseInfo, GroupPathInfo, SuiteReqs) of [] -> - add_defaults2(Mod,Func, TCAndGroupInfo,SuiteInfo,SuiteReqs, DoInit); + add_defaults2(Mod,Func, TCAndGroupInfo,SuiteInfo,SuiteReqs); Clashes -> {error,{config_name_already_in_use,Clashes}} end. @@ -372,16 +366,12 @@ get_suite_name(Mod, _) -> Mod. %% Check that alias names are not already in use -check_for_clashes(TCInfo, GrPathInfo, SuiteInfo) -> - {CurrGrInfo,SearchIn} = case GrPathInfo of - [] -> {[],[SuiteInfo]}; - [Curr|Path] -> {Curr,[SuiteInfo|Path]} - end, +check_for_clashes(TCInfo, [CurrGrInfo|Path], SuiteInfo) -> ReqNames = fun(Info) -> [element(2,R) || R <- Info, size(R) == 3, require == element(1,R)] end, - ExistingNames = lists:flatten([ReqNames(L) || L <- SearchIn]), + ExistingNames = lists:flatten([ReqNames(L) || L <- [SuiteInfo|Path]]), CurrGrReqNs = ReqNames(CurrGrInfo), GrClashes = [Name || Name <- CurrGrReqNs, true == lists:member(Name, ExistingNames)], @@ -421,34 +411,25 @@ keysmember([Key,Pos|Next], List) -> keysmember([], _) -> true. -add_defaults2(Mod,init_per_suite, IPSInfo, SuiteInfo,SuiteReqs, false) -> - add_defaults2(Mod,init_per_suite, IPSInfo, SuiteInfo,SuiteReqs, true); +add_defaults2(_Mod,init_per_suite, IPSInfo, SuiteInfo,SuiteReqs) -> + Info = lists:flatten([IPSInfo, SuiteReqs]), + lists:flatten([Info,remove_info_in_prev(Info, [SuiteInfo])]); -add_defaults2(_Mod,IPG, IPGAndGroupInfo, SuiteInfo,SuiteReqs, DoInit) when - IPG == init_per_group ; IPG == ct_init_per_group -> - %% If DoInit == true, we have to process the suite() list, otherwise - %% it has already been handled (see clause for init_per_suite) - case DoInit of - true -> - %% note: we know for sure this is a top level group - Info = lists:flatten([IPGAndGroupInfo, SuiteReqs]), - Info ++ remove_info_in_prev(Info, [SuiteInfo]); - false -> - SuiteInfo1 = - remove_info_in_prev(lists:flatten([IPGAndGroupInfo, - SuiteReqs]), [SuiteInfo]), - %% don't require terms in prev groups (already processed) - case IPGAndGroupInfo of - [IPGInfo] -> - lists:flatten([IPGInfo,SuiteInfo1]); - [IPGInfo | [CurrGroupInfo | PrevGroupInfo]] -> - PrevGroupInfo1 = delete_require_terms(PrevGroupInfo), - lists:flatten([IPGInfo,CurrGroupInfo,PrevGroupInfo1, - SuiteInfo1]) - end +add_defaults2(_Mod,init_per_group, IPGAndGroupInfo, SuiteInfo,SuiteReqs) -> + SuiteInfo1 = + remove_info_in_prev(lists:flatten([IPGAndGroupInfo, + SuiteReqs]), [SuiteInfo]), + %% don't require terms in prev groups (already processed) + case IPGAndGroupInfo of + [IPGInfo] -> + lists:flatten([IPGInfo,SuiteInfo1]); + [IPGInfo | [CurrGroupInfo | PrevGroupInfo]] -> + PrevGroupInfo1 = delete_require_terms(PrevGroupInfo), + lists:flatten([IPGInfo,CurrGroupInfo,PrevGroupInfo1, + SuiteInfo1]) end; -add_defaults2(_Mod,_Func, TCAndGroupInfo, SuiteInfo,SuiteReqs, false) -> +add_defaults2(_Mod,_Func, TCAndGroupInfo, SuiteInfo,SuiteReqs) -> %% Include require elements from test case info and current group, %% but not from previous groups or suite/0 (since we've already required %% those vars). Let test case info elements override group and suite @@ -463,14 +444,7 @@ add_defaults2(_Mod,_Func, TCAndGroupInfo, SuiteInfo,SuiteReqs, false) -> PrevGroupInfo1 = delete_require_terms(PrevGroupInfo), lists:flatten([TCInfo,CurrGroupInfo,PrevGroupInfo1, SuiteInfo1]) - end; - -add_defaults2(_Mod,_Func, TCInfo, SuiteInfo,SuiteReqs, true) -> - %% Here we have to process the suite info list also (no call to - %% init_per_suite before this first test case). This TC can't belong - %% to a group, or the clause for (ct_)init_per_group would've caught this. - Info = lists:flatten([TCInfo, SuiteReqs]), - lists:flatten([Info,remove_info_in_prev(Info, [SuiteInfo])]). + end. delete_require_terms([Info | Prev]) -> Info1 = [T || T <- Info, @@ -506,15 +480,16 @@ timetrap_first([],Info,[]) -> timetrap_first([],Info,Found) -> ?rev(Found) ++ ?rev(Info). -configure([{require,Required}|Rest],Info,SuiteInfo,Scope,Config) -> +configure([{require,Required}|Rest], + Info,SuiteInfo,Scope,PostInitHook,Config) -> case ct:require(Required) of ok -> - configure(Rest,Info,SuiteInfo,Scope,Config); + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); Error = {error,Reason} -> case required_default('_UNDEF',Required,Info, SuiteInfo,Scope) of ok -> - configure(Rest,Info,SuiteInfo,Scope,Config); + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); _ -> case lists:keymember(Required,2,SuiteInfo) of true -> @@ -524,14 +499,15 @@ configure([{require,Required}|Rest],Info,SuiteInfo,Scope,Config) -> end end end; -configure([{require,Name,Required}|Rest],Info,SuiteInfo,Scope,Config) -> +configure([{require,Name,Required}|Rest], + Info,SuiteInfo,Scope,PostInitHook,Config) -> case ct:require(Name,Required) of ok -> - configure(Rest,Info,SuiteInfo,Scope,Config); + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); Error = {error,Reason} -> case required_default(Name,Required,Info,SuiteInfo,Scope) of ok -> - configure(Rest,Info,SuiteInfo,Scope,Config); + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); _ -> case lists:keymember(Name,2,SuiteInfo) of true -> @@ -541,35 +517,33 @@ configure([{require,Name,Required}|Rest],Info,SuiteInfo,Scope,Config) -> end end end; -configure([{timetrap,off}|Rest],Info,SuiteInfo,Scope,Config) -> - configure(Rest,Info,SuiteInfo,Scope,Config); -configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,Config) -> - Dog = test_server:timetrap(Time), - configure(Rest,Info,SuiteInfo,Scope,[{watchdog,Dog}|Config]); -configure([{ct_hooks, Hook} | Rest], Info, SuiteInfo, Scope, Config) -> - configure(Rest, Info, SuiteInfo, Scope, [{ct_hooks, Hook} | Config]); -configure([_|Rest],Info,SuiteInfo,Scope,Config) -> - configure(Rest,Info,SuiteInfo,Scope,Config); -configure([],_,_,_,Config) -> - {ok,[Config]}. +configure([{timetrap,off}|Rest],Info,SuiteInfo,Scope,PostInitHook,Config) -> + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); +configure([{timetrap,Time}|Rest],Info,SuiteInfo,Scope,PostInitHook,Config) -> + PostInitHook1 = + [{watchdog,fun() -> case test_server:get_timetrap_info() of + undefined -> + test_server:timetrap(Time); + _ -> + {error,already_set} + end + end} | PostInitHook], + configure(Rest,Info,SuiteInfo,Scope,PostInitHook1,Config); +configure([{ct_hooks,Hook}|Rest],Info,SuiteInfo,Scope,PostInitHook,Config) -> + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,[{ct_hooks,Hook}|Config]); +configure([_|Rest],Info,SuiteInfo,Scope,PostInitHook,Config) -> + configure(Rest,Info,SuiteInfo,Scope,PostInitHook,Config); +configure([],_,_,_,PostInitHook,Config) -> + {ok,PostInitHook,Config}. %% the require element in Info may come from suite/0 and %% should be scoped 'suite', or come from the group info %% function and be scoped 'group', or come from the testcase %% info function and then be scoped 'testcase' -required_default(Name,Key,Info,SuiteInfo,{FuncSpec,true}) -> - case try_set_default(Name,Key,SuiteInfo,suite) of - ok -> - ok; - _ -> - required_default(Name,Key,Info,[],{FuncSpec,false}) - end; -required_default(Name,Key,Info,_,{init_per_suite,_}) -> +required_default(Name,Key,Info,_,init_per_suite) -> try_set_default(Name,Key,Info,suite); -required_default(Name,Key,Info,_,{{init_per_group,GrName,_},_}) -> - try_set_default(Name,Key,Info,{group,GrName}); -required_default(Name,Key,Info,_,{{ct_init_per_group,GrName,_},_}) -> +required_default(Name,Key,Info,_,{init_per_group,GrName,_}) -> try_set_default(Name,Key,Info,{group,GrName}); required_default(Name,Key,Info,_,_FuncSpec) -> try_set_default(Name,Key,Info,testcase). @@ -621,10 +595,11 @@ end_tc(Mod,Func,{Result,[Args]}, Return) -> end_tc(Mod,Func,self(),Result,Args,Return). end_tc(Mod,Func,TCPid,Result,Args,Return) -> - case lists:keysearch(watchdog,1,Args) of - {value,{watchdog,Dog}} -> test_server:timetrap_cancel(Dog); - false -> ok - end, + %% in case Mod == ct_framework, lookup the suite name + Suite = get_suite_name(Mod, Args), + + test_server:timetrap_cancel(), + %% save the testcase process pid so that it can be used %% to look up the attached trace window later case ct_util:get_testdata(interpret) of @@ -636,61 +611,76 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> end, ct_util:delete_testdata(comment), ct_util:delete_suite_data(last_saved_config), - FuncSpec = - case group_or_func(Func,Args) of - {_,GroupName,_Props} = Group -> - if Func == end_per_group; Func == ct_end_per_group -> - ct_config:delete_default_config({group,GroupName}); - true -> ok - end, - case lists:keysearch(save_config,1,Args) of - {value,{save_config,SaveConfig}} -> - ct_util:save_suite_data( - last_saved_config, - {Mod,{group,GroupName}}, - SaveConfig), - Group; - false -> - Group - end; - _ -> - case lists:keysearch(save_config,1,Args) of - {value,{save_config,SaveConfig}} -> - ct_util:save_suite_data(last_saved_config, - {Mod,Func},SaveConfig), - Func; - false -> - Func - end - end, - ct_util:reset_silent_connections(), + + FuncSpec = case group_or_func(Func,Args) of + {_,_GroupName,_} = Group -> Group; + _ -> Func + end, case get('$test_server_framework_test') of undefined -> {FinalResult,FinalNotify} = case ct_hooks:end_tc( - Mod, FuncSpec, Args, Result, Return) of + Suite, FuncSpec, Args, Result, Return) of '$ct_no_change' -> {ok,Result}; FinalResult1 -> {FinalResult1,FinalResult1} end, - % send sync notification so that event handlers may print - % in the log file before it gets closed + %% send sync notification so that event handlers may print + %% in the log file before it gets closed ct_event:sync_notify(#event{name=tc_done, node=node(), data={Mod,FuncSpec, tag_cth(FinalNotify)}}); Fun -> - % send sync notification so that event handlers may print - % in the log file before it gets closed + %% send sync notification so that event handlers may print + %% in the log file before it gets closed ct_event:sync_notify(#event{name=tc_done, node=node(), data={Mod,FuncSpec,tag(Result)}}), FinalResult = Fun(end_tc, Return) + end, + + case FuncSpec of + {_,GroupName,_Props} -> + if Func == end_per_group -> + ct_config:delete_default_config({group,GroupName}); + true -> ok + end, + case lists:keysearch(save_config,1,Args) of + {value,{save_config,SaveConfig}} -> + ct_util:save_suite_data(last_saved_config, + {Suite,{group,GroupName}}, + SaveConfig); + false -> + ok + end; + _ -> + case lists:keysearch(save_config,1,Args) of + {value,{save_config,SaveConfig}} -> + ct_util:save_suite_data(last_saved_config, + {Suite,Func},SaveConfig); + false -> + ok + end end, - + ct_util:reset_silent_connections(), + + %% reset the curr_tc state, or delete this TC from the list of + %% executing cases (if in a parallel group) + ClearCurrTC = fun(Running = [_,_|_]) -> + lists:delete({Mod,Func},Running); + ({_,{suite0_failed,_}}) -> + undefined; + ([{_,CurrTC}]) when CurrTC == Func -> + undefined; + (undefined) -> + undefined + end, + ct_util:update_testdata(curr_tc,ClearCurrTC), + case FinalResult of {skip,{sequence_failed,_,_}} -> %% ct_logs:init_tc is never called for a skipped test case @@ -706,7 +696,7 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> end, case Func of end_per_suite -> - ct_util:match_delete_suite_data({seq,Mod,'_'}); + ct_util:match_delete_suite_data({seq,Suite,'_'}); _ -> ok end, @@ -864,9 +854,7 @@ mark_as_failed1(_,_,_,[]) -> ok. group_or_func(Func, Config) when Func == init_per_group; - Func == end_per_group; - Func == ct_init_per_group; - Func == ct_end_per_group -> + Func == end_per_group -> case ?val(tc_group_properties, Config) of undefined -> {Func,unknown,[]}; @@ -1209,8 +1197,8 @@ make_conf(Mod, Name, Props, TestSpec) -> "end_per_group/2 missing for group " "~p in ~p, using default.", [Name,Mod]), - {{?MODULE,ct_init_per_group}, - {?MODULE,ct_end_per_group}, + {{?MODULE,init_per_group}, + {?MODULE,end_per_group}, [{suite,Mod}]} end, {conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}. @@ -1470,22 +1458,31 @@ error_in_suite(Config) -> Reason = test_server:lookup_config(error,Config), exit(Reason). +%% if init_per_suite and end_per_suite are missing in the suite, +%% these will be called instead (without any trace of them in the +%% log files), only so that it's possible to call hook functions +%% for configuration +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + %% if the group config functions are missing in the suite, %% use these instead -ct_init_per_group(GroupName, Config) -> +init_per_group(GroupName, Config) -> ct:comment(io_lib:format("start of ~p", [GroupName])), ct_logs:log("TEST INFO", "init_per_group/2 for ~w missing " "in suite, using default.", [GroupName]), Config. -ct_end_per_group(GroupName, _) -> +end_per_group(GroupName, _) -> ct:comment(io_lib:format("end of ~p", [GroupName])), ct_logs:log("TEST INFO", "end_per_group/2 for ~w missing " "in suite, using default.", [GroupName]), ok. - %%%----------------------------------------------------------------- %%% @spec report(What,Data) -> ok @@ -1562,10 +1559,6 @@ report(What,Data) -> ok; {end_per_group,_} -> ok; - {ct_init_per_group,_} -> - ok; - {ct_end_per_group,_} -> - ok; {_,ok} -> add_to_stats(ok); {_,{skipped,{failed,{_,init_per_testcase,_}}}} -> @@ -1602,8 +1595,7 @@ report(What,Data) -> data=Data}), ct_hooks:on_tc_skip(What, Data), if Case /= end_per_suite, - Case /= end_per_group, - Case /= ct_end_per_group -> + Case /= end_per_group -> add_to_stats(auto_skipped); true -> ok @@ -1689,5 +1681,5 @@ format_comment(Comment) -> %%%----------------------------------------------------------------- %%% @spec get_html_wrapper(TestName, PrintLabel, Cwd) -> Header -get_html_wrapper(TestName, PrintLabel, Cwd) -> - ct_logs:get_ts_html_wrapper(TestName, PrintLabel, Cwd). +get_html_wrapper(TestName, PrintLabel, Cwd, TableCols) -> + ct_logs:get_ts_html_wrapper(TestName, PrintLabel, Cwd, TableCols). diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 5aab4dd2dd..1f01d84601 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -27,7 +27,7 @@ -compile(export_all). -export([start/4, stop/1]). --export([call/2, do_within_time/2]). +-export([call/2, call/3, return/2, do_within_time/2]). -ifdef(debug). -define(dbg,true). @@ -39,17 +39,24 @@ name, address, init_data, + reconnect = true, + forward = false, + use_existing = true, + old = false, conn_pid, cb_state, ct_util_server}). %%%----------------------------------------------------------------- -%%% @spec start(Name,Address,InitData,CallbackMod) -> +%%% @spec start(Address,InitData,CallbackMod,Opts) -> %%% {ok,Handle} | {error,Reason} %%% Name = term() %%% CallbackMod = atom() %%% InitData = term() %%% Address = term() +%%% Opts = [Opt] +%%% Opt = {name,Name} | {use_existing_connection,boolean()} | +%%% {reconnect,boolean()} | {forward_messages,boolean()} %%% %%% @doc Open a connection and start the generic connection owner process. %%% @@ -60,50 +67,67 @@ %%% <code>InitData</code> and returna %%% <code>{ok,ConnectionPid,State}</code> or %%% <code>{error,Reason}</code>.</p> +%%% +%%% If no name is given, the <code>Name</code> argument in init/3 will +%%% have the value <code>undefined</code>. +%%% +%%% The callback modules must also export +%%% ``` +%%% handle_msg(Msg,From,State) -> {reply,Reply,State} | +%%% {noreply,State} | +%%% {stop,Reply,State} +%%% terminate(ConnectionPid,State) -> term() +%%% close(Handle) -> term() +%%% ''' +%%% +%%% The <code>close/1</code> callback function is actually a callback +%%% for ct_util, for closing registered connections when +%%% ct_util_server is terminated. <code>Handle</code> is the Pid of +%%% the ct_gen_conn process. +%%% +%%% If option <code>reconnect</code> is <code>true</code>, then the +%%% callback must also export +%%% ``` +%%% reconnect(Address,State) -> {ok,ConnectionPid,State} +%%% ''' +%%% +%%% If option <code>forward_messages</code> is <ocde>true</code>, then +%%% the callback must also export +%%% ``` +%%% handle_msg(Msg,State) -> {noreply,State} | {stop,State} +%%% ''' +%%% +%%% An old interface still exists. This is used by ct_telnet, ct_ftp +%%% and ct_ssh. The start function then has an explicit +%%% <code>Name</code> argument, and no <code>Opts</code> argument. The +%%% callback must export: +%%% +%%% ``` +%%% init(Name,Address,InitData) -> {ok,ConnectionPid,State} +%%% handle_msg(Msg,State) -> {Reply,State} +%%% reconnect(Address,State) -> {ok,ConnectionPid,State} +%%% terminate(ConnectionPid,State) -> term() +%%% close(Handle) -> term() +%%% ''' +%%% +start(Address,InitData,CallbackMod,Opts) when is_list(Opts) -> + do_start(Address,InitData,CallbackMod,Opts); start(Name,Address,InitData,CallbackMod) -> - case ct_util:does_connection_exist(Name,Address,CallbackMod) of - {ok,Pid} -> - log("ct_gen_conn:start","Using existing connection!\n",[]), - {ok,Pid}; - false -> - Self = self(), - Pid = spawn(fun() -> - init_gen(Self, #gen_opts{callback=CallbackMod, - name=Name, - address=Address, - init_data=InitData}) - end), - MRef = erlang:monitor(process,Pid), - receive - {connected,Pid} -> - erlang:demonitor(MRef, [flush]), - ct_util:register_connection(Name,Address,CallbackMod,Pid), - {ok,Pid}; - {Error,Pid} -> - receive {'DOWN',MRef,process,_,_} -> ok end, - Error; - {'DOWN',MRef,process,_,Reason} -> - log("ct_gen_conn:start", - "Connection process died: ~p\n", - [Reason]), - {error,{connection_process_died,Reason}} - end - end. - + do_start(Address,InitData,CallbackMod,[{name,Name},{old,true}]). %%%----------------------------------------------------------------- %%% @spec stop(Handle) -> ok %%% Handle = handle() %%% -%%% @doc Close the telnet connection and stop the process managing it. +%%% @doc Close the connection and stop the process managing it. stop(Pid) -> - call(Pid,stop). + call(Pid,stop,5000). %%%----------------------------------------------------------------- %%% @spec log(Heading,Format,Args) -> ok %%% %%% @doc Log activities on the current connection (tool-internal use only). -%%% @see ct_logs:log/3 +%%% @see ct_logs:log/3 log(Heading,Format,Args) -> log(log,[Heading,Format,Args]). @@ -111,7 +135,7 @@ log(Heading,Format,Args) -> %%% @spec start_log(Heading) -> ok %%% %%% @doc Log activities on the current connection (tool-internal use only). -%%% @see ct_logs:start_log/1 +%%% @see ct_logs:start_log/1 start_log(Heading) -> log(start_log,[Heading]). @@ -119,7 +143,7 @@ start_log(Heading) -> %%% @spec cont_log(Format,Args) -> ok %%% %%% @doc Log activities on the current connection (tool-internal use only). -%%% @see ct_logs:cont_log/2 +%%% @see ct_logs:cont_log/2 cont_log(Format,Args) -> log(cont_log,[Format,Args]). @@ -127,7 +151,7 @@ cont_log(Format,Args) -> %%% @spec end_log() -> ok %%% %%% @doc Log activities on the current connection (tool-internal use only). -%%% @see ct_logs:end_log/0 +%%% @see ct_logs:end_log/0 end_log() -> log(end_log,[]). @@ -148,10 +172,10 @@ do_within_time(Fun,Timeout) -> Silent = get(silent), TmpPid = spawn_link(fun() -> put(silent,Silent), R = Fun(), - Self ! {self(),R} + Self ! {self(),R} end), ConnPid = get(conn_pid), - receive + receive {TmpPid,Result} -> Result; {'EXIT',ConnPid,_Reason}=M -> @@ -159,7 +183,7 @@ do_within_time(Fun,Timeout) -> exit(TmpPid,kill), self() ! M, {error,connection_closed} - after + after Timeout -> exit(TmpPid,kill), receive @@ -176,12 +200,66 @@ do_within_time(Fun,Timeout) -> %%%================================================================= %%% Internal functions -call(Pid,Msg) -> +do_start(Address,InitData,CallbackMod,Opts0) -> + Opts = check_opts(Opts0,#gen_opts{callback=CallbackMod, + address=Address, + init_data=InitData}), + case ct_util:does_connection_exist(Opts#gen_opts.name, + Address,CallbackMod) of + {ok,Pid} when Opts#gen_opts.use_existing -> + log("ct_gen_conn:start","Using existing connection!\n",[]), + {ok,Pid}; + {ok,Pid} when not Opts#gen_opts.use_existing -> + {error,{connection_exists,Pid}}; + false -> + do_start(Opts) + end. + +do_start(Opts) -> + Self = self(), + Pid = spawn(fun() -> init_gen(Self, Opts) end), + MRef = erlang:monitor(process,Pid), + receive + {connected,Pid} -> + erlang:demonitor(MRef, [flush]), + ct_util:register_connection(Opts#gen_opts.name, Opts#gen_opts.address, + Opts#gen_opts.callback, Pid), + {ok,Pid}; + {Error,Pid} -> + receive {'DOWN',MRef,process,_,_} -> ok end, + Error; + {'DOWN',MRef,process,_,Reason} -> + log("ct_gen_conn:start", + "Connection process died: ~p\n", + [Reason]), + {error,{connection_process_died,Reason}} + end. + +check_opts(Opts0) -> + check_opts(Opts0,#gen_opts{}). + +check_opts([{name,Name}|T],Opts) -> + check_opts(T,Opts#gen_opts{name=Name}); +check_opts([{reconnect,Bool}|T],Opts) -> + check_opts(T,Opts#gen_opts{reconnect=Bool}); +check_opts([{forward_messages,Bool}|T],Opts) -> + check_opts(T,Opts#gen_opts{forward=Bool}); +check_opts([{use_existing_connection,Bool}|T],Opts) -> + check_opts(T,Opts#gen_opts{use_existing=Bool}); +check_opts([{old,Bool}|T],Opts) -> + check_opts(T,Opts#gen_opts{old=Bool}); +check_opts([],Opts) -> + Opts. + +call(Pid, Msg) -> + call(Pid, Msg, infinity). + +call(Pid, Msg, Timeout) -> MRef = erlang:monitor(process,Pid), Ref = make_ref(), Pid ! {Msg,{self(),Ref}}, receive - {Ref, Result} -> + {Ref, Result} -> erlang:demonitor(MRef, [flush]), case Result of {retry,_Data} -> @@ -189,8 +267,15 @@ call(Pid,Msg) -> Other -> Other end; - {'DOWN',MRef,process,_,Reason} -> + {'DOWN',MRef,process,_,Reason} -> {error,{process_down,Pid,Reason}} + after Timeout -> + erlang:demonitor(MRef, [flush]), + log("ct_gen_conn", + "Connection process ~p not responding. Killing now!", + [Pid]), + exit(Pid, kill), + {error,{process_down,Pid,forced_termination}} end. return({To,Ref},Result) -> @@ -198,36 +283,47 @@ return({To,Ref},Result) -> init_gen(Parent,Opts) -> process_flag(trap_exit,true), - CtUtilServer = whereis(ct_util_server), - link(CtUtilServer), put(silent,false), - case catch (Opts#gen_opts.callback):init(Opts#gen_opts.name, - Opts#gen_opts.address, - Opts#gen_opts.init_data) of + try (Opts#gen_opts.callback):init(Opts#gen_opts.name, + Opts#gen_opts.address, + Opts#gen_opts.init_data) of {ok,ConnPid,State} when is_pid(ConnPid) -> link(ConnPid), put(conn_pid,ConnPid), + CtUtilServer = whereis(ct_util_server), + link(CtUtilServer), Parent ! {connected,self()}, loop(Opts#gen_opts{conn_pid=ConnPid, cb_state=State, ct_util_server=CtUtilServer}); {error,Reason} -> Parent ! {{error,Reason},self()} + catch + throw:{error,Reason} -> + Parent ! {{error,Reason},self()} end. loop(Opts) -> receive {'EXIT',Pid,Reason} when Pid==Opts#gen_opts.conn_pid -> - log("Connection down!\nOpening new!","Reason: ~p\nAddress: ~p\n", - [Reason,Opts#gen_opts.address]), - case reconnect(Opts) of - {ok, NewPid, NewState} -> - link(NewPid), - put(conn_pid,NewPid), - loop(Opts#gen_opts{conn_pid=NewPid,cb_state=NewState}); - Error -> + case Opts#gen_opts.reconnect of + true -> + log("Connection down!\nOpening new!", + "Reason: ~p\nAddress: ~p\n", + [Reason,Opts#gen_opts.address]), + case reconnect(Opts) of + {ok, NewPid, NewState} -> + link(NewPid), + put(conn_pid,NewPid), + loop(Opts#gen_opts{conn_pid=NewPid,cb_state=NewState}); + Error -> + ct_util:unregister_connection(self()), + log("Reconnect failed. Giving up!","Reason: ~p\n", + [Error]) + end; + false -> ct_util:unregister_connection(self()), - log("Reconnect failed. Giving up!","Reason: ~p\n",[Error]) + log("Connection closed!","Reason: ~p\n",[Reason]) end; {'EXIT',Pid,Reason} -> case Opts#gen_opts.ct_util_server of @@ -252,24 +348,40 @@ loop(Opts) -> loop(Opts); {{retry,{_Error,_Name,_CPid,Msg}}, From} -> log("Rerunning command","Connection reestablished. Rerunning command...",[]), - {Return,NewState} = + {Return,NewState} = (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state), return(From, Return), - loop(Opts#gen_opts{cb_state=NewState}); - {Msg,From={Pid,_Ref}} when is_pid(Pid) -> - {Return,NewState} = + loop(Opts#gen_opts{cb_state=NewState}); + {Msg,From={Pid,_Ref}} when is_pid(Pid), Opts#gen_opts.old==true -> + {Return,NewState} = (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state), return(From, Return), - loop(Opts#gen_opts{cb_state=NewState}) + loop(Opts#gen_opts{cb_state=NewState}); + {Msg,From={Pid,_Ref}} when is_pid(Pid) -> + case (Opts#gen_opts.callback):handle_msg(Msg,From, + Opts#gen_opts.cb_state) of + {reply,Reply,NewState} -> + return(From,Reply), + loop(Opts#gen_opts{cb_state=NewState}); + {noreply,NewState} -> + loop(Opts#gen_opts{cb_state=NewState}); + {stop,Reply,NewState} -> + ct_util:unregister_connection(self()), + (Opts#gen_opts.callback):terminate(Opts#gen_opts.conn_pid, + NewState), + return(From,Reply) + end; + Msg when Opts#gen_opts.forward==true -> + case (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state) of + {noreply,NewState} -> + loop(Opts#gen_opts{cb_state=NewState}); + {stop,NewState} -> + ct_util:unregister_connection(self()), + (Opts#gen_opts.callback):terminate(Opts#gen_opts.conn_pid, + NewState) + end end. -nozero({ok,S}) when is_list(S) -> - {ok,[C || C <- S, - C=/=0, - C=/=13]}; -nozero(M) -> - M. - reconnect(Opts) -> (Opts#gen_opts.callback):reconnect(Opts#gen_opts.address, Opts#gen_opts.cb_state). @@ -277,10 +389,8 @@ reconnect(Opts) -> log(Func,Args) -> case get(silent) of - true when not ?dbg-> + true when not ?dbg-> ok; _ -> apply(ct_logs,Func,Args) end. - - diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index c42adbbdd9..d0432b604d 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. 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 @@ -70,8 +70,7 @@ terminate(Hooks) -> {skip, Reason :: term()} | {auto_skip, Reason :: term()} | {fail, Reason :: term()}. -init_tc(ct_framework, _Func, Args) -> - Args; + init_tc(Mod, init_per_suite, Config) -> Info = try proplists:get_value(ct_hooks, Mod:suite(),[]) of List when is_list(List) -> @@ -104,27 +103,21 @@ init_tc(_Mod, TC, Config) -> {auto_skip, Reason :: term()} | {fail, Reason :: term()} | ok | '$ct_no_change'. -end_tc(ct_framework, _Func, _Args, Result, _Return) -> - Result; end_tc(Mod, init_per_suite, Config, _Result, Return) -> call(fun call_generic/3, Return, [post_init_per_suite, Mod, Config], '$ct_no_change'); - end_tc(Mod, end_per_suite, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config], '$ct_no_change'); - end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config], '$ct_no_change'); - end_tc(Mod, {end_per_group, GroupName, Opts}, Config, Result, _Return) -> Res = call(fun call_generic/3, Result, [post_end_per_group, GroupName, Config], '$ct_no_change'), maybe_stop_locker(Mod, GroupName,Opts), Res; - end_tc(_Mod, TC, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], '$ct_no_change'). @@ -199,12 +192,12 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> case lists:keyfind(NewId, #ct_hook_config.id, Hooks) of false when NextFun =:= undefined -> {Hooks ++ [NewHook], - [{NewId, call_init} | Rest]}; + Rest ++ [{NewId, call_init}]}; ExistingHook when is_tuple(ExistingHook) -> {Hooks, Rest}; _ -> {Hooks ++ [NewHook], - [{NewId, call_init}, {NewId,NextFun} | Rest]} + Rest ++ [{NewId, call_init}, {NewId,NextFun}]} end, call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks) catch Error:Reason -> @@ -360,11 +353,10 @@ pos(Id,[_|Rest],Num) -> pos(Id,Rest,Num+1). - catch_apply(M,F,A, Default) -> try apply(M,F,A) - catch error:Reason -> + catch _:Reason -> case erlang:get_stacktrace() of %% Return the default if it was the CTH module which did not have the function. [{M,F,A,_}|_] when Reason == undef -> diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 0cd9b5f7cb..0b7a8bb075 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -28,22 +28,25 @@ -module(ct_logs). --export([init/1,close/2,init_tc/1,end_tc/1]). --export([get_log_dir/0,get_log_dir/1]). --export([log/3,start_log/1,cont_log/2,end_log/0]). --export([set_stylesheet/2,clear_stylesheet/1]). --export([add_external_logs/1,add_link/3]). +-export([init/2, close/2, init_tc/1, end_tc/1]). +-export([get_log_dir/0, get_log_dir/1]). +-export([log/3, start_log/1, cont_log/2, end_log/0]). +-export([set_stylesheet/2, clear_stylesheet/1]). +-export([add_external_logs/1, add_link/3]). -export([make_last_run_index/0]). -export([make_all_suites_index/1,make_all_runs_index/1]). --export([get_ts_html_wrapper/3]). +-export([get_ts_html_wrapper/4]). +-export([xhtml/2, locate_priv_file/1, make_relative/1]). +-export([insert_javascript/1]). %% Logging stuff directly from testcase --export([tc_log/3,tc_log/4,tc_log_async/3,tc_print/3,tc_pal/3,ct_log/3, - basic_html/0]). +-export([tc_log/3, tc_log/4, tc_log_async/3, tc_print/3, tc_print/4, + tc_pal/3, tc_pal/4, ct_log/3, basic_html/0]). %% Simulate logger process for use without ct environment running -export([simulate/0]). +-include("ct.hrl"). -include("ct_event.hrl"). -include("ct_util.hrl"). -include_lib("kernel/include/file.hrl"). @@ -55,7 +58,6 @@ -define(all_runs_name, "all_runs.html"). -define(index_name, "index.html"). -define(totals_name, "totals.info"). --define(css_default, "ct_default.css"). -define(table_color1,"#ADD8E6"). -define(table_color2,"#E4F0FE"). @@ -78,9 +80,9 @@ %%% started. A new directory named ct_run.<timestamp> is created %%% and all logs are stored under this directory.</p> %%% -init(Mode) -> +init(Mode, Verbosity) -> Self = self(), - Pid = spawn_link(fun() -> logger(Self,Mode) end), + Pid = spawn_link(fun() -> logger(Self, Mode, Verbosity) end), MRef = erlang:monitor(process,Pid), receive {started,Pid,Result} -> @@ -239,7 +241,7 @@ end_tc(TCPid) -> %%% activity it is. <code>Format</code> and <code>Args</code> is the %%% data to log (as in <code>io:format(Format,Args)</code>).</p> log(Heading,Format,Args) -> - cast({log,sync,self(),group_leader(), + cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, [{int_header(),[log_timestamp(now()),Heading]}, {Format,Args}, {int_footer(),[]}]}), @@ -261,7 +263,7 @@ log(Heading,Format,Args) -> %%% @see cont_log/2 %%% @see end_log/0 start_log(Heading) -> - cast({log,sync,self(),group_leader(), + cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, [{int_header(),[log_timestamp(now()),Heading]}]}), ok. @@ -276,7 +278,8 @@ cont_log([],[]) -> ok; cont_log(Format,Args) -> maybe_log_timestamp(), - cast({log,sync,self(),group_leader(),[{Format,Args}]}), + cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, + [{Format,Args}]}), ok. %%%----------------------------------------------------------------- @@ -287,7 +290,8 @@ cont_log(Format,Args) -> %%% @see start_log/1 %%% @see cont_log/2 end_log() -> - cast({log,sync,self(),group_leader(),[{int_footer(), []}]}), + cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, + [{int_footer(), []}]}), ok. @@ -320,10 +324,16 @@ add_link(Heading,File,Type) -> [filename:join("log_private",File),Type,File]). - %%%----------------------------------------------------------------- %%% @spec tc_log(Category,Format,Args) -> ok +%%% @equiv tc_log(Category,?STD_IMPORTANCE,Format,Args) +tc_log(Category,Format,Args) -> + tc_log(Category,?STD_IMPORTANCE,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec tc_log(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -332,19 +342,26 @@ add_link(Heading,File,Type) -> %%% <p>This function is called by <code>ct</code> when logging %%% stuff directly from a testcase (i.e. not from within the CT %%% framework).</p> -tc_log(Category,Format,Args) -> - tc_log(Category,"User",Format,Args). +tc_log(Category,Importance,Format,Args) -> + tc_log(Category,Importance,"User",Format,Args). -tc_log(Category,Printer,Format,Args) -> - cast({log,sync,self(),group_leader(),[{div_header(Category,Printer),[]}, - {Format,Args}, - {div_footer(),[]}]}), +tc_log(Category,Importance,Printer,Format,Args) -> + cast({log,sync,self(),group_leader(),Category,Importance, + [{div_header(Category,Printer),[]}, + {Format,Args}, + {div_footer(),[]}]}), ok. - %%%----------------------------------------------------------------- %%% @spec tc_log_async(Category,Format,Args) -> ok +%%% @equiv tc_log_async(Category,?STD_IMPORTANCE,Format,Args) +tc_log_async(Category,Format,Args) -> + tc_log_async(Category,?STD_IMPORTANCE,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec tc_log_async(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -355,40 +372,66 @@ tc_log(Category,Printer,Format,Args) -> %%% to avoid deadlocks when e.g. the hook that handles SASL printouts %%% prints to the test case log file at the same time test server %%% asks ct_logs for an html wrapper.</p> -tc_log_async(Category,Format,Args) -> - cast({log,async,self(),group_leader(),[{div_header(Category),[]}, - {Format,Args}, - {div_footer(),[]}]}), +tc_log_async(Category,Importance,Format,Args) -> + cast({log,async,self(),group_leader(),Category,Importance, + [{div_header(Category),[]}, + {Format,Args}, + {div_footer(),[]}]}), ok. +%%%----------------------------------------------------------------- +%%% @spec tc_print(Category,Format,Args) +%%% @equiv tc_print(Category,?STD_IMPORTANCE,Format,Args) +tc_print(Category,Format,Args) -> + tc_print(Category,?STD_IMPORTANCE,Format,Args). %%%----------------------------------------------------------------- -%%% @spec tc_print(Category,Format,Args) -> ok +%%% @spec tc_print(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% %%% @doc Console printout from a testcase. %%% %%% <p>This function is called by <code>ct</code> when printing -%%% stuff a testcase on the user console.</p> -tc_print(Category,Format,Args) -> - Head = get_heading(Category), - io:format(user, lists:concat([Head,Format,"\n\n"]), Args), - ok. +%%% stuff from a testcase on the user console.</p> +tc_print(Category,Importance,Format,Args) -> + VLvl = case ct_util:get_testdata({verbosity,Category}) of + undefined -> + ct_util:get_testdata({verbosity,'$unspecified'}); + {error,bad_invocation} -> + ?MAX_VERBOSITY; + Val -> + Val + end, + if Importance >= (100-VLvl) -> + Head = get_heading(Category), + io:format(user, lists:concat([Head,Format,"\n\n"]), Args), + ok; + true -> + ok + end. get_heading(default) -> - io_lib:format("-----------------------------" + io_lib:format("\n-----------------------------" "-----------------------\n~s\n", [log_timestamp(now())]); get_heading(Category) -> - io_lib:format("-----------------------------" + io_lib:format("\n-----------------------------" "-----------------------\n~s ~w\n", [log_timestamp(now()),Category]). %%%----------------------------------------------------------------- %%% @spec tc_pal(Category,Format,Args) -> ok +%%% @equiv tc_pal(Category,?STD_IMPORTANCE,Format,Args) -> ok +tc_pal(Category,Format,Args) -> + tc_pal(Category,?STD_IMPORTANCE,Format,Args). + +%%%----------------------------------------------------------------- +%%% @spec tc_pal(Category,Importance,Format,Args) -> ok %%% Category = atom() +%%% Importance = integer() %%% Format = string() %%% Args = list() %%% @@ -397,16 +440,17 @@ get_heading(Category) -> %%% <p>This function is called by <code>ct</code> when logging %%% stuff directly from a testcase. The info is written both in the %%% log and on the console.</p> -tc_pal(Category,Format,Args) -> - tc_print(Category,Format,Args), - cast({log,sync,self(),group_leader(),[{div_header(Category),[]}, - {Format,Args}, - {div_footer(),[]}]}), +tc_pal(Category,Importance,Format,Args) -> + tc_print(Category,Importance,Format,Args), + cast({log,sync,self(),group_leader(),Category,Importance, + [{div_header(Category),[]}, + {Format,Args}, + {div_footer(),[]}]}), ok. %%%----------------------------------------------------------------- -%%% @spec tc_pal(Category,Format,Args) -> ok +%%% @spec ct_pal(Category,Format,Args) -> ok %%% Category = atom() %%% Format = string() %%% Args = list() @@ -444,7 +488,7 @@ maybe_log_timestamp() -> {MS,S,_} -> ok; _ -> - cast({log,sync,self(),group_leader(), + cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, [{"<i>~s</i>",[log_timestamp({MS,S,US})]}]}) end. @@ -468,7 +512,7 @@ log_timestamp({MS,S,US}) -> stylesheet, async_print_jobs}). -logger(Parent,Mode) -> +logger(Parent, Mode, Verbosity) -> register(?MODULE,self()), %%! Below is a temporary workaround for the limitation of @@ -501,26 +545,27 @@ logger(Parent,Mode) -> %% dir) so logs are independent of Common Test installation {ok,Cwd} = file:get_cwd(), CTPath = code:lib_dir(common_test), - CSSFileSrc = filename:join(filename:join(CTPath, "priv"), - ?css_default), - CSSFileDestTop = filename:join(Cwd, ?css_default), - CSSFileDestRun = filename:join(AbsDir, ?css_default), - case file:copy(CSSFileSrc, CSSFileDestTop) of - {error,Reason0} -> + PrivFiles = [?css_default,?jquery_script,?tablesorter_script], + PrivFilesSrc = [filename:join(filename:join(CTPath, "priv"), F) || + F <- PrivFiles], + PrivFilesDestTop = [filename:join(Cwd, F) || F <- PrivFiles], + PrivFilesDestRun = [filename:join(AbsDir, F) || F <- PrivFiles], + case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of + {error,Src1,Dest1,Reason1} -> io:format(user, "ERROR! "++ - "CSS file ~p could not be copied to ~p. "++ - "Reason: ~p~n", - [CSSFileSrc,CSSFileDestTop,Reason0]), - exit({css_file_error,CSSFileDestTop}); - _ -> - case file:copy(CSSFileSrc, CSSFileDestRun) of - {error,Reason1} -> + "Priv file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [Src1,Dest1,Reason1]), + exit({priv_file_error,Dest1}); + ok -> + case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of + {error,Src2,Dest2,Reason2} -> io:format(user, "ERROR! "++ - "CSS file ~p could not be copied to ~p. "++ - "Reason: ~p~n", - [CSSFileSrc,CSSFileDestRun,Reason1]), - exit({css_file_error,CSSFileDestRun}); - _ -> + "Priv file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [Src2,Dest2,Reason2]), + exit({priv_file_error,Dest2}); + ok -> ok end end @@ -540,6 +585,23 @@ logger(Parent,Mode) -> [log_timestamp(now()),"Common Test Logger started"]), Parent ! {started,self(),{Time,filename:absname("")}}, set_evmgr_gl(CtLogFd), + + %% save verbosity levels in dictionary for fast lookups + io:format(CtLogFd, "\nVERBOSITY LEVELS:\n", []), + case proplists:get_value('$unspecified', Verbosity) of + undefined -> ok; + GenLvl -> io:format(CtLogFd, "~-25s~3w~n", + ["general level",GenLvl]) + end, + [begin put({verbosity,Cat},VLvl), + if Cat == '$unspecified' -> + ok; + true -> + io:format(CtLogFd, "~-25w~3w~n", [Cat,VLvl]) + end + end || {Cat,VLvl} <- Verbosity], + io:nl(CtLogFd), + logger_loop(#logger_state{parent=Parent, log_dir=AbsDir, start_time=Time, @@ -548,31 +610,58 @@ logger(Parent,Mode) -> tc_groupleaders=[], async_print_jobs=[]}). +copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> + case file:copy(SrcF, DestF) of + {error,Reason} -> + {error,SrcF,DestF,Reason}; + _ -> + copy_priv_files(SrcFs, DestFs) + end; +copy_priv_files([], []) -> + ok. + logger_loop(State) -> receive - {log,SyncOrAsync,Pid,GL,List} -> - case get_groupleader(Pid, GL, State) of - {tc_log,TCGL,TCGLs} -> - case erlang:is_process_alive(TCGL) of - true -> - State1 = print_to_log(SyncOrAsync, Pid, TCGL, - List, State), - logger_loop(State1#logger_state{tc_groupleaders = - TCGLs}); - false -> - %% Group leader is dead, so write to the - %% CtLog instead - Fd = State#logger_state.ct_log_fd, - [begin io:format(Fd,Str,Args),io:nl(Fd) end || + {log,SyncOrAsync,Pid,GL,Category,Importance,List} -> + VLvl = case Category of + ct_internal -> + ?MAX_VERBOSITY; + _ -> + case get({verbosity,Category}) of + undefined -> get({verbosity,'$unspecified'}); + Val -> Val + end + end, + if Importance >= (100-VLvl) -> + case get_groupleader(Pid, GL, State) of + {tc_log,TCGL,TCGLs} -> + case erlang:is_process_alive(TCGL) of + true -> + State1 = print_to_log(SyncOrAsync, Pid, + TCGL, List, State), + logger_loop(State1#logger_state{ + tc_groupleaders = TCGLs}); + false -> + %% Group leader is dead, so write to the + %% CtLog instead + Fd = State#logger_state.ct_log_fd, + [begin io:format(Fd,Str,Args), + io:nl(Fd) end || {Str,Args} <- List], + logger_loop(State) + end; + {ct_log,Fd,TCGLs} -> + [begin io:format(Fd,Str,Args),io:nl(Fd) end || {Str,Args} <- List], - logger_loop(State) + logger_loop(State#logger_state{ + tc_groupleaders = TCGLs}) end; - {ct_log,Fd,TCGLs} -> - [begin io:format(Fd,Str,Args),io:nl(Fd) end || - {Str,Args} <- List], - logger_loop(State#logger_state{tc_groupleaders = TCGLs}) - end; + true -> + logger_loop(State) + end; {{init_tc,TCPid,GL,RefreshLog},From} -> + %% make sure no IO for this test case from the + %% CT logger gets rejected + test_server:permit_io(GL, self()), print_style(GL, State#logger_state.stylesheet), set_evmgr_gl(GL), TCGLs = add_tc_gl(TCPid,GL,State), @@ -658,13 +747,24 @@ create_io_fun(FromPid, State) -> print_to_log(sync, FromPid, TCGL, List, State) -> IoFun = create_io_fun(FromPid, State), - io:format(TCGL, "~s", [lists:foldl(IoFun, [], List)]), + %% in some situations (exceptions), the printout is made from the + %% test server IO process and there's no valid group leader to send to + IoProc = if FromPid /= TCGL -> TCGL; + true -> State#logger_state.ct_log_fd + end, + io:format(IoProc, "~s", [lists:foldl(IoFun, [], List)]), State; print_to_log(async, FromPid, TCGL, List, State) -> IoFun = create_io_fun(FromPid, State), + %% in some situations (exceptions), the printout is made from the + %% test server IO process and there's no valid group leader to send to + IoProc = if FromPid /= TCGL -> TCGL; + true -> State#logger_state.ct_log_fd + end, Printer = fun() -> - io:format(TCGL, "~s", [lists:foldl(IoFun, [], List)]) + test_server:permit_io(IoProc, self()), + io:format(IoProc, "~s", [lists:foldl(IoFun, [], List)]) end, case State#logger_state.async_print_jobs of [] -> @@ -769,7 +869,7 @@ set_evmgr_gl(GL) -> open_ctlog() -> {ok,Fd} = file:open(?ct_log_name,[write]), - io:format(Fd, header("Common Test Framework Log"), []), + io:format(Fd, header("Common Test Framework Log", {[],[1,2],[]}), []), case file:consult(ct_run:variables_file_name("../")) of {ok,Vars} -> io:format(Fd, config_table(Vars), []); @@ -1079,14 +1179,14 @@ total_row(Success, Fail, UserSkip, AutoSkip, NotBuilt, All) -> integer_to_list(UserSkip),integer_to_list(AutoSkip)} end, [xhtml("<tr valign=top>\n", - ["<tr class=\"",odd_or_even(),"\">\n"]), + ["</tbody>\n<tfoot>\n<tr class=\"",odd_or_even(),"\">\n"]), "<td><b>Total</b></td>\n", Label, TimestampCell, "<td align=right><b>",integer_to_list(Success),"<b></td>\n", "<td align=right><b>",integer_to_list(Fail),"<b></td>\n", "<td align=right>",integer_to_list(AllSkip), " (",UserSkipStr,"/",AutoSkipStr,")</td>\n", "<td align=right><b>",integer_to_list(NotBuilt),"<b></td>\n", - AllInfo, "</tr>\n"]. + AllInfo, "</tr>\n</tfoot>\n"]. not_built(_BaseName,_LogDir,_All,[]) -> 0; @@ -1143,10 +1243,12 @@ index_header(Label, StartTime) -> Head = case Label of undefined -> - header("Test Results", format_time(StartTime)); + header("Test Results", format_time(StartTime), + {[],[1],[2,3,4,5]}); _ -> header("Test Results for '" ++ Label ++ "'", - format_time(StartTime)) + format_time(StartTime), + {[],[1],[2,3,4,5]}) end, [Head | ["<center>\n", @@ -1158,15 +1260,17 @@ index_header(Label, StartTime) -> "\">COMMON TEST FRAMEWORK LOG</a>\n</div>"]), xhtml("<br>\n", "<br /><br /><br />\n"), xhtml(["<table border=\"3\" cellpadding=\"5\" " - "bgcolor=\"",?table_color3,"\">\n"], "<table>\n"), + "bgcolor=\"",?table_color3,"\">\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n<tr>\n"]), "<th><b>Test Name</b></th>\n", xhtml(["<th><font color=\"",?table_color3,"\">_</font>Ok" "<font color=\"",?table_color3,"\">_</font></th>\n"], "<th>Ok</th>\n"), "<th>Failed</th>\n", "<th>Skipped", xhtml("<br>", "<br />"), "(User/Auto)</th>\n" - "<th>Missing", xhtml("<br>", "<br />"), "Suites</th>\n" - "\n"]]. + "<th>Missing", xhtml("<br>", "<br />"), "Suites</th>\n", + xhtml("", "</tr>\n</thead>\n<tbody>\n")]]. all_suites_index_header() -> {ok,Cwd} = file:get_cwd(), @@ -1179,12 +1283,14 @@ all_suites_index_header(IndexDir) -> AllRunsLink = xhtml(["<a href=\"",?all_runs_name,"\">",AllRuns,"</a>\n"], ["<div id=\"button_holder\" class=\"btn\">\n" "<a href=\"",?all_runs_name,"\">",AllRuns,"</a>\n</div>"]), - [header("Test Results") | + [header("Test Results", {[3],[1,2,8,9,10],[4,5,6,7]}) | ["<center>\n", AllRunsLink, xhtml("<br><br>\n", "<br /><br />\n"), xhtml(["<table border=\"3\" cellpadding=\"5\" " - "bgcolor=\"",?table_color2,"\">\n"], "<table>\n"), + "bgcolor=\"",?table_color2,"\">\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n<tr>\n"]), "<th>Test Name</th>\n", "<th>Label</th>\n", "<th>Test Run Started</th>\n", @@ -1197,7 +1303,7 @@ all_suites_index_header(IndexDir) -> "<th>Node</th>\n", "<th>CT Log</th>\n", "<th>Old Runs</th>\n", - "\n"]]. + xhtml("", "</tr>\n</thead>\n<tbody>\n")]]. all_runs_header() -> {ok,Cwd} = file:get_cwd(), @@ -1209,10 +1315,12 @@ all_runs_header() -> "<a href=\"",?index_name, "\">TEST INDEX PAGE</a>\n</div>"]), xhtml("<br>\n", "<br /><br />\n")], - [header(Title) | + [header(Title, {[1],[2,3,5],[4,6,7,8,9,10]}) | ["<center>\n", IxLink, xhtml(["<table border=\"3\" cellpadding=\"5\" " - "bgcolor=\"",?table_color1,"\">\n"], "<table>\n"), + "bgcolor=\"",?table_color1,"\">\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n<tr>\n"]), "<th><b>History</b></th>\n" "<th><b>Node</b></th>\n" "<th><b>Label</b></th>\n" @@ -1224,45 +1332,65 @@ all_runs_header() -> "<th>Ok</th>\n"), "<th>Failed</th>\n" "<th>Skipped<br>(User/Auto)</th>\n" - "<th>Missing<br>Suites</th>\n" - "\n"]]. + "<th>Missing<br>Suites</th>\n", + xhtml("", "</tr>\n</thead>\n<tbody>\n")]]. -header(Title) -> - header1(Title, ""). -header(Title, SubTitle) -> - header1(Title, SubTitle). +header(Title, TableCols) -> + header1(Title, "", TableCols). +header(Title, SubTitle, TableCols) -> + header1(Title, SubTitle, TableCols). -header1(Title, SubTitle) -> +header1(Title, SubTitle, TableCols) -> SubTitleHTML = if SubTitle =/= "" -> ["<center>\n", "<h3>" ++ SubTitle ++ "</h3>\n", xhtml("</center>\n<br>\n", "</center>\n<br />\n")]; - true -> xhtml("<br>\n", "<br />\n") + true -> xhtml("<br>", "<br />") end, CSSFile = xhtml(fun() -> "" end, - fun() -> make_relative(locate_default_css_file()) end), + fun() -> make_relative(locate_priv_file(?css_default)) end), + JQueryFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?jquery_script)) end), + TableSorterFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?tablesorter_script)) end), [xhtml(["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", "<html>\n"], ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n", "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n", "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"]), - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", - "<head>\n", - "<title>" ++ Title ++ " " ++ SubTitle ++ "</title>\n", - "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", - xhtml("", - ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]), - "</head>\n", - body_tag(), - "<center>\n", - "<h1>" ++ Title ++ "</h1>\n", - "</center>\n", - SubTitleHTML,"\n"]. + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", + "<head>\n", + "<title>" ++ Title ++ " " ++ SubTitle ++ "</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + xhtml("", + ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">\n"]), + xhtml("", + ["<script type=\"text/javascript\" src=\"",JQueryFile, + "\"></script>\n"]), + xhtml("", + ["<script type=\"text/javascript\" src=\"",TableSorterFile, + "\"></script>\n"]), + xhtml(fun() -> "" end, + fun() -> insert_javascript({tablesorter,?sortable_table_name, + TableCols}) + end), + "</head>\n", + body_tag(), + "<center>\n", + "<h1>" ++ Title ++ "</h1>\n", + "</center>\n", + SubTitleHTML,"\n"]. index_footer() -> ["</table>\n" "</center>\n" | footer()]. +all_runs_index_footer() -> + ["</tbody>\n</table>\n" + "</center>\n" | footer()]. + footer() -> ["<center>\n", xhtml("<br><br>\n<hr>\n", "<br /><br />\n"), @@ -1274,7 +1402,8 @@ footer() -> xhtml("<br>\n", "<br />\n"), xhtml("</font></p>\n", "</div>\n"), "</center>\n" - "</body>\n"]. + "</body>\n" + "</html>\n"]. body_tag() -> @@ -1290,7 +1419,7 @@ current_time() -> format_time({{Y, Mon, D}, {H, Min, S}}) -> Weekday = weekday(calendar:day_of_the_week(Y, Mon, D)), - lists:flatten(io_lib:format("~s ~s ~p ~w ~2.2.0w:~2.2.0w:~2.2.0w", + lists:flatten(io_lib:format("~s ~s ~2.2.0w ~w ~2.2.0w:~2.2.0w:~2.2.0w", [Weekday, month(Mon), D, Y, H, Min, S])). weekday(1) -> "Mon"; @@ -1416,8 +1545,12 @@ config_table_header() -> [ xhtml(["<h2>Configuration</h2>\n" "<table border=\"3\" cellpadding=\"5\" bgcolor=\"",?table_color1,"\"\n"], - "<h4>CONFIGURATION</h4>\n<table>\n"), - "<tr><th>Key</th><th>Value</th></tr>\n"]. + ["<h4>CONFIGURATION</h4>\n", + "<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n"]), + "<tr><th>Key</th><th>Value</th></tr>\n", + xhtml("", "</thead>\n<tbody>\n") + ]. config_table1([{Key,Value}|Vars]) -> [xhtml(["<tr><td>", atom_to_list(Key), "</td>\n", @@ -1427,7 +1560,7 @@ config_table1([{Key,Value}|Vars]) -> "<td>", io_lib:format("~p",[Value]), "</td>\n</tr>\n"]) | config_table1(Vars)]; config_table1([]) -> - ["</table>\n"]. + ["</tbody>\n</table>\n"]. make_all_runs_index(When) -> @@ -1441,7 +1574,8 @@ make_all_runs_index(When) -> DirsSorted = (catch sort_all_runs(Dirs)), Header = all_runs_header(), Index = [runentry(Dir) || Dir <- DirsSorted], - Result = file:write_file(AbsName,Header++Index++index_footer()), + Result = file:write_file(AbsName,Header++Index++ + all_runs_index_footer()), if When == start -> ok; true -> io:put_chars("done\n") end, @@ -1980,7 +2114,7 @@ simulate() -> simulate_logger_loop() -> receive - {log,_,_,_,List} -> + {log,_,_,_,_,_,List} -> S = [[io_lib:format(Str,Args),io_lib:nl()] || {Str,Args} <- List], io:format("~s",[S]), simulate_logger_loop(); @@ -2077,34 +2211,34 @@ basic_html() -> end. %%%----------------------------------------------------------------- -%%% @spec locate_default_css_file() -> CSSFile +%%% @spec locate_priv_file(FileName) -> PrivFile %%% %%% @doc %%% -locate_default_css_file() -> +locate_priv_file(FileName) -> {ok,CWD} = file:get_cwd(), - CSSFileInCwd = filename:join(CWD, ?css_default), - case filelib:is_file(CSSFileInCwd) of + PrivFileInCwd = filename:join(CWD, FileName), + case filelib:is_file(PrivFileInCwd) of true -> - CSSFileInCwd; + PrivFileInCwd; false -> - CSSResultFile = + PrivResultFile = case {whereis(?MODULE),self()} of {Self,Self} -> %% executed on the ct_logs process - filename:join(get(ct_run_dir), ?css_default); + filename:join(get(ct_run_dir), FileName); _ -> %% executed on other process than ct_logs {ok,RunDir} = get_log_dir(true), - filename:join(RunDir, ?css_default) + filename:join(RunDir, FileName) end, - case filelib:is_file(CSSResultFile) of + case filelib:is_file(PrivResultFile) of true -> - CSSResultFile; + PrivResultFile; false -> %% last resort, try use css file in CT installation CTPath = code:lib_dir(common_test), - filename:join(filename:join(CTPath, "priv"), ?css_default) + filename:join(filename:join(CTPath, "priv"), FileName) end end. @@ -2143,7 +2277,7 @@ make_relative1(DirTs, CwdTs) -> %%% %%% @doc %%% -get_ts_html_wrapper(TestName, PrintLabel, Cwd) -> +get_ts_html_wrapper(TestName, PrintLabel, Cwd, TableCols) -> TestName1 = if is_list(TestName) -> lists:flatten(TestName); true -> @@ -2203,17 +2337,36 @@ get_ts_html_wrapper(TestName, PrintLabel, Cwd) -> "Open Telecom Platform</a><br />\n", "Updated: <!date>", current_time(), "<!/date>", "<br />\n</div>\n"], - CSSFile = xhtml(fun() -> "" end, - fun() -> make_relative(locate_default_css_file(), Cwd) end), + CSSFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?css_default), + Cwd) + end), + JQueryFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?jquery_script), + Cwd) + end), + TableSorterFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?tablesorter_script), + Cwd) + end), + TableSorterScript = + xhtml(fun() -> "" end, + fun() -> insert_javascript({tablesorter, + ?sortable_table_name, + TableCols}) end), {xhtml, ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n", "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n", "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n", "<head>\n<title>", TestName1, "</title>\n", "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", - "<link rel=\"stylesheet\" href=\"", CSSFile, "\" type=\"text/css\">", - "</head>\n","<body>\n", - LabelStr, "\n"], + "<link rel=\"stylesheet\" href=\"", CSSFile, "\" type=\"text/css\">\n", + "<script type=\"text/javascript\" src=\"", JQueryFile, "\"></script>\n", + "<script type=\"text/javascript\" src=\"", TableSorterFile, "\"></script>\n"] ++ + TableSorterScript ++ ["</head>\n","<body>\n", LabelStr, "\n"], ["<center>\n<br /><hr /><p>\n", "<a href=\"", AllRuns, "\">Test run history\n</a> | ", @@ -2221,3 +2374,89 @@ get_ts_html_wrapper(TestName, PrintLabel, Cwd) -> "\">Top level test index\n</a>\n</p>\n", Copyright,"</center>\n</body>\n</html>\n"]} end. + +insert_javascript({tablesorter,_TableName,undefined}) -> + []; + +insert_javascript({tablesorter,TableName, + {DateCols,TextCols,ValCols}}) -> + Headers = + lists:flatten( + lists:sort( + lists:flatmap(fun({Sorter,Cols}) -> + [lists:flatten( + io_lib:format(" ~w: " + "{ sorter: '~s' },\n", + [Col-1,Sorter])) || Col<-Cols] + end, [{"CTDateSorter",DateCols}, + {"CTTextSorter",TextCols}, + {"CTValSorter",ValCols}]))), + Headers1 = string:substr(Headers, 1, length(Headers)-2), + + ["<script type=\"text/javascript\">\n", + "// Parser for date format, e.g: Wed Jul 4 2012 11:24:15\n", + "var monthNames = {};\n", + "monthNames[\"Jan\"] = \"01\"; monthNames[\"Feb\"] = \"02\";\n", + "monthNames[\"Mar\"] = \"03\"; monthNames[\"Apr\"] = \"04\";\n", + "monthNames[\"May\"] = \"05\"; monthNames[\"Jun\"] = \"06\";\n", + "monthNames[\"Jul\"] = \"07\"; monthNames[\"Aug\"] = \"08\";\n", + "monthNames[\"Sep\"] = \"09\"; monthNames[\"Oct\"] = \"10\";\n", + "monthNames[\"Nov\"] = \"11\"; monthNames[\"Dec\"] = \"12\";\n", + "$.tablesorter.addParser({\n", + " id: 'CTDateSorter',\n", + " is: function(s) {\n", + " return false; },\n", + " format: function(s) {\n", + %% place empty cells, "-" and "?" at the bottom + " if (s.length < 2) return 999999999;\n", + " else {\n", + %% match out each date element + " var date = s.match(/(\\w{3})\\s(\\w{3})\\s(\\d{2})\\s(\\d{4})\\s(\\d{2}):(\\d{2}):(\\d{2})/);\n", + " var y = date[4]; var mo = monthNames[date[2]]; var d = String(date[3]);\n", + " var h = String(date[5]); var mi = String(date[6]); var sec = String(date[7]);\n", + " return (parseInt('' + y + mo + d + h + mi + sec)); }},\n", + " type: 'numeric' });\n", + + "// Parser for general text format\n", + "$.tablesorter.addParser({\n", + " id: 'CTTextSorter',\n", + " is: function(s) {\n", + " return false; },\n", + " format: function(s) {\n", + %% place empty cells, "?" and "-" at the bottom + " if (s.length < 1) return 'zzzzzzzz';\n", + " else if (s == \"?\") return 'zzzzzzz';\n", + " else if (s == \"-\") return 'zzzzzz';\n", + " else if (s == \"FAILED\") return 'A';\n", + " else if (s == \"SKIPPED\") return 'B';\n", + " else if (s == \"OK\") return 'C';\n", + " else return '' + s; },\n", + " type: 'text' });\n", + + "// Parser for numerical values\n", + "$.tablesorter.addParser({\n", + " id: 'CTValSorter',\n", + " is: function(s) {\n", + " return false; },\n", + " format: function(s) {\n" + %% place empty cells and "?" at the bottom + " if (s.length < 1) return '-2';\n", + " else if (s == \"?\") return '-1';\n", + %% look for skip value, eg "3 (2/1)" + " else if ((s.search(/(\\d{1,})\\s/)) >= 0) {\n", + " var num = s.match(/(\\d{1,})\\s/);\n", + %% return only the total skip value for sorting + " return (parseInt('' + num[1])); }\n", + " else if ((s.search(/(\\d{1,})\\.(\\d{3})s/)) >= 0) {\n", + " var num = s.match(/(\\d{1,})\\.(\\d{3})/);\n", + " if (num[1] == \"0\") return (parseInt('' + num[2]));\n", + " else return (parseInt('' + num[1] + num[2])); }\n", + " else return '' + s; },\n", + " type: 'numeric' });\n", + + "$(document).ready(function() {\n", + " $(\"#",TableName,"\").tablesorter({\n", + " headers: { \n", Headers1, "\n }\n });\n", + " $(\"#",TableName,"\").trigger(\"update\");\n", + " $(\"#",TableName,"\").trigger(\"appendCache\");\n", + "});\n</script>\n"]. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 2ea2ba106a..042c5ba267 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. 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 @@ -25,6 +25,7 @@ -export([run/1,run/3,run/4]). -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). +-export([basic_html/1]). -export([abort/0,abort/1,progress/0]). @@ -277,7 +278,17 @@ abort(Node) when is_atom(Node) -> progress() -> call(progress). - +%%%----------------------------------------------------------------- +%%% @spec basic_html(Bool) -> ok +%%% Bool = true | false +%%% +%%% @doc If set to true, the ct_master logs will be written on a +%%% primitive html format, not using the Common Test CSS style +%%% sheet. +basic_html(Bool) -> + application:set_env(common_test_master, basic_html, Bool), + ok. + %%%----------------------------------------------------------------- %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 244faace06..9e61d5b16f 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. 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 @@ -23,7 +23,10 @@ %%% node.</p> -module(ct_master_logs). --export([start/2, make_all_runs_index/0, log/3, nodedir/2, stop/0]). +-export([start/2, make_all_runs_index/0, log/3, nodedir/2, + stop/0]). + +-include("ct_util.hrl"). -record(state, {log_fd, start_time, logdir, rundir, nodedir_ix_fd, nodes, nodedirs=[]}). @@ -87,6 +90,41 @@ init(Parent,LogDir,Nodes) -> RunDirAbs = filename:join(LogDir,RunDir), file:make_dir(RunDirAbs), write_details_file(RunDirAbs,{node(),Nodes}), + + case basic_html() of + true -> + put(basic_html, true); + BasicHtml -> + put(basic_html, BasicHtml), + %% copy priv files to log dir (both top dir and test run + %% dir) so logs are independent of Common Test installation + CTPath = code:lib_dir(common_test), + PrivFiles = [?css_default,?jquery_script,?tablesorter_script], + PrivFilesSrc = [filename:join(filename:join(CTPath, "priv"), F) || + F <- PrivFiles], + PrivFilesDestTop = [filename:join(LogDir, F) || F <- PrivFiles], + PrivFilesDestRun = [filename:join(RunDirAbs, F) || F <- PrivFiles], + case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of + {error,Src1,Dest1,Reason1} -> + io:format(user, "ERROR! "++ + "Priv file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [Src1,Dest1,Reason1]), + exit({priv_file_error,Dest1}); + ok -> + case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of + {error,Src2,Dest2,Reason2} -> + io:format(user, "ERROR! "++ + "Priv file ~p could not be copied to ~p. "++ + "Reason: ~p~n", + [Src2,Dest2,Reason2]), + exit({priv_file_error,Dest2}); + ok -> + ok + end + end + end, + make_all_runs_index(LogDir), CtLogFd = open_ct_master_log(RunDirAbs), NodeStr = @@ -110,6 +148,16 @@ init(Parent,LogDir,Nodes) -> {N,""} end,Nodes)}). +copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> + case file:copy(SrcF, DestF) of + {error,Reason} -> + {error,SrcF,DestF,Reason}; + _ -> + copy_priv_files(SrcFs, DestFs) + end; +copy_priv_files([], []) -> + ok. + loop(State) -> receive {log,_From,List} -> @@ -154,7 +202,7 @@ loop(State) -> open_ct_master_log(Dir) -> FullName = filename:join(Dir,?ct_master_log_name), {ok,Fd} = file:open(FullName,[write]), - io:format(Fd,header("Common Test Master Log"),[]), + io:format(Fd,header("Common Test Master Log", {[],[1,2],[]}),[]), %% maybe add config info here later io:format(Fd, config_table([]), []), io:format(Fd, @@ -164,8 +212,9 @@ open_ct_master_log(Dir) -> "</style>\n", []), io:format(Fd, - "<br><h2>Progress Log</h2>\n" - "<pre>\n",[]), + xhtml("<br><h2>Progress Log</h2>\n<pre>\n", + "<br /><h2>Progress Log</h2>\n<pre>\n"), + []), Fd. close_ct_master_log(Fd) -> @@ -178,20 +227,15 @@ config_table(Vars) -> config_table_header() -> ["<h2>Configuration</h2>\n", - "<table border=\"3\" cellpadding=\"5\" bgcolor=\"",?table_color, - "\"\n", - "<tr><th>Key</th><th>Value</th></tr>\n"]. - -%% -%% keep for possible later use -%% -%%config_table1([{Key,Value}|Vars]) -> -%% ["<tr><td>", atom_to_list(Key), "</td>\n", -%% "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n" | -%% config_table1(Vars)]; + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\"\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n"]), + "<tr><th>Key</th><th>Value</th></tr>\n", + xhtml("", "</thead>\n<tbody>\n")]. config_table1([]) -> - ["</table>\n"]. + ["</tbody>\n</table>\n"]. int_header() -> "<div class=\"ct_internal\"><b>*** CT MASTER ~s *** ~s</b>". @@ -210,10 +254,10 @@ open_nodedir_index(Dir,StartTime) -> print_nodedir(Node,RunDir,Fd) -> Index = filename:join(RunDir,"index.html"), io:format(Fd, - ["<TR>\n" - "<TD ALIGN=center>",atom_to_list(Node),"</TD>\n", - "<TD ALIGN=left><A HREF=\"",Index,"\">",Index,"</A></TD>\n", - "</TR>\n"],[]), + ["<tr>\n" + "<td align=center>",atom_to_list(Node),"</td>\n", + "<td align=left><a href=\"",Index,"\">",Index,"</a></td>\n", + "</tr>\n"],[]), ok. close_nodedir_index(Fd) -> @@ -221,14 +265,16 @@ close_nodedir_index(Fd) -> file:close(Fd). nodedir_index_header(StartTime) -> - [header("Log Files " ++ format_time(StartTime)) | - ["<CENTER>\n", - "<P><A HREF=\"",?ct_master_log_name,"\">Common Test Master Log</A></P>", - "<TABLE border=\"3\" cellpadding=\"5\" ", - "BGCOLOR=\"",?table_color,"\">\n", - "<th><B>Node</B></th>\n", - "<th><B>Log</B></th>\n", - "\n"]]. + [header("Log Files " ++ format_time(StartTime), {[],[1,2],[]}) | + ["<center>\n", + "<p><a href=\"",?ct_master_log_name,"\">Common Test Master Log</a></p>", + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\">\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n<tr>\n"]), + "<th><b>Node</b></th>\n", + "<th><b>Log</b></th>\n", + xhtml("", "</tr>\n</thead>\n<tbody>\n")]]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% All Run Index functions %%% @@ -279,21 +325,23 @@ runentry(Dir) -> {"unknown",""} end, Index = filename:join(Dir,?nodedir_index_name), - ["<TR>\n" - "<TD ALIGN=center><A HREF=\"",Index,"\">",timestamp(Dir),"</A></TD>\n", - "<TD ALIGN=center>",MasterStr,"</TD>\n", - "<TD ALIGN=center>",NodesStr,"</TD>\n", - "</TR>\n"]. + ["<tr>\n" + "<td align=center><a href=\"",Index,"\">",timestamp(Dir),"</a></td>\n", + "<td align=center>",MasterStr,"</td>\n", + "<td align=center>",NodesStr,"</td>\n", + "</tr>\n"]. all_runs_header() -> - [header("Master Test Runs") | - ["<CENTER>\n", - "<TABLE border=\"3\" cellpadding=\"5\" " - "BGCOLOR=\"",?table_color,"\">\n" - "<th><B>History</B></th>\n" - "<th><B>Master Host</B></th>\n" - "<th><B>Test Nodes</B></th>\n" - "\n"]]. + [header("Master Test Runs", {[1],[2,3],[]}) | + ["<center>\n", + xhtml(["<table border=\"3\" cellpadding=\"5\" " + "bgcolor=\"",?table_color,"\">\n"], + ["<table id=\"",?sortable_table_name,"\">\n", + "<thead>\n<tr>\n"]), + "<th><b>History</b></th>\n" + "<th><b>Master Host</b></th>\n" + "<th><b>Test Nodes</b></th>\n", + xhtml("", "</tr></thead>\n<tbody>\n")]]. timestamp(Dir) -> [S,Min,H,D,M,Y|_] = lists:reverse(string:tokens(Dir,".-_")), @@ -317,52 +365,71 @@ read_details_file(Dir) -> %%% Internal functions %%%-------------------------------------------------------------------- -header(Title) -> - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - - "<TITLE>" ++ Title ++ "</TITLE>\n", - "<META HTTP-EQUIV=\"CACHE-CONTROL\" CONTENT=\"NO-CACHE\">\n", - - "</HEAD>\n", - +header(Title, TableCols) -> + CSSFile = xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?css_default)) end), + JQueryFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?jquery_script)) end), + TableSorterFile = + xhtml(fun() -> "" end, + fun() -> make_relative(locate_priv_file(?tablesorter_script)) end), + + [xhtml(["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n", + "<html>\n"], + ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"\n", + "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n", + "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"]), + "<!-- autogenerated by '"++atom_to_list(?MODULE)++"' -->\n", + "<head>\n", + "<title>" ++ Title ++ "</title>\n", + "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n", + xhtml("", + ["<link rel=\"stylesheet\" href=\"",CSSFile,"\" type=\"text/css\">"]), + xhtml("", + ["<script type=\"text/javascript\" src=\"",JQueryFile, + "\"></script>\n"]), + xhtml("", + ["<script type=\"text/javascript\" src=\"",TableSorterFile, + "\"></script>\n"]), + xhtml(fun() -> "" end, + fun() -> ct_logs:insert_javascript({tablesorter, + ?sortable_table_name, + TableCols}) end), + "</head>\n", body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>" ++ Title ++ "</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n"]. + "<center>\n", + "<h1>" ++ Title ++ "</h1>\n", + "</center>\n"]. index_footer() -> - ["</TABLE>\n" - "</CENTER>\n" | footer()]. + ["</tbody>\n</table>\n" + "</center>\n" | footer()]. footer() -> - ["<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" + ["<center>\n", + xhtml("<br><hr>\n", "<br />\n"), + xhtml("<p><font size=\"-1\">\n", "<div class=\"copyright\">"), "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" + " <a href=\"http://www.erlang.org\">Open Telecom Platform</a>", + xhtml("<br>\n", "<br />\n"), + "Updated: <!date>", current_time(), "<!/date>", + xhtml("<br>\n", "<br />\n"), + xhtml("</font></p>\n", "</div>\n"), + "</center>\n" "</body>\n"]. body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">\n". + xhtml("<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\" " + "vlink=\"#800080\" alink=\"#FF0000\">\n", + "<body>\n"). current_time() -> format_time(calendar:local_time()). format_time({{Y, Mon, D}, {H, Min, S}}) -> Weekday = weekday(calendar:day_of_the_week(Y, Mon, D)), - lists:flatten(io_lib:format("~s ~s ~p ~w ~2.2.0w:~2.2.0w:~2.2.0w", + lists:flatten(io_lib:format("~s ~s ~2.2.0w ~w ~2.2.0w:~2.2.0w:~2.2.0w", [Weekday, month(Mon), D, Y, H, Min, S])). weekday(1) -> "Mon"; @@ -404,6 +471,23 @@ log_timestamp(Now) -> lists:flatten(io_lib:format("~2.2.0w:~2.2.0w:~2.2.0w", [H,M,S])). +basic_html() -> + case application:get_env(common_test_master, basic_html) of + {ok,true} -> + true; + _ -> + false + end. + +xhtml(HTML, XHTML) -> + ct_logs:xhtml(HTML, XHTML). + +locate_priv_file(File) -> + ct_logs:locate_priv_file(File). + +make_relative(Dir) -> + ct_logs:make_relative(Dir). + force_write_file(Name,Contents) -> force_delete(Name), file:write_file(Name,Contents). @@ -452,3 +536,4 @@ cast(Msg) -> _Pid -> ?MODULE ! Msg end. + diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl new file mode 100644 index 0000000000..d9c4a962dc --- /dev/null +++ b/lib/common_test/src/ct_netconfc.erl @@ -0,0 +1,1828 @@ +%%---------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% File: ct_netconfc.erl +%% +%% Description: +%% This file contains the Netconf client interface +%% +%% @author Support +%% +%% @doc Netconf client module. +%% +%% <p>The Netconf client is compliant with RFC4741 and RFC4742.</p> +%% +%% <p> For each server to test against, the following entry can be +%% added to a configuration file:</p> +%% +%% <p>`{server_id(),options()}.'</p> +%% +%% <p> The `server_id()' or an associated `target_name()' (see +%% {@link ct}) shall then be used in calls to {@link open/2}.</p> +%% +%% <p>If no configuration exists for a server, a session can still be +%% opened by calling {@link open/2} with all necessary options given +%% in the call. The first argument to {@link open/2} can then be any +%% atom.</p> +%% +%% == Logging == +%% +%% The netconf server uses the `error_logger' for logging of netconf +%% traffic. A special purpose error handler is implemented in +%% `ct_conn_log_h'. To use this error handler, add the `cth_conn_log' +%% hook in your test suite, e.g. +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, [{conn_mod(),hook_options()}]}]}]. +%%''' +%% +%% The `conn_mod()' is the name of the common_test module implementing +%% the connection protocol, e.g. `ct_netconfc'. +%% +%% The hook option `log_type' specifies the type of logging: +%% +%% <dl> +%% <dt>`raw'</dt> +%% <dd>The sent and received netconf data is logged to a separate +%% text file as is without any formatting. A link to the file is +%% added to the test case HTML log.</dd> +%% +%% <dt>`pretty'</dt> +%% <dd>The sent and received netconf data is logged to a separate +%% text file with XML data nicely indented. A link to the file is +%% added to the test case HTML log.</dd> +%% +%% <dt>`html (default)'</dt> +%% <dd>The sent and received netconf traffic is pretty printed +%% directly in the test case HTML log.</dd> +%% +%% <dt>`silent'</dt> +%% <dd>Netconf traffic is not logged.</dd> +%% </dl> +%% +%% By default, all netconf traffic is logged in one single log +%% file. However, it is possible to have different connections logged +%% in separate files. To do this, use the hook option `hosts' and +%% list the names of the servers/connections that will be used in the +%% suite. Note that the connections must be named for this to work, +%% i.e. they must be opened with {@link open/2}. +%% +%% The `hosts' option has no effect if `log_type' is set to `html' or +%% `silent'. +%% +%% The hook options can also be specified in a configuration file with +%% the configuration variable `ct_conn_log': +%% +%% ``` +%% {ct_conn_log,[{conn_mod(),hook_options()}]}. +%% ''' +%% +%% For example: +%% +%% ``` +%% {ct_conn_log,[{ct_netconfc,[{log_type,pretty}, +%% {hosts,[key_or_name()]}]}]} +%% ''' +%% +%% <b>Note</b> that hook options specified in a configuration file +%% will overwrite the hardcoded hook options in the test suite. +%% +%% === Logging example 1 === +%% +%% The following `ct_hooks' statement will cause pretty printing of +%% netconf traffic to separate logs for the connections named +%% `nc_server1' and `nc_server2'. Any other connections will be logged +%% to default netconf log. +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, [{ct_netconfc,[{log_type,pretty}}, +%% {hosts,[nc_server1,nc_server2]}]} +%% ]}]}]. +%%''' +%% +%% Connections must be opened like this: +%% +%% ``` +%% open(nc_server1,[...]), +%% open(nc_server2,[...]). +%% ''' +%% +%% === Logging example 2 === +%% +%% The following configuration file will cause raw logging of all +%% netconf traffic into one single text file. +%% +%% ``` +%% {ct_conn_log,[{ct_netconfc,[{log_type,raw}]}]}. +%% ''' +%% +%% The `ct_hooks' statement must look like this: +%% +%% ``` +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, []}]}]. +%% ''' +%% +%% The same `ct_hooks' statement without the configuration file would +%% cause HTML logging of all netconf connections into the test case +%% HTML log. +%% +%% == Notifications == +%% +%% The netconf client is also compliant with RFC5277 NETCONF Event +%% Notifications, which defines a mechanism for an asynchronous +%% message notification delivery service for the netconf protocol. +%% +%% Specific functions to support this are {@link +%% create_subscription/6} and {@link get_event_streams/3}. (The +%% functions also exist with other arities.) +%% +%% @end +%%---------------------------------------------------------------------- +-module(ct_netconfc). + +-include("ct_netconfc.hrl"). +-include("ct_util.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). + +%%---------------------------------------------------------------------- +%% External exports +%%---------------------------------------------------------------------- +-export([open/1, + open/2, + only_open/1, + only_open/2, + hello/1, + hello/2, + close_session/1, + close_session/2, + kill_session/2, + kill_session/3, + send/2, + send/3, + send_rpc/2, + send_rpc/3, + lock/2, + lock/3, + unlock/2, + unlock/3, + get/2, + get/3, + get_config/3, + get_config/4, + edit_config/3, + edit_config/4, + delete_config/2, + delete_config/3, + copy_config/3, + copy_config/4, + action/2, + action/3, + create_subscription/1, + create_subscription/2, + create_subscription/3, + create_subscription/4, + create_subscription/5, + create_subscription/6, + get_event_streams/2, + get_event_streams/3, + get_capabilities/1, + get_capabilities/2, + get_session_id/1, + get_session_id/2]). + +%%---------------------------------------------------------------------- +%% Exported types +%%---------------------------------------------------------------------- +-export_type([hook_options/0, + conn_mod/0, + log_type/0, + key_or_name/0, + notification/0]). + +%%---------------------------------------------------------------------- +%% Internal exports +%%---------------------------------------------------------------------- +%% ct_gen_conn callbacks +-export([init/3, + handle_msg/3, + handle_msg/2, + terminate/2, + close/1]). + +%% ct_conn_log callback +-export([format_data/2]). + +%%---------------------------------------------------------------------- +%% Internal defines +%%---------------------------------------------------------------------- +-define(APPLICATION,?MODULE). +-define(VALID_SSH_OPTS,[user, password, user_dir]). +-define(DEFAULT_STREAM,"NETCONF"). + +-define(error(ConnName,Report), + error_logger:error_report([{ct_connection,ConnName}, + {client,self()}, + {module,?MODULE}, + {line,?LINE} | + Report])). + +-define(is_timeout(T), (is_integer(T) orelse T==infinity)). +-define(is_filter(F), + (is_atom(F) orelse (is_tuple(F) andalso is_atom(element(1,F))))). +-define(is_string(S), (is_list(S) andalso is_integer(hd(S)))). + +%%---------------------------------------------------------------------- +%% Records +%%---------------------------------------------------------------------- +%% Client state +-record(state, {host, + port, + connection, % #connection + capabilities, + session_id, + msg_id = 1, + hello_status, + buff = <<>>, + pending = [], % [#pending] + event_receiver}).% pid + +%% Run-time client options. +-record(options, {ssh = [], % Options for the ssh application + host, + port = ?DEFAULT_PORT, + timeout = ?DEFAULT_TIMEOUT, + name}). + +%% Connection reference +-record(connection, {reference, % {CM,Ch} + host, + port, + name}). + +%% Pending replies from server +-record(pending, {tref, % timer ref (returned from timer:xxx) + ref, % pending ref + msg_id, + op, + caller}).% pid which sent the request + +%%---------------------------------------------------------------------- +%% Type declarations +%%---------------------------------------------------------------------- +-type client() :: handle() | server_id() | target_name(). +-type handle() :: term(). +%% An opaque reference for a connection (netconf session). See {@link +%% ct} for more information. + +-type server_id() :: atom(). +%% A `ServerId' which exists in a configuration file. +-type target_name() :: atom(). +%% A name which is associated to a `server_id()' via a +%% `require' statement or a call to {@link ct:require/2} in the +%% test suite. +-type key_or_name() :: server_id() | target_name(). + +-type options() :: [option()]. +%% Options used for setting up ssh connection to a netconf server. + +-type option() :: {ssh,host()} | {port,inet:port_number()} | {user,string()} | + {password,string()} | {user_dir,string()} | + {timeout,timeout()}. +-type host() :: inet:host_name() | inet:ip_address(). + +-type notification() :: {notification, xml_attributes(), notification_content()}. +-type notification_content() :: [event_time()|simple_xml()]. +-type event_time() :: {eventTime,xml_attributes(),[xs_datetime()]}. + +-type stream_name() :: string(). +-type streams() :: [{stream_name(),[stream_data()]}]. +-type stream_data() :: {description,string()} | + {replaySupport,string()} | + {replayLogCreationTime,string()} | + {replayLogAgedTime,string()}. +%% See XML Schema for Event Notifications found in RFC5277 for further +%% detail about the data format for the string values. + +-type hook_options() :: [hook_option()]. +%% Options that can be given to `cth_conn_log' in the `ct_hook' statement. +-type hook_option() :: {log_type,log_type()} | + {hosts,[key_or_name()]}. +-type log_type() :: raw | pretty | html | silent. +%-type error_handler() :: module(). +-type conn_mod() :: ct_netconfc. + +-type error_reason() :: term(). + +-type simple_xml() :: {xml_tag(), xml_attributes(), xml_content()} | + {xml_tag(), xml_content()} | + xml_tag(). +%% <p>This type is further described in the documentation for the +%% <tt>Xmerl</tt> application.</p> +-type xml_tag() :: atom(). +-type xml_attributes() :: [{xml_attribute_tag(),xml_attribute_value()}]. +-type xml_attribute_tag() :: atom(). +-type xml_attribute_value() :: string(). +-type xml_content() :: [simple_xml() | iolist()]. +-type xpath() :: {xpath,string()}. + +-type netconf_db() :: running | startup | candidate. +-type xs_datetime() :: string(). +%% This date and time identifyer has the same format as the XML type +%% dateTime and compliant to RFC3339. The format is +%% ```[-]CCYY-MM-DDThh:mm:ss[.s][Z|(+|-)hh:mm]''' + +%%---------------------------------------------------------------------- +%% External interface functions +%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +-spec open(Options) -> Result when + Options :: options(), + Result :: {ok,handle()} | {error,error_reason()}. +%% @doc Open a netconf session and exchange `hello' messages. +%% +%% If the server options are specified in a configuration file, or if +%% a named client is needed for logging purposes (see {@section +%% Logging}) use {@link open/2} instead. +%% +%% The opaque `handler()' reference which is returned from this +%% function is required as client identifier when calling any other +%% function in this module. +%% +%% The `timeout' option (milli seconds) is used when setting up +%% the ssh connection and when waiting for the hello message from the +%% server. It is not used for any other purposes during the lifetime +%% of the connection. +%% +%% @end +%%---------------------------------------------------------------------- +open(Options) -> + open(Options,#options{},[],true). + +%%---------------------------------------------------------------------- +-spec open(KeyOrName, ExtraOptions) -> Result when + KeyOrName :: key_or_name(), + ExtraOptions :: options(), + Result :: {ok,handle()} | {error,error_reason()}. +%% @doc Open a named netconf session and exchange `hello' messages. +%% +%% If `KeyOrName' is a configured `server_id()' or a +%% `target_name()' associated with such an ID, then the options +%% for this server will be fetched from the configuration file. +% +%% The `ExtraOptions' argument will be added to the options found in +%% the configuration file. If the same options are given, the values +%% from the configuration file will overwrite `ExtraOptions'. +%% +%% If the server is not specified in a configuration file, use {@link +%% open/1} instead. +%% +%% The opaque `handle()' reference which is returned from this +%% function can be used as client identifier when calling any other +%% function in this module. However, if `KeyOrName' is a +%% `target_name()', i.e. if the server is named via a call to +%% `ct:require/2' or a `require' statement in the test +%% suite, then this name may be used instead of the `handle()'. +%% +%% The `timeout' option (milli seconds) is used when setting up +%% the ssh connection and when waiting for the hello message from the +%% server. It is not used for any other purposes during the lifetime +%% of the connection. +%% +%% @end +%%---------------------------------------------------------------------- +open(KeyOrName, ExtraOpts) -> + open(KeyOrName, ExtraOpts, true). + +open(KeyOrName, ExtraOpts, Hello) -> + SortedExtra = lists:keysort(1,ExtraOpts), + SortedConfig = lists:keysort(1,ct:get_config(KeyOrName,[])), + AllOpts = lists:ukeymerge(1,SortedConfig,SortedExtra), + open(AllOpts,#options{name=KeyOrName},[{name,KeyOrName}],Hello). + +open(OptList,InitOptRec,NameOpt,Hello) -> + case check_options(OptList,undefined,undefined,InitOptRec) of + {Host,Port,Options} -> + case ct_gen_conn:start({Host,Port},Options,?MODULE, + NameOpt ++ [{reconnect,false}, + {use_existing_connection,false}, + {forward_messages,true}]) of + {ok,Client} when Hello==true -> + case hello(Client,Options#options.timeout) of + ok -> + {ok,Client}; + Error -> + Error + end; + Other -> + Other + end; + Error -> + Error + end. + + +%%---------------------------------------------------------------------- +-spec only_open(Options) -> Result when + Options :: options(), + Result :: {ok,handle()} | {error,error_reason()}. +%% @doc Open a netconf session, but don't send `hello'. +%% +%% As {@link open/1} but does not send a `hello' message. +%% +%% @end +%%---------------------------------------------------------------------- +only_open(Options) -> + open(Options,#options{},[],false). + +%%---------------------------------------------------------------------- +-spec only_open(KeyOrName,ExtraOptions) -> Result when + KeyOrName :: key_or_name(), + ExtraOptions :: options(), + Result :: {ok,handle()} | {error,error_reason()}. +%% @doc Open a name netconf session, but don't send `hello'. +%% +%% As {@link open/2} but does not send a `hello' message. +%% +%% @end +%%---------------------------------------------------------------------- +only_open(KeyOrName, ExtraOpts) -> + open(KeyOrName, ExtraOpts, false). + +%%---------------------------------------------------------------------- +%% @spec hello(Client) -> Result +%% @equiv hello(Client, infinity) +hello(Client) -> + hello(Client,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec hello(Client,Timeout) -> Result when + Client :: handle(), + 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. +%% +%% @end +%%---------------------------------------------------------------------- +hello(Client,Timeout) -> + call(Client, {hello, Timeout}). + +%%---------------------------------------------------------------------- +%% @spec get_session_id(Client) -> Result +%% @equiv get_session_id(Client, infinity) +get_session_id(Client) -> + get_session_id(Client, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec get_session_id(Client, Timeout) -> Result when + Client :: client(), + Timeout :: timeout(), + Result :: pos_integer() | {error,error_reason()}. +%% @doc Returns the session id associated with the given client. +%% +%% @end +%%---------------------------------------------------------------------- +get_session_id(Client, Timeout) -> + call(Client, get_session_id, Timeout). + +%%---------------------------------------------------------------------- +%% @spec get_capabilities(Client) -> Result +%% @equiv get_capabilities(Client, infinity) +get_capabilities(Client) -> + get_capabilities(Client, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec get_capabilities(Client, Timeout) -> Result when + Client :: client(), + Timeout :: timeout(), + Result :: [string()] | {error,error_reason()}. +%% @doc Returns the server side capabilities +%% +%% The following capability identifiers, defined in RFC 4741, can be returned: +%% +%% <ul> +%% <li>`"urn:ietf:params:netconf:base:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:writable-running:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:candidate:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:confirmed-commit:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:rollback-on-error:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:startup:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:url:1.0"'</li> +%% <li>`"urn:ietf:params:netconf:capability:xpath:1.0"'</li> +%% </ul> +%% +%% Note, additional identifiers may exist, e.g. server side namespace. +%% +%% @end +%%---------------------------------------------------------------------- +get_capabilities(Client, Timeout) -> + call(Client, get_capabilities, Timeout). + +%% @private +send(Client, SimpleXml) -> + send(Client, SimpleXml, ?DEFAULT_TIMEOUT). +%% @private +send(Client, SimpleXml, Timeout) -> + call(Client,{send, Timeout, SimpleXml}). + +%% @private +send_rpc(Client, SimpleXml) -> + send_rpc(Client, SimpleXml, ?DEFAULT_TIMEOUT). +%% @private +send_rpc(Client, SimpleXml, Timeout) -> + call(Client,{send_rpc, SimpleXml, Timeout}). + + + +%%---------------------------------------------------------------------- +%% @spec lock(Client, Target) -> Result +%% @equiv lock(Client, Target, infinity) +lock(Client, Target) -> + lock(Client, Target,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec lock(Client, Target, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Unlock configuration target. +%% +%% Which target parameters that can be used depends on if +%% `:candidate' and/or `:startup' are supported by the +%% server. If successfull, the configuration system of the device is +%% not available to other clients (Netconf, CORBA, SNMP etc). Locks +%% are intended to be short-lived. +%% +%% The operations {@link kill_session/2} or {@link kill_session/3} can +%% be used to force the release of a lock owned by another Netconf +%% session. How this is achieved by the server side is implementation +%% specific. +%% +%% @end +%%---------------------------------------------------------------------- +lock(Client, Target, Timeout) -> + call(Client,{send_rpc_op,lock,[Target],Timeout}). + +%%---------------------------------------------------------------------- +%% @spec unlock(Client, Target) -> Result +%% @equiv unlock(Client, Target, infinity) +unlock(Client, Target) -> + unlock(Client, Target,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec unlock(Client, Target, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Unlock configuration target. +%% +%% If the client earlier has aquired a lock, via {@link lock/2} or +%% {@link lock/3}, this operation release the associated lock. To be +%% able to access another target than `running', the server must +%% support `:candidate' and/or `:startup'. +%% +%% @end +%%---------------------------------------------------------------------- +unlock(Client, Target, Timeout) -> + call(Client, {send_rpc_op, unlock, [Target], Timeout}). + +%%---------------------------------------------------------------------- +%% @spec get(Client, Filter) -> Result +%% @equiv get(Client, Filter, infinity) +get(Client, Filter) -> + get(Client, Filter, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec get(Client, Filter, Timeout) -> Result when + Client :: client(), + Filter :: simple_xml() | xpath(), + Timeout :: timeout(), + Result :: {ok,simple_xml()} | {error,error_reason()}. +%% @doc Get data. +%% +%% This operation returns both configuration and state data from the +%% server. +%% +%% Filter type `xpath' can only be used if the server supports +%% `:xpath'. +%% +%% @end +%%---------------------------------------------------------------------- +get(Client, Filter, Timeout) -> + call(Client,{send_rpc_op, get, [Filter], Timeout}). + +%%---------------------------------------------------------------------- +%% @spec get_config(Client, Source, Filter) -> Result +%% @equiv get_config(Client, Source, Filter, infinity) +get_config(Client, Source, Filter) -> + get_config(Client, Source, Filter, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec get_config(Client, Source, Filter, Timeout) -> Result when + Client :: client(), + Source :: netconf_db(), + Filter :: simple_xml() | xpath(), + Timeout :: timeout(), + Result :: {ok,simple_xml()} | {error,error_reason()}. +%% @doc Get configuration data. +%% +%% To be able to access another source than `running', the server +%% must advertise `:candidate' and/or `:startup'. +%% +%% Filter type `xpath' can only be used if the server supports +%% `:xpath'. +%% +%% +%% @end +%%---------------------------------------------------------------------- +get_config(Client, Source, Filter, Timeout) -> + call(Client, {send_rpc_op, get_config, [Source, Filter], Timeout}). + +%%---------------------------------------------------------------------- +%% @spec edit_config(Client, Target, Config) -> Result +%% @equiv edit_config(Client, Target, Config, infinity) +edit_config(Client, Target, Config) -> + edit_config(Client, Target, Config, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec edit_config(Client, Target, Config, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Config :: simple_xml(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Edit configuration data. +%% +%% Per default only the running target is available, unless the server +%% include `:candidate' or `:startup' in its list of +%% capabilities. +%% +%% @end +%%---------------------------------------------------------------------- +edit_config(Client, Target, Config, Timeout) -> + call(Client, {send_rpc_op, edit_config, [Target,Config], Timeout}). + + +%%---------------------------------------------------------------------- +%% @spec delete_config(Client, Target) -> Result +%% @equiv delete_config(Client, Target, infinity) +delete_config(Client, Target) -> + delete_config(Client, Target, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec delete_config(Client, Target, Timeout) -> Result when + Client :: client(), + Target :: startup | candidate, + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Delete configuration data. +%% +%% The running configuration cannot be deleted and `:candidate' +%% or `:startup' must be advertised by the server. +%% +%% @end +%%---------------------------------------------------------------------- +delete_config(Client, Target, Timeout) when Target == startup; + Target == candidate -> + call(Client,{send_rpc_op, delete_config, [Target], Timeout}). + +%%---------------------------------------------------------------------- +%% @spec copy_config(Client, Source, Target) -> Result +%% @equiv copy_config(Client, Source, Target, infinity) +copy_config(Client, Source, Target) -> + copy_config(Client, Source, Target, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec copy_config(Client, Target, Source, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Source :: netconf_db(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Copy configuration data. +%% +%% Which source and target options that can be issued depends on the +%% capabilities supported by the server. I.e. `:candidate' and/or +%% `:startup' are required. +%% +%% @end +%%---------------------------------------------------------------------- +copy_config(Client, Target, Source, Timeout) -> + call(Client,{send_rpc_op, copy_config, [Target, Source], Timeout}). + +%%---------------------------------------------------------------------- +%% @spec action(Client, Action) -> Result +%% @equiv action(Client, Action, infinity) +action(Client,Action) -> + action(Client,Action,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec action(Client, Action, Timeout) -> Result when + Client :: client(), + Action :: simple_xml(), + Timeout :: timeout(), + Result :: {ok,simple_xml()} | {error,error_reason()}. +%% @doc Execute an action. +%% +%% @end +%%---------------------------------------------------------------------- +action(Client,Action,Timeout) -> + call(Client,{send_rpc_op, action, [Action], Timeout}). + +%%---------------------------------------------------------------------- +create_subscription(Client) -> + create_subscription(Client,?DEFAULT_STREAM,?DEFAULT_TIMEOUT). + +create_subscription(Client,Timeout) + when ?is_timeout(Timeout) -> + create_subscription(Client,?DEFAULT_STREAM,Timeout); +create_subscription(Client,Stream) + when is_list(Stream) -> + create_subscription(Client,Stream,?DEFAULT_TIMEOUT); +create_subscription(Client,Filter) + when ?is_filter(Filter) -> + create_subscription(Client,?DEFAULT_STREAM,Filter, + ?DEFAULT_TIMEOUT). + +create_subscription(Client,Stream,Timeout) + when is_list(Stream) andalso + ?is_timeout(Timeout) -> + call(Client,{send_rpc_op,{create_subscription,self()}, + [Stream,undefined,undefined,undefined], + Timeout}); +create_subscription(Client,StartTime,StopTime) + when is_list(StartTime) andalso + is_list(StopTime) -> + create_subscription(Client,?DEFAULT_STREAM,StartTime,StopTime, + ?DEFAULT_TIMEOUT); +create_subscription(Client,Filter,Timeout) + when ?is_filter(Filter) andalso + ?is_timeout(Timeout) -> + create_subscription(Client,?DEFAULT_STREAM,Filter,Timeout); +create_subscription(Client,Stream,Filter) + when is_list(Stream) andalso + ?is_filter(Filter) -> + create_subscription(Client,Stream,Filter,?DEFAULT_TIMEOUT). + +create_subscription(Client,StartTime,StopTime,Timeout) + when is_list(StartTime) andalso + is_list(StopTime) andalso + ?is_timeout(Timeout) -> + create_subscription(Client,?DEFAULT_STREAM,StartTime,StopTime,Timeout); +create_subscription(Client,Stream,StartTime,StopTime) + when is_list(Stream) andalso + is_list(StartTime) andalso + is_list(StopTime) -> + create_subscription(Client,Stream,StartTime,StopTime,?DEFAULT_TIMEOUT); +create_subscription(Client,Filter,StartTime,StopTime) + when ?is_filter(Filter) andalso + is_list(StartTime) andalso + is_list(StopTime) -> + create_subscription(Client,?DEFAULT_STREAM,Filter, + StartTime,StopTime,?DEFAULT_TIMEOUT); +create_subscription(Client,Stream,Filter,Timeout) + when is_list(Stream) andalso + ?is_filter(Filter) andalso + ?is_timeout(Timeout) -> + call(Client,{send_rpc_op,{create_subscription,self()}, + [Stream,Filter,undefined,undefined], + Timeout}). + +create_subscription(Client,Stream,StartTime,StopTime,Timeout) + when is_list(Stream) andalso + is_list(StartTime) andalso + is_list(StopTime) andalso + ?is_timeout(Timeout) -> + call(Client,{send_rpc_op,{create_subscription,self()}, + [Stream,undefined,StartTime,StopTime], + Timeout}); +create_subscription(Client,Stream,Filter,StartTime,StopTime) + when is_list(Stream) andalso + ?is_filter(Filter) andalso + is_list(StartTime) andalso + is_list(StopTime) -> + create_subscription(Client,Stream,Filter,StartTime,StopTime,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec create_subscription(Client, Stream, Filter,StartTime, StopTime, Timeout) -> + Result when + Client :: client(), + Stream :: stream_name(), + Filter :: simple_xml(), + StartTime :: xs_datetime(), + StopTime :: xs_datetime(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Create a subscription for event notifications. +%% +%% This function sets up a subscription for netconf event +%% notifications of the given stream type, matching the given +%% filter. The calling process will receive notifications as messages +%% of type `notification()'. +%% +%% <dl> +%% <dt>Stream:</dt> +%% <dd> An optional parameter that indicates which stream of events +%% is of interest. If not present, events in the default NETCONF +%% stream will be sent.</dd> +%% +%% <dt>Filter:</dt> +%% <dd>An optional parameter that indicates which subset of all +%% possible events is of interest. The format of this parameter is +%% the same as that of the filter parameter in the NETCONF protocol +%% operations. If not present, all events not precluded by other +%% parameters will be sent. See section 3.6 for more information on +%% filters.</dd> +%% +%% <dt>StartTime:</dt> +%% <dd>An optional parameter used to trigger the replay feature and +%% indicate that the replay should start at the time specified. If +%% `StartTime' is not present, this is not a replay subscription. +%% It is not valid to specify start times that are later than the +%% current time. If the `StartTime' specified is earlier than the +%% log can support, the replay will begin with the earliest +%% available notification. This parameter is of type dateTime and +%% compliant to [RFC3339]. Implementations must support time +%% zones.</dd> +%% +%% <dt>StopTime:</dt> +%% <dd>An optional parameter used with the optional replay feature +%% to indicate the newest notifications of interest. If `StopTime' +%% is not present, the notifications will continue until the +%% subscription is terminated. Must be used with and be later than +%% `StartTime'. Values of `StopTime' in the future are valid. This +%% parameter is of type dateTime and compliant to [RFC3339]. +%% Implementations must support time zones.</dd> +%% </dl> +%% +%% See RFC5277 for further details about the event notification +%% mechanism. +%% +%% @end +%%---------------------------------------------------------------------- +create_subscription(Client,Stream,Filter,StartTime,StopTime,Timeout) -> + call(Client,{send_rpc_op,{create_subscription, self()}, + [Stream,Filter,StartTime,StopTime], + Timeout}). + +%%---------------------------------------------------------------------- +%% @spec get_event_streams(Client, Timeout) -> Result +%% @equiv get_event_streams(Client, [], Timeout) +get_event_streams(Client,Timeout) when is_integer(Timeout); Timeout==infinity -> + get_event_streams(Client,[],Timeout); + +%%---------------------------------------------------------------------- +%% @spec get_event_streams(Client, Streams) -> Result +%% @equiv get_event_streams(Client, Streams, infinity) +get_event_streams(Client,Streams) when is_list(Streams) -> + get_event_streams(Client,Streams,?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec get_event_streams(Client, Streams, Timeout) + -> Result when + Client :: client(), + Streams :: [stream_name()], + Timeout :: timeout(), + Result :: {ok,streams()} | {error,error_reason()}. +%% @doc Send a request to get the given event streams. +%% +%% `Streams' is a list of stream names. The following filter will +%% be sent to the netconf server in a `get' request: +%% +%% ``` +%% <netconf xmlns="urn:ietf:params:xml:ns:netmod:notification"> +%% <streams> +%% <stream> +%% <name>StreamName1</name> +%% </stream> +%% <stream> +%% <name>StreamName2</name> +%% </stream> +%% ... +%% </streams> +%% </netconf> +%% ''' +%% +%% If `Streams' is an empty list, ALL streams will be requested +%% by sending the following filter: +%% +%% ``` +%% <netconf xmlns="urn:ietf:params:xml:ns:netmod:notification"> +%% <streams/> +%% </netconf> +%% ''' +%% +%% If more complex filtering is needed, a use {@link get/2} or {@link +%% get/3} and specify the exact filter according to XML Schema for +%% Event Notifications found in RFC5277. +%% +%% @end +%%---------------------------------------------------------------------- +get_event_streams(Client,Streams,Timeout) -> + call(Client,{get_event_streams,Streams,Timeout}). + + +%%---------------------------------------------------------------------- +%% @spec close_session(Client) -> Result +%% @equiv close_session(Client, infinity) +close_session(Client) -> + close_session(Client, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec close_session(Client, Timeout) -> Result when + Client :: client(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Request graceful termination of the session associated with the client. +%% +%% When a netconf server receives a `close-session' request, it +%% will gracefully close the session. The server will release any +%% locks and resources associated with the session and gracefully +%% close any associated connections. Any NETCONF requests received +%% after a `close-session' request will be ignored. +%% +%% @end +%%---------------------------------------------------------------------- +close_session(Client, Timeout) -> + call(Client,{send_rpc_op, close_session, [], Timeout}). + + +%%---------------------------------------------------------------------- +%% @spec kill_session(Client, SessionId) -> Result +%% @equiv kill_session(Client, SessionId, infinity) +kill_session(Client, SessionId) -> + kill_session(Client, SessionId, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec kill_session(Client, SessionId, Timeout) -> Result when + Client :: client(), + SessionId :: pos_integer(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Force termination of the session associated with the supplied +%% session id. +%% +%% The server side shall abort any operations currently in process, +%% release any locks and resources associated with the session, and +%% close any associated connections. +%% +%% Only if the server is in the confirmed commit phase, the +%% configuration will be restored to its state before entering the +%% confirmed commit phase. Otherwise, no configuration roll back will +%% be performed. +%% +%% If the given `SessionId' is equal to the current session id, +%% an error will be returned. +%% +%% @end +%% ---------------------------------------------------------------------- +kill_session(Client, SessionId, Timeout) -> + call(Client,{send_rpc_op, kill_session, [SessionId], Timeout}). + + +%%---------------------------------------------------------------------- +%% Callback functions +%%---------------------------------------------------------------------- + +%% @private +init(_KeyOrName,{_Host,_Port},Options) -> + case ssh_open(Options) of + {ok, Connection} -> + log(Connection,open), + {ConnPid,_} = Connection#connection.reference, + {ok, ConnPid, #state{connection = Connection}}; + {error,Reason}-> + {error,Reason} + end. + +%% @private +terminate(_, #state{connection=Connection}) -> + ssh_close(Connection), + log(Connection,close), + ok. + +%% @private +handle_msg({hello,Timeout}, From, + #state{connection=Connection,hello_status=HelloStatus} = State) -> + case do_send(Connection, client_hello()) of + ok -> + case HelloStatus of + undefined -> + {Ref,TRef} = set_request_timer(Timeout), + {noreply, State#state{hello_status=#pending{tref=TRef, + ref=Ref, + caller=From}}}; + received -> + {reply, ok, State#state{hello_status=done}}; + {error,Reason} -> + {stop, {error,Reason}, State} + end; + Error -> + {stop, Error, State} + end; +handle_msg(_, _From, #state{session_id=undefined} = State) -> + %% Hello is not yet excanged - this shall never happen + {reply,{error,waiting_for_hello},State}; +handle_msg(get_capabilities, _From, #state{capabilities = Caps} = State) -> + {reply, Caps, State}; +handle_msg(get_session_id, _From, #state{session_id = Id} = State) -> + {reply, Id, State}; +handle_msg({send, Timeout, SimpleXml}, From, + #state{connection=Connection,pending=Pending} = State) -> + case do_send(Connection, SimpleXml) of + ok -> + {Ref,TRef} = set_request_timer(Timeout), + {noreply, State#state{pending=[#pending{tref=TRef, + ref=Ref, + caller=From} | Pending]}}; + Error -> + {reply, Error, State} + end; +handle_msg({send_rpc, SimpleXml, Timeout}, From, State) -> + do_send_rpc(undefined, SimpleXml, Timeout, From, State); +handle_msg({send_rpc_op, Op, Data, Timeout}, From, State) -> + SimpleXml = encode_rpc_operation(Op,Data), + do_send_rpc(Op, SimpleXml, Timeout, From, State); +handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> + Filter = {netconf,?NETMOD_NOTIF_NAMESPACE_ATTR, + [{streams,[{stream,[{name,[Name]}]} || Name <- Streams]}]}, + SimpleXml = encode_rpc_operation(get,[Filter]), + do_send_rpc(Op, SimpleXml, Timeout, From, State). + +handle_msg({ssh_cm, _CM, {data, _Ch, _Type, Data}}, State) -> + handle_data(Data, State); +handle_msg({ssh_cm, _CM, {closed,_Ch}}, State) -> + %% This will happen if the server terminates the connection, as in + %% kill-session (or if ssh:close is called from somewhere + %% unexpected). + + %%! Log this?? - i.e. as server closing the connection + %%! Currently the log will say that the client closed the + %%! connection - due to terminate/2 + + {stop, State}; +handle_msg({Ref,timeout}, + #state{hello_status=#pending{ref=Ref,caller=Caller}} = State) -> + ct_gen_conn:return(Caller,{error,{hello_session_failed,timeout}}), + {stop,State#state{hello_status={error,timeout}}}; +handle_msg({Ref,timeout},#state{pending=Pending} = State) -> + {value,#pending{caller=Caller},Pending1} = + lists:keytake(Ref,#pending.ref,Pending), + ct_gen_conn:return(Caller,{error,timeout}), + {noreply,State#state{pending=Pending1}}. + +%% @private +%% Called by ct_util_server to close registered connections before terminate. +close(Client) -> + case get_handle(Client) of + {ok,Pid} -> + case ct_gen_conn:stop(Pid) of + {error,{process_down,Pid,noproc}} -> + {error,already_closed}; + Result -> + Result + end; + Error -> + Error + end. + + +%%---------------------------------------------------------------------- +%% Internal functions +%%---------------------------------------------------------------------- +call(Client, Msg) -> + call(Client, Msg, infinity). +call(Client, Msg, Timeout) -> + case get_handle(Client) of + {ok,Pid} -> + case ct_gen_conn:call(Pid,Msg,Timeout) of + {error,{process_down,Client,noproc}} -> + {error,no_such_client}; + {error,{process_down,Client,normal}} -> + {error,closed}; + {error,{process_down,Client,Reason}} -> + {error,{closed,Reason}}; + Other -> + Other + end; + Error -> + Error + end. + +get_handle(Client) when is_pid(Client) -> + {ok,Client}; +get_handle(Client) -> + case ct_util:get_connections(Client, ?MODULE) of + {ok,[{Pid,_}]} -> + {ok,Pid}; + {ok,[]} -> + {error,{no_connection_found,Client}}; + {ok,Conns} -> + {error,{multiple_connections_found,Client,Conns}}; + Error -> + Error + end. + +check_options([], undefined, _Port, _Options) -> + {error, no_host_address}; +check_options([], _Host, undefined, _Options) -> + {error, no_port}; +check_options([], Host, Port, Options) -> + {Host,Port,Options}; +check_options([{ssh, Host}|T], _, Port, #options{} = Options) -> + check_options(T, Host, Port, Options#options{host=Host}); +check_options([{port,Port}|T], Host, _, #options{} = Options) -> + check_options(T, Host, Port, Options#options{port=Port}); +check_options([{timeout, Timeout}|T], Host, Port, Options) + when is_integer(Timeout); Timeout==infinity -> + check_options(T, Host, Port, Options#options{timeout = Timeout}); +check_options([{X,_}=Opt|T], Host, Port, #options{ssh=SshOpts}=Options) -> + case lists:member(X,?VALID_SSH_OPTS) of + true -> + check_options(T, Host, Port, Options#options{ssh=[Opt|SshOpts]}); + false -> + {error, {invalid_option, Opt}} + end. + +%%%----------------------------------------------------------------- +set_request_timer(infinity) -> + {undefined,undefined}; +set_request_timer(T) -> + Ref = make_ref(), + {ok,TRef} = timer:send_after(T,{Ref,timeout}), + {Ref,TRef}. + + +%%%----------------------------------------------------------------- +client_hello() -> + {hello, ?NETCONF_NAMESPACE_ATTR, + [{capabilities, + [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}]}]}. + +%%%----------------------------------------------------------------- + +encode_rpc_operation(Lock,[Target]) when Lock==lock; Lock==unlock -> + {Lock,[{target,[Target]}]}; +encode_rpc_operation(get,[Filter]) -> + {get,filter(Filter)}; +encode_rpc_operation(get_config,[Source,Filter]) -> + {'get-config',[{source,[Source]}] ++ filter(Filter)}; +encode_rpc_operation(edit_config,[Target,Config]) -> + {'edit-config',[{target,[Target]},{config,[Config]}]}; +encode_rpc_operation(delete_config,[Target]) -> + {'delete-config',[{target,[Target]}]}; +encode_rpc_operation(copy_config,[Target,Source]) -> + {'copy-config',[{target,[Target]},{source,[Source]}]}; +encode_rpc_operation(action,[Action]) -> + {action,?ACTION_NAMESPACE_ATTR,[{data,[Action]}]}; +encode_rpc_operation(kill_session,[SessionId]) -> + {'kill-session',[{'session-id',[integer_to_list(SessionId)]}]}; +encode_rpc_operation(close_session,[]) -> + 'close-session'; +encode_rpc_operation({create_subscription,_}, + [Stream,Filter,StartTime,StopTime]) -> + {'create-subscription',?NETCONF_NOTIF_NAMESPACE_ATTR, + [{stream,[Stream]}] ++ + filter(Filter) ++ + maybe_element(startTime,StartTime) ++ + maybe_element(stopTime,StopTime)}. + +filter(undefined) -> + []; +filter({xpath,Filter}) when ?is_string(Filter) -> + [{filter,[{type,"xpath"},{select, Filter}],[]}]; +filter(Filter) -> + [{filter,[{type,"subtree"}],[Filter]}]. + +maybe_element(_,undefined) -> + []; +maybe_element(Tag,Value) -> + [{Tag,[Value]}]. + +%%%----------------------------------------------------------------- +%%% Send XML data to server +do_send_rpc(PendingOp,SimpleXml,Timeout,Caller, + #state{connection=Connection,msg_id=MsgId,pending=Pending} = State) -> + case do_send_rpc(Connection, MsgId, SimpleXml) of + ok -> + {Ref,TRef} = set_request_timer(Timeout), + {noreply, State#state{msg_id=MsgId+1, + pending=[#pending{tref=TRef, + ref=Ref, + msg_id=MsgId, + op=PendingOp, + caller=Caller} | Pending]}}; + Error -> + {reply, Error, State#state{msg_id=MsgId+1}} + end. + +do_send_rpc(Connection, MsgId, SimpleXml) -> + do_send(Connection, + {rpc, + [{'message-id',MsgId} | ?NETCONF_NAMESPACE_ATTR], + [SimpleXml]}). + +do_send(Connection, SimpleXml) -> + Xml=to_xml_doc(SimpleXml), + log(Connection,send,Xml), + ssh_send(Connection, Xml). + +to_xml_doc(Simple) -> + Prolog = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>", + Xml = list_to_binary(xmerl:export_simple([Simple], + xmerl_xml, + [#xmlAttribute{name=prolog, + value=Prolog}])), + <<Xml/binary,?END_TAG/binary>>. + +%%%----------------------------------------------------------------- +%%% Parse and handle received XML data +handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> + 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}, + {data,Data}]), + 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}) -> + 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}) + end. + + + +%% 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. +sax_event(Event,_Loc,State) -> + sax_event(Event,State). + +sax_event({startPrefixMapping, Prefix, Uri},Acc) -> + %% startPrefixMapping will always come immediately before the + %% startElement where the namespace is defined. + [{xmlns,{Prefix,Uri}}|Acc]; +sax_event({startElement,_Uri,_Name,QN,Attrs},Acc) -> + %% Pick out any namespace attributes inserted due to a + %% startPrefixMapping event.The rest of Acc will then be only + %% elements. + {NsAttrs,NewAcc} = split_attrs_and_elements(Acc,[]), + Tag = qn_to_tag(QN), + [{Tag,NsAttrs ++ parse_attrs(Attrs),[]}|NewAcc]; +sax_event({endElement,_Uri,_Name,_QN},[{Name,Attrs,Cont},{Parent,PA,PC}|Acc]) -> + [{Parent,PA,[{Name,Attrs,lists:reverse(Cont)}|PC]}|Acc]; +sax_event(endDocument,[{Tag,Attrs,Cont}]) -> + {Tag,Attrs,lists:reverse(Cont)}; +sax_event({characters,String},[{Name,Attrs,Cont}|Acc]) -> + [{Name,Attrs,[String|Cont]}|Acc]; +sax_event(_Event,State) -> + State. + +split_attrs_and_elements([{xmlns,{Prefix,Uri}}|Rest],Attrs) -> + split_attrs_and_elements(Rest,[{xmlnstag(Prefix),Uri}|Attrs]); +split_attrs_and_elements(Elements,Attrs) -> + {Attrs,Elements}. + +xmlnstag([]) -> + xmlns; +xmlnstag(Prefix) -> + list_to_atom("xmlns:"++Prefix). + +qn_to_tag({[],Name}) -> + list_to_atom(Name); +qn_to_tag({Prefix,Name}) -> + list_to_atom(Prefix ++ ":" ++ Name). + +parse_attrs([{_Uri, [], Name, Value}|Attrs]) -> + [{list_to_atom(Name),Value}|parse_attrs(Attrs)]; +parse_attrs([{_Uri, Prefix, Name, Value}|Attrs]) -> + [{list_to_atom(Prefix ++ ":" ++ Name),Value}|parse_attrs(Attrs)]; +parse_attrs([]) -> + []. + + +%%%----------------------------------------------------------------- +%%% Decoding of parsed XML data +decode({Tag,Attrs,_}=E, #state{connection=Connection,pending=Pending}=State) -> + ConnName = Connection#connection.name, + case get_local_name_atom(Tag) of + 'rpc-reply' -> + case get_msg_id(Attrs) of + undefined -> + case Pending of + [#pending{msg_id=MsgId}] -> + ?error(ConnName,[{warning,rpc_reply_missing_msg_id}, + {assuming,MsgId}]), + decode_rpc_reply(MsgId,E,State); + _ -> + ?error(ConnName,[{error,rpc_reply_missing_msg_id}]), + {noreply,State} + end; + MsgId -> + decode_rpc_reply(MsgId,E,State) + end; + hello -> + case State#state.hello_status of + undefined -> + case decode_hello(E) of + {ok,SessionId,Capabilities} -> + {noreply,State#state{session_id = SessionId, + capabilities = Capabilities, + hello_status = received}}; + {error,Reason} -> + {noreply,State#state{hello_status = {error,Reason}}} + end; + #pending{tref=TRef,caller=Caller} -> + timer:cancel(TRef), + case decode_hello(E) of + {ok,SessionId,Capabilities} -> + ct_gen_conn:return(Caller,ok), + {noreply,State#state{session_id = SessionId, + capabilities = Capabilities, + hello_status = done}}; + {error,Reason} -> + ct_gen_conn:return(Caller,{error,Reason}), + {stop,State#state{hello_status={error,Reason}}} + end; + Other -> + ?error(ConnName,[{got_unexpected_hello,E}, + {hello_status,Other}]), + {noreply,State} + end; + notification -> + EventReceiver = State#state.event_receiver, + EventReceiver ! E, + {noreply,State}; + Other -> + %% Result of send/2, when not sending an rpc request - or + %% if netconf server sends noise. Can handle this only if + %% there is just one pending that matches (i.e. has + %% undefined msg_id and op) + case [P || P = #pending{msg_id=undefined,op=undefined} <- Pending] of + [#pending{tref=TRef, + caller=Caller}] -> + timer:cancel(TRef), + ct_gen_conn:return(Caller,E), + {noreply,State#state{pending=[]}}; + _ -> + ?error(ConnName,[{got_unexpected_msg,Other}, + {expecting,Pending}]), + {noreply,State} + end + + end. + +get_msg_id(Attrs) -> + case lists:keyfind('message-id',1,Attrs) of + {_,Str} -> + list_to_integer(Str); + false -> + undefined + end. + +decode_rpc_reply(MsgId,{_,Attrs,Content0}=E,#state{pending=Pending} = State) -> + case lists:keytake(MsgId,#pending.msg_id,Pending) of + {value, #pending{tref=TRef,op=Op,caller=Caller}, Pending1} -> + timer:cancel(TRef), + Content = forward_xmlns_attr(Attrs,Content0), + {CallerReply,{ServerReply,State2}} = + do_decode_rpc_reply(Op,Content,State#state{pending=Pending1}), + ct_gen_conn:return(Caller,CallerReply), + {ServerReply,State2}; + false -> + %% Result of send/2, when receiving a correct + %% rpc-reply. Can handle this only if there is just one + %% pending that matches (i.e. has undefined msg_id and op) + case [P || P = #pending{msg_id=undefined,op=undefined} <- Pending] of + [#pending{tref=TRef, + msg_id=undefined, + op=undefined, + caller=Caller}] -> + timer:cancel(TRef), + ct_gen_conn:return(Caller,E), + {noreply,State#state{pending=[]}}; + _ -> + ConnName = (State#state.connection)#connection.name, + ?error(ConnName,[{got_unexpected_msg_id,MsgId}, + {expecting,Pending}]), + {noreply,State} + end + end. + +do_decode_rpc_reply(Op,Result,State) + when Op==lock; Op==unlock; Op==edit_config; Op==delete_config; + Op==copy_config; Op==kill_session -> + {decode_ok(Result),{noreply,State}}; +do_decode_rpc_reply(Op,Result,State) + when Op==get; Op==get_config; Op==action -> + {decode_data(Result),{noreply,State}}; +do_decode_rpc_reply(close_session,Result,State) -> + case decode_ok(Result) of + ok -> {ok,{stop,State}}; + Other -> {Other,{noreply,State}} + end; +do_decode_rpc_reply({create_subscription,Caller},Result,State) -> + case decode_ok(Result) of + ok -> + {ok,{noreply,State#state{event_receiver=Caller}}}; + Other -> + {Other,{noreply,State}} + end; +do_decode_rpc_reply(get_event_streams,Result,State) -> + {decode_streams(decode_data(Result)),{noreply,State}}; +do_decode_rpc_reply(undefined,Result,State) -> + {Result,{noreply,State}}. + + + +decode_ok([{Tag,Attrs,Content}]) -> + case get_local_name_atom(Tag) of + ok -> + ok; + 'rpc-error' -> + {error,forward_xmlns_attr(Attrs,Content)}; + _Other -> + {error,{unexpected_rpc_reply,[{Tag,Attrs,Content}]}} + end; +decode_ok(Other) -> + {error,{unexpected_rpc_reply,Other}}. + +decode_data([{Tag,Attrs,Content}]) -> + case get_local_name_atom(Tag) of + data -> + %% Since content of data has nothing from the netconf + %% namespace, we remove the parent's xmlns attribute here + %% - just to make the result cleaner + {ok,forward_xmlns_attr(remove_xmlnsattr_for_tag(Tag,Attrs),Content)}; + 'rpc-error' -> + {error,forward_xmlns_attr(Attrs,Content)}; + _Other -> + {error,{unexpected_rpc_reply,[{Tag,Attrs,Content}]}} + end; +decode_data(Other) -> + {error,{unexpected_rpc_reply,Other}}. + +get_qualified_name(Tag) -> + case string:tokens(atom_to_list(Tag),":") of + [TagStr] -> {[],TagStr}; + [PrefixStr,TagStr] -> {PrefixStr,TagStr} + end. + +get_local_name_atom(Tag) -> + {_,TagStr} = get_qualified_name(Tag), + list_to_atom(TagStr). + + +%% Remove the xmlns attr that points to the tag. I.e. if the tag has a +%% prefix, remove {'xmlns:prefix',_}, else remove default {xmlns,_}. +remove_xmlnsattr_for_tag(Tag,Attrs) -> + {Prefix,_TagStr} = get_qualified_name(Tag), + XmlnsTag = xmlnstag(Prefix), + case lists:keytake(XmlnsTag,1,Attrs) of + {value,_,NoNsAttrs} -> + NoNsAttrs; + false -> + Attrs + end. + +%% Take all xmlns attributes from the parent's attribute list and +%% forward into all childrens' attribute lists. But do not overwrite +%% any. +forward_xmlns_attr(ParentAttrs,Children) -> + do_forward_xmlns_attr(get_all_xmlns_attrs(ParentAttrs,[]),Children). + +do_forward_xmlns_attr(XmlnsAttrs,[{ChT,ChA,ChC}|Children]) -> + ChA1 = add_xmlns_attrs(XmlnsAttrs,ChA), + [{ChT,ChA1,ChC} | do_forward_xmlns_attr(XmlnsAttrs,Children)]; +do_forward_xmlns_attr(_XmlnsAttrs,[]) -> + []. + +add_xmlns_attrs([{Key,_}=A|XmlnsAttrs],ChA) -> + case lists:keymember(Key,1,ChA) of + true -> + add_xmlns_attrs(XmlnsAttrs,ChA); + false -> + add_xmlns_attrs(XmlnsAttrs,[A|ChA]) + end; +add_xmlns_attrs([],ChA) -> + ChA. + +get_all_xmlns_attrs([{xmlns,_}=Default|Attrs],XmlnsAttrs) -> + get_all_xmlns_attrs(Attrs,[Default|XmlnsAttrs]); +get_all_xmlns_attrs([{Key,_}=Attr|Attrs],XmlnsAttrs) -> + case atom_to_list(Key) of + "xmlns:"++_Prefix -> + get_all_xmlns_attrs(Attrs,[Attr|XmlnsAttrs]); + _ -> + get_all_xmlns_attrs(Attrs,XmlnsAttrs) + end; +get_all_xmlns_attrs([],XmlnsAttrs) -> + XmlnsAttrs. + + +%% Decode server hello to pick out session id and capabilities +decode_hello({hello,_Attrs,Hello}) -> + case lists:keyfind('session-id',1,Hello) of + {'session-id',_,[SessionId]} -> + case lists:keyfind(capabilities,1,Hello) of + {capabilities,_,Capabilities} -> + case decode_caps(Capabilities,[],false) of + {ok,Caps} -> + {ok,list_to_integer(SessionId),Caps}; + Error -> + Error + end; + false -> + {error,{incorrect_hello,capabilities_not_found}} + end; + false -> + {error,{incorrect_hello,no_session_id_found}} + end. + +decode_caps([{capability,[],[?NETCONF_BASE_CAP++Vsn=Cap]} |Caps], Acc, _) -> + case Vsn of + ?NETCONF_BASE_CAP_VSN -> + decode_caps(Caps, [Cap|Acc], true); + _ -> + {error,{incompatible_base_capability_vsn,Vsn}} + end; +decode_caps([{capability,[],[Cap]}|Caps],Acc,Base) -> + decode_caps(Caps,[Cap|Acc],Base); +decode_caps([H|_T],_,_) -> + {error,{unexpected_capability_element,H}}; +decode_caps([],_,false) -> + {error,{incorrect_hello,no_base_capability_found}}; +decode_caps([],Acc,true) -> + {ok,lists:reverse(Acc)}. + + +%% Return a list of {Name,Data}, where data is a {Tag,Value} list for each stream +decode_streams({error,Reason}) -> + {error,Reason}; +decode_streams({ok,[{netconf,_,Streams}]}) -> + {ok,decode_streams(Streams)}; +decode_streams([{streams,_,Streams}]) -> + decode_streams(Streams); +decode_streams([{stream,_,Stream} | Streams]) -> + {name,_,[Name]} = lists:keyfind(name,1,Stream), + [{Name,[{Tag,Value} || {Tag,_,[Value]} <- Stream, Tag /= name]} + | decode_streams(Streams)]; +decode_streams([]) -> + []. + + +%%%----------------------------------------------------------------- +%%% Logging + +log(Connection,Action) -> + log(Connection,Action,<<>>). +log(#connection{host=Host,port=Port,name=Name},Action,Data) -> + error_logger:info_report(#conn_log{client=self(), + address={Host,Port}, + name=Name, + action=Action, + module=?MODULE}, + Data). + + +%% Log callback - called from the error handler process +format_data(raw,Data) -> + io_lib:format("~n~s~n",[hide_password(Data)]); +format_data(pretty,Data) -> + io_lib:format("~n~s~n",[indent(Data)]); +format_data(html,Data) -> + io_lib:format("~n~s~n",[html_format(Data)]). + +%%%----------------------------------------------------------------- +%%% Hide password elements from XML data +hide_password(Bin) -> + re:replace(Bin,<<"(<password[^>]*>)[^<]*(</password>)">>,<<"\\1*****\\2">>, + [global,{return,binary}]). + +%%%----------------------------------------------------------------- +%%% HTML formatting +html_format(Bin) -> + binary:replace(indent(Bin),<<"<">>,<<"<">>,[global]). + +%%%----------------------------------------------------------------- +%%% Indentation of XML code +indent(Bin) -> + String = normalize(hide_password(Bin)), + IndentedString = + case erase(part_of_line) of + undefined -> + indent1(String,[]); + Part -> + indent1(lists:reverse(Part)++String,erase(indent)) + end, + list_to_binary(IndentedString). + +%% Normalizes the XML document by removing all space and newline +%% between two XML tags. +%% Returns a list, no matter if the input was a list or a binary. +normalize(Str) -> + re:replace(Str,<<">[ \r\n\t]+<">>,<<"><">>,[global,{return,list}]). + + +indent1("<?"++Rest1,Indent1) -> + %% Prolog + {Line,Rest2,Indent2} = indent_line(Rest1,Indent1,[$?,$<]), + Line++indent1(Rest2,Indent2); +indent1("</"++Rest1,Indent1) -> + %% Stop tag + {Line,Rest2,Indent2} = indent_line1(Rest1,Indent1,[$/,$<]), + "\n"++Line++indent1(Rest2,Indent2); +indent1("<"++Rest1,Indent1) -> + %% Start- or empty tag + put(tag,get_tag(Rest1)), + {Line,Rest2,Indent2} = indent_line(Rest1,Indent1,[$<]), + "\n"++Line++indent1(Rest2,Indent2); +indent1([H|T],Indent) -> + [H|indent1(T,Indent)]; +indent1([],_Indent) -> + []. + +indent_line("?>"++Rest,Indent,Line) -> + %% Prolog + {lists:reverse(Line)++"?>",Rest,Indent}; +indent_line("/></"++Rest,Indent,Line) -> + %% Empty tag, and stop of parent tag -> one step out in indentation + {Indent++lists:reverse(Line)++"/>","</"++Rest,Indent--" "}; +indent_line("/>"++Rest,Indent,Line) -> + %% Empty tag, then probably next tag -> keep indentation + {Indent++lists:reverse(Line)++"/>",Rest,Indent}; +indent_line("></"++Rest,Indent,Line) -> + LastTag = erase(tag), + case get_tag(Rest) of + LastTag -> + %% Start and stop tag, but no content + indent_line1(Rest,Indent,[$/,$<,$>|Line]); + _ -> + %% Stop tag completed, and then stop tag of parent -> one step out + {Indent++lists:reverse(Line)++">","</"++Rest,Indent--" "} + end; +indent_line("><"++Rest,Indent,Line) -> + %% Stop tag completed, and new tag comming -> keep indentation + {Indent++lists:reverse(Line)++">","<"++Rest," "++Indent}; +indent_line("</"++Rest,Indent,Line) -> + %% Stop tag starting -> search for end of this tag + indent_line1(Rest,Indent,[$/,$<|Line]); +indent_line([H|T],Indent,Line) -> + indent_line(T,Indent,[H|Line]); +indent_line([],Indent,Line) -> + %% The line is not complete - will be continued later + put(part_of_line,Line), + put(indent,Indent), + {[],[],Indent}. + +indent_line1("></"++Rest,Indent,Line) -> + %% Stop tag completed, and then stop tag of parent -> one step out + {Indent++lists:reverse(Line)++">","</"++Rest,Indent--" "}; +indent_line1(">"++Rest,Indent,Line) -> + %% Stop tag completed -> keep indentation + {Indent++lists:reverse(Line)++">",Rest,Indent}; +indent_line1([H|T],Indent,Line) -> + indent_line1(T,Indent,[H|Line]); +indent_line1([],Indent,Line) -> + %% The line is not complete - will be continued later + put(part_of_line,Line), + put(indent,Indent), + {[],[],Indent}. + +get_tag("/>"++_) -> + []; +get_tag(">"++_) -> + []; +get_tag([H|T]) -> + [H|get_tag(T)]; +get_tag([]) -> + %% The line is not complete - will be continued later. + []. + + +%%%----------------------------------------------------------------- +%%% SSH stuff +ssh_receive_data() -> + receive + {ssh_cm, _CM, {data, _Ch, _Type, 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, + [{user_interaction,false}, + {silently_accept_hosts, true}|SshOpts]) of + {ok,CM} -> + case ssh_connection:session_channel(CM, Timeout) of + {ok,Ch} -> + case ssh_connection:subsystem(CM, Ch, "netconf", Timeout) of + success -> + {ok, #connection{reference = {CM,Ch}, + host = Host, + port = Port, + name = Name}}; + failure -> + ssh:close(CM), + {error,{ssh,could_not_execute_netconf_subsystem}} + end; + {error, Reason} -> + ssh:close(CM), + {error,{ssh,could_not_open_channel,Reason}}; + Other -> + %% Bug in ssh?? got {closed,0} here once... + {error,{ssh,unexpected_from_session_channel,Other}} + end; + {error,Reason} -> + {error,{ssh,could_not_connect_to_server,Reason}} + end. + +ssh_send(#connection{reference = {CM,Ch}}, Data) -> + case ssh_connection:send(CM, Ch, Data) of + ok -> ok; + {error,Reason} -> {error,{ssh,failed_to_send_data,Reason}} + end. + +ssh_close(#connection{reference = {CM,_Ch}}) -> + ssh:close(CM). + + +%%---------------------------------------------------------------------- +%% END OF MODULE +%%---------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_netconfc.hrl b/lib/common_test/src/ct_netconfc.hrl new file mode 100644 index 0000000000..295a61a98b --- /dev/null +++ b/lib/common_test/src/ct_netconfc.hrl @@ -0,0 +1,58 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% File: ct_netconfc.hrl +%% +%% Description: +%% This file defines constant values and records used by the +%% netconf client ct_netconfc. +%% +%% @author Support +%% @doc Netconf Client Interface. +%% @end +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- + + +%% Default port number (RFC 4742/IANA). +-define(DEFAULT_PORT, 830). + +%% Default timeout to wait for netconf server to reply to a request +-define(DEFAULT_TIMEOUT, infinity). %% msec + +%% Namespaces +-define(NETCONF_NAMESPACE_ATTR,[{xmlns,?NETCONF_NAMESPACE}]). +-define(ACTION_NAMESPACE_ATTR,[{xmlns,?ACTION_NAMESPACE}]). +-define(NETCONF_NOTIF_NAMESPACE_ATTR,[{xmlns,?NETCONF_NOTIF_NAMESPACE}]). +-define(NETMOD_NOTIF_NAMESPACE_ATTR,[{xmlns,?NETMOD_NOTIF_NAMESPACE}]). + +-define(NETCONF_NAMESPACE,"urn:ietf:params:xml:ns:netconf:base:1.0"). +-define(ACTION_NAMESPACE,"urn:com:ericsson:ecim:1.0"). +-define(NETCONF_NOTIF_NAMESPACE, + "urn:ietf:params:xml:ns:netconf:notification:1.0"). +-define(NETMOD_NOTIF_NAMESPACE,"urn:ietf:params:xml:ns:netmod:notification"). + +%% Capabilities +-define(NETCONF_BASE_CAP,"urn:ietf:params:netconf:base:"). +-define(NETCONF_BASE_CAP_VSN,"1.0"). + +%% Misc +-define(END_TAG,<<"]]>]]>">>). + +-define(FORMAT(_F, _A), lists:flatten(io_lib:format(_F, _A))). diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl index e6eb135ae8..a47309c6ee 100644 --- a/lib/common_test/src/ct_repeat.erl +++ b/lib/common_test/src/ct_repeat.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. 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 @@ -41,72 +41,86 @@ loop_test(If,Args) when is_list(Args) -> case get_loop_info(Args) of no_loop -> false; - {error,E} -> + E = {error,_} -> io:format("Common Test error: ~p\n\n",[E]), file:set_cwd(Cwd), E; {repeat,N} -> io:format("\nCommon Test: Will repeat tests ~w times.\n\n",[N]), Args1 = [{loop_info,[{repeat,1,N}]} | Args], - loop(If,repeat,0,N,undefined,Args1,undefined), - file:set_cwd(Cwd); + Result = loop(If,repeat,0,N,undefined,Args1,undefined,[]), + file:set_cwd(Cwd), + Result; {stop_time,StopTime} -> - case remaining_time(StopTime) of - 0 -> - io:format("\nCommon Test: No time left to run tests.\n\n",[]), - ok; - Secs -> - io:format("\nCommon Test: Will repeat tests for ~s.\n\n", - [ts(Secs)]), - TPid = - case lists:keymember(force_stop,1,Args) of - true -> - CtrlPid = self(), - spawn(fun() -> stop_after(CtrlPid,Secs) end); - false -> - undefined - end, - Args1 = [{loop_info,[{stop_time,Secs,StopTime,1}]} | Args], - loop(If,stop_time,0,Secs,StopTime,Args1,TPid) - end, - file:set_cwd(Cwd) + Result = + case remaining_time(StopTime) of + 0 -> + io:format("\nCommon Test: " + "No time left to run tests.\n\n",[]), + {error,not_enough_time}; + Secs -> + io:format("\nCommon Test: " + "Will repeat tests for ~s.\n\n",[ts(Secs)]), + TPid = + case lists:keymember(force_stop,1,Args) of + true -> + CtrlPid = self(), + spawn(fun() -> stop_after(CtrlPid,Secs) end); + false -> + undefined + end, + Args1 = [{loop_info,[{stop_time,Secs,StopTime,1}]} | Args], + loop(If,stop_time,0,Secs,StopTime,Args1,TPid,[]) + end, + file:set_cwd(Cwd), + Result end. -loop(_,repeat,N,N,_,_Args,_) -> - ok; +loop(_,repeat,N,N,_,_Args,_,AccResult) -> + lists:reverse(AccResult); -loop(If,Type,N,Data0,Data1,Args,TPid) -> +loop(If,Type,N,Data0,Data1,Args,TPid,AccResult) -> Pid = spawn_tester(If,self(),Args), receive {'EXIT',Pid,Reason} -> - io:format("Test run crashed! This could be an internal error " - "- please report!\n\n" - "~p\n\n",[Reason]), - cancel(TPid), - {error,Reason}; + case Reason of + {user_error,What} -> + io:format("\nTest run failed!\nReason: ~p\n\n\n", [What]), + cancel(TPid), + {error,What}; + _ -> + io:format("Test run crashed! This could be an internal error " + "- please report!\n\n" + "~p\n\n\n",[Reason]), + cancel(TPid), + {error,Reason} + end; {Pid,{error,Reason}} -> - io:format("\nTest run failed!\nReason: ~p\n\n",[Reason]), + io:format("\nTest run failed!\nReason: ~p\n\n\n",[Reason]), cancel(TPid), {error,Reason}; {Pid,Result} -> if Type == repeat -> - io:format("\nTest run ~w(~w) complete.\n\n",[N+1,Data0]), + io:format("\nTest run ~w(~w) complete.\n\n\n",[N+1,Data0]), lists:keydelete(loop_info,1,Args), Args1 = [{loop_info,[{repeat,N+2,Data0}]} | Args], - loop(If,repeat,N+1,Data0,Data1,Args1,TPid); + loop(If,repeat,N+1,Data0,Data1,Args1,TPid,[Result|AccResult]); Type == stop_time -> case remaining_time(Data1) of 0 -> - io:format("\nTest time (~s) has run out.\n\n",[ts(Data0)]), + io:format("\nTest time (~s) has run out.\n\n\n", + [ts(Data0)]), cancel(TPid), - Result; + lists:reverse([Result|AccResult]); Secs -> io:format("\n~s of test time remaining, " - "starting run #~w...\n\n",[ts(Secs),N+2]), + "starting run #~w...\n\n\n", + [ts(Secs),N+2]), lists:keydelete(loop_info,1,Args), ST = {stop_time,Data0,Data1,N+2}, Args1 = [{loop_info,[ST]} | Args], - loop(If,stop_time,N+1,Data0,Data1,Args1,TPid) + loop(If,stop_time,N+1,Data0,Data1,Args1,TPid, + [Result|AccResult]) end end end. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 666eb3c988..a202ca15e2 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. 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 @@ -39,12 +39,20 @@ %% Misc internal functions -export([variables_file_name/1,script_start1/2,run_test2/1]). +-include("ct.hrl"). -include("ct_event.hrl"). -include("ct_util.hrl"). -define(abs(Name), filename:absname(Name)). -define(testdir(Name, Suite), ct_util:get_testdir(Name, Suite)). +-define(EXIT_STATUS_TEST_SUCCESSFUL, 0). +-define(EXIT_STATUS_TEST_CASE_FAILED, 1). +-define(EXIT_STATUS_TEST_RUN_FAILED, 2). + +-define(default_verbosity, [{default,?MAX_VERBOSITY}, + {'$unspecified',?MAX_VERBOSITY}]). + -record(opts, {label, profile, vts, @@ -54,11 +62,14 @@ step, logdir, logopts = [], + basic_html, + verbosity = [], config = [], event_handlers = [], ct_hooks = [], - enable_builtin_hooks = true, + enable_builtin_hooks, include = [], + auto_compile, silent_connections, stylesheet, multiply_timetraps = 1, @@ -102,7 +113,8 @@ script_start() -> end, Flags) end, %% used for purpose of testing the run_test interface - io:format(user, "~n-------------------- START ARGS --------------------~n", []), + io:format(user, "~n-------------------- START ARGS " + "--------------------~n", []), io:format(user, "--- Init args:~n~p~n", [FlagFilter(Init)]), io:format(user, "--- CT args:~n~p~n", [FlagFilter(CtArgs)]), EnvArgs = opts2args(EnvStartOpts), @@ -110,7 +122,8 @@ script_start() -> [EnvStartOpts,EnvArgs]), Merged = merge_arguments(CtArgs ++ EnvArgs), io:format(user, "--- Merged args:~n~p~n", [FlagFilter(Merged)]), - io:format(user, "----------------------------------------------------~n~n", []), + io:format(user, "-----------------------------------" + "-----------------~n~n", []), Merged; _ -> merge_arguments(CtArgs) @@ -122,46 +135,100 @@ script_start() -> script_start(Args) -> Tracing = start_trace(Args), - Res = - case ct_repeat:loop_test(script, Args) of - false -> - {ok,Cwd} = file:get_cwd(), - CTVsn = - case filename:basename(code:lib_dir(common_test)) of - CTBase when is_list(CTBase) -> - case string:tokens(CTBase, "-") of - ["common_test",Vsn] -> " v"++Vsn; - _ -> "" - end - end, - io:format("~nCommon Test~s starting (cwd is ~s)~n~n", [CTVsn,Cwd]), - Self = self(), - Pid = spawn_link(fun() -> script_start1(Self, Args) end), - receive - {'EXIT',Pid,Reason} -> - case Reason of - {user_error,What} -> - io:format("\nTest run failed!\nReason: ~p\n\n", [What]), - {error,What}; - _ -> - io:format("Test run crashed! This could be an internal error " - "- please report!\n\n" - "~p\n\n", [Reason]), - {error,Reason} - end; - {Pid,{error,Reason}} -> - io:format("\nTest run failed! Reason:\n~p\n\n",[Reason]), - {error,Reason}; - {Pid,Result} -> - Result - end; - Result -> - Result - end, + case ct_repeat:loop_test(script, Args) of + false -> + {ok,Cwd} = file:get_cwd(), + CTVsn = + case filename:basename(code:lib_dir(common_test)) of + CTBase when is_list(CTBase) -> + case string:tokens(CTBase, "-") of + ["common_test",Vsn] -> " v"++Vsn; + _ -> "" + end + end, + io:format("~nCommon Test~s starting (cwd is ~s)~n~n", + [CTVsn,Cwd]), + Self = self(), + Pid = spawn_link(fun() -> script_start1(Self, Args) end), + receive + {'EXIT',Pid,Reason} -> + case Reason of + {user_error,What} -> + io:format("\nTest run failed!\nReason: ~p\n\n\n", + [What]), + finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args); + _ -> + io:format("Test run crashed! " + "This could be an internal error " + "- please report!\n\n" + "~p\n\n\n", [Reason]), + finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args) + end; + {Pid,{error,Reason}} -> + io:format("\nTest run failed! Reason:\n~p\n\n\n",[Reason]), + finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args); + {Pid,Result} -> + io:nl(), + finish(Tracing, analyze_test_result(Result, Args), Args) + end; + {error,_LoopReason} -> + finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args); + Result -> + io:nl(), + finish(Tracing, analyze_test_result(Result, Args), Args) + end. + +%% analyze the result of one test run, or many (in case of looped test) +analyze_test_result(ok, _) -> + ?EXIT_STATUS_TEST_SUCCESSFUL; +analyze_test_result({error,_Reason}, _) -> + ?EXIT_STATUS_TEST_RUN_FAILED; +analyze_test_result({_Ok,Failed,{_UserSkipped,AutoSkipped}}, Args) -> + if Failed > 0 -> + ?EXIT_STATUS_TEST_CASE_FAILED; + true -> + case AutoSkipped of + 0 -> + ?EXIT_STATUS_TEST_SUCCESSFUL; + _ -> + case get_start_opt(exit_status, + fun([ExitOpt]) -> ExitOpt end, + Args) of + undefined -> + ?EXIT_STATUS_TEST_CASE_FAILED; + "ignore_config" -> + ?EXIT_STATUS_TEST_SUCCESSFUL + end + end + end; +analyze_test_result([Result|Rs], Args) -> + case analyze_test_result(Result, Args) of + ?EXIT_STATUS_TEST_SUCCESSFUL -> + analyze_test_result(Rs, Args); + Other -> + Other + end; +analyze_test_result([], _) -> + ?EXIT_STATUS_TEST_SUCCESSFUL; +analyze_test_result(Unknown, _) -> + io:format("\nTest run failed! Reason:\n~p\n\n\n",[Unknown]), + ?EXIT_STATUS_TEST_RUN_FAILED. + +finish(Tracing, ExitStatus, Args) -> stop_trace(Tracing), timer:sleep(1000), - io:nl(), - Res. + %% 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. script_start1(Parent, Args) -> %% read general start flags @@ -173,6 +240,7 @@ script_start1(Parent, Args) -> LogDir = get_start_opt(logdir, fun([LogD]) -> LogD end, Args), LogOpts = get_start_opt(logopts, fun(Os) -> [list_to_atom(O) || O <- Os] end, [], Args), + Verbosity = verbosity_args2opts(Args), MultTT = get_start_opt(multiply_timetraps, fun([MT]) -> list_to_integer(MT) end, 1, Args), ScaleTT = get_start_opt(scale_timetraps, @@ -187,8 +255,8 @@ script_start1(Parent, Args) -> CTHooks = ct_hooks_args2opts(Args), EnableBuiltinHooks = get_start_opt(enable_builtin_hooks, fun([CT]) -> list_to_atom(CT); - ([]) -> true - end, true, Args), + ([]) -> undefined + end, undefined, Args), %% check flags and set corresponding application env variables @@ -206,7 +274,7 @@ script_start1(Parent, Args) -> end end, %% no_auto_compile + include - IncludeDirs = + {AutoCompile,IncludeDirs} = case proplists:get_value(no_auto_compile, Args) of undefined -> application:set_env(common_test, auto_compile, true), @@ -222,16 +290,16 @@ script_start1(Parent, Args) -> case os:getenv("CT_INCLUDE_PATH") of false -> application:set_env(common_test, include, InclDirs), - InclDirs; + {undefined,InclDirs}; CtInclPath -> AllInclDirs = string:tokens(CtInclPath,[$:,$ ,$,]) ++ InclDirs, application:set_env(common_test, include, AllInclDirs), - AllInclDirs + {undefined,AllInclDirs} end; _ -> application:set_env(common_test, auto_compile, false), - [] + {false,[]} end, %% silent connections SilentConns = @@ -243,19 +311,24 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - case proplists:get_value(basic_html, Args) of - undefined -> - application:set_env(common_test, basic_html, false); - _ -> - application:set_env(common_test, basic_html, true) - end, + BasicHtml = case proplists:get_value(basic_html, Args) of + undefined -> + application:set_env(common_test, basic_html, false), + undefined; + _ -> + application:set_env(common_test, basic_html, true), + true + end, StartOpts = #opts{label = Label, profile = Profile, vts = Vts, shell = Shell, cover = Cover, logdir = LogDir, logopts = LogOpts, + basic_html = BasicHtml, + verbosity = Verbosity, event_handlers = EvHandlers, ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, + auto_compile = AutoCompile, include = IncludeDirs, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -325,9 +398,12 @@ script_start2(StartOpts = #opts{vts = undefined, AllLogOpts = merge_vals([StartOpts#opts.logopts, SpecStartOpts#opts.logopts]), - - Cover = choose_val(StartOpts#opts.cover, - SpecStartOpts#opts.cover), + AllVerbosity = + merge_keyvals([StartOpts#opts.verbosity, + SpecStartOpts#opts.verbosity]), + Cover = + choose_val(StartOpts#opts.cover, + SpecStartOpts#opts.cover), MultTT = choose_val(StartOpts#opts.multiply_timetraps, SpecStartOpts#opts.multiply_timetraps), @@ -352,9 +428,36 @@ script_start2(StartOpts = #opts{vts = undefined, StartOpts#opts.enable_builtin_hooks, SpecStartOpts#opts.enable_builtin_hooks), + Stylesheet = + choose_val(StartOpts#opts.stylesheet, + SpecStartOpts#opts.stylesheet), + AllInclude = merge_vals([StartOpts#opts.include, SpecStartOpts#opts.include]), application:set_env(common_test, include, AllInclude), + + AutoCompile = + case choose_val(StartOpts#opts.auto_compile, + SpecStartOpts#opts.auto_compile) of + undefined -> + true; + ACBool -> + application:set_env(common_test, + auto_compile, + ACBool), + ACBool + end, + + BasicHtml = + case choose_val(StartOpts#opts.basic_html, + SpecStartOpts#opts.basic_html) of + undefined -> + false; + BHBool -> + application:set_env(common_test, basic_html, + BHBool), + BHBool + end, {TS,StartOpts#opts{label = Label, profile = Profile, @@ -362,11 +465,15 @@ script_start2(StartOpts = #opts{vts = undefined, cover = Cover, logdir = LogDir, logopts = AllLogOpts, + basic_html = BasicHtml, + verbosity = AllVerbosity, config = SpecStartOpts#opts.config, event_handlers = AllEvHs, ct_hooks = AllCTHooks, enable_builtin_hooks = EnableBuiltinHooks, + stylesheet = Stylesheet, + auto_compile = AutoCompile, include = AllInclude, multiply_timetraps = MultTT, scale_timetraps = ScaleTT, @@ -519,6 +626,7 @@ script_start4(#opts{label = Label, profile = Profile, event_handlers = EvHandlers, ct_hooks = CTHooks, logopts = LogOpts, + verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, logdir = LogDir, testspecs = Specs}, _Args) -> %% label - used by ct_logs @@ -536,7 +644,8 @@ script_start4(#opts{label = Label, profile = Profile, {ct_hooks, CTHooks}, {enable_builtin_hooks,EnableBuiltinHooks}]) of ok -> - ct_util:start(interactive, LogDir), + ct_util:start(interactive, LogDir, + add_verbosity_defaults(Verbosity)), ct_util:set_testdata({logopts, LogOpts}), log_ts_names(Specs), io:nl(), @@ -553,7 +662,7 @@ script_start4(#opts{vts = true, cover = Cover}, _) -> %% Add support later (maybe). io:format("\nCan't run cover in vts mode.\n\n", []) end, - erlang:halt(); + {error,no_cover_in_vts_mode}; script_start4(#opts{shell = true, cover = Cover}, _) -> case Cover of @@ -562,7 +671,8 @@ script_start4(#opts{shell = true, cover = Cover}, _) -> _ -> %% Add support later (maybe). io:format("\nCan't run cover in interactive mode.\n\n", []) - end; + end, + {error,no_cover_in_interactive_mode}; script_start4(Opts = #opts{tests = Tests}, Args) -> do_run(Tests, [], Opts, Args). @@ -579,6 +689,7 @@ script_usage() -> "\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[-multiply_timetraps N]" @@ -593,11 +704,12 @@ script_usage() -> "\n\t[-userconfig CallbackModule ConfigFile1 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t[-logdir LogDir]" + "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" + "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" - "\n\t[-stylesheet CSSFile]" + "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" @@ -613,12 +725,13 @@ script_usage() -> "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" "\n\t[-logdir LogDir]" + "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" + "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" "\n\t[-allow_user_terms]" "\n\t[-silent_connections [ConnType1 ConnType2 .. ConnTypeN]]" "\n\t[-stylesheet CSSFile]" "\n\t[-cover CoverCfgFile]" "\n\t[-event_handler EvHandler1 EvHandler2 .. EvHandlerN]" - "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" "\n\t[-ct_hooks CTHook1 CTHook2 .. CTHookN]" "\n\t[-include InclDir1 InclDir2 .. InclDirN]" "\n\t[-no_auto_compile]" @@ -702,7 +815,7 @@ run_test(StartOpts) when is_list(StartOpts) -> Ref = monitor(process, CTPid), receive {'DOWN',Ref,process,CTPid,{user_error,Error}} -> - Error; + {error,Error}; {'DOWN',Ref,process,CTPid,Other} -> Other end. @@ -739,8 +852,10 @@ run_test2(StartOpts) -> (Lbl) when is_atom(Lbl) -> atom_to_list(Lbl) end, StartOpts), %% profile - Profile = get_start_opt(profile, fun(Prof) when is_list(Prof) -> Prof; - (Prof) when is_atom(Prof) -> atom_to_list(Prof) + Profile = get_start_opt(profile, fun(Prof) when is_list(Prof) -> + Prof; + (Prof) when is_atom(Prof) -> + atom_to_list(Prof) end, StartOpts), %% logdir LogDir = get_start_opt(logdir, fun(LD) when is_list(LD) -> LD end, @@ -748,6 +863,19 @@ run_test2(StartOpts) -> %% logopts LogOpts = get_start_opt(logopts, value, [], StartOpts), + %% verbosity + Verbosity = + get_start_opt(verbosity, + fun(VLvls) when is_list(VLvls) -> + lists:map(fun(VLvl = {_Cat,_Lvl}) -> + VLvl; + (Lvl) -> + {'$unspecified',Lvl} + end, VLvls); + (VLvl) when is_integer(VLvl) -> + [{'$unspecified',VLvl}] + end, [], StartOpts), + %% config & userconfig CfgFiles = ct_config:get_config_file_list(StartOpts), @@ -782,7 +910,7 @@ run_test2(StartOpts) -> fun(EBH) when EBH == true; EBH == false -> EBH - end, true, StartOpts), + end, undefined, StartOpts), %% silent connections SilentConns = get_start_opt(silent_connections, @@ -805,7 +933,7 @@ run_test2(StartOpts) -> CreatePrivDir = get_start_opt(create_priv_dir, value, StartOpts), %% auto compile & include files - Include = + {AutoCompile,Include} = case proplists:get_value(auto_compile, StartOpts) of undefined -> application:set_env(common_test, auto_compile, true), @@ -821,16 +949,16 @@ run_test2(StartOpts) -> case os:getenv("CT_INCLUDE_PATH") of false -> application:set_env(common_test, include, InclDirs), - InclDirs; + {undefined,InclDirs}; CtInclPath -> InclDirs1 = string:tokens(CtInclPath, [$:,$ ,$,]), AllInclDirs = InclDirs1++InclDirs, application:set_env(common_test, include, AllInclDirs), - AllInclDirs + {undefined,AllInclDirs} end; ACBool -> application:set_env(common_test, auto_compile, ACBool), - [] + {ACBool,[]} end, %% decrypt config file @@ -844,11 +972,14 @@ run_test2(StartOpts) -> end, %% basic html - used by ct_logs - case proplists:get_value(basic_html, StartOpts) of - undefined -> - application:set_env(common_test, basic_html, false); - BasicHtmlBool -> - application:set_env(common_test, basic_html, BasicHtmlBool) + BasicHtml = + case proplists:get_value(basic_html, StartOpts) of + undefined -> + application:set_env(common_test, basic_html, false), + undefined; + BasicHtmlBool -> + application:set_env(common_test, basic_html, BasicHtmlBool), + BasicHtmlBool end, %% stepped execution @@ -856,10 +987,13 @@ run_test2(StartOpts) -> Opts = #opts{label = Label, profile = Profile, cover = Cover, step = Step, logdir = LogDir, - logopts = LogOpts, config = CfgFiles, + logopts = LogOpts, basic_html = BasicHtml, + config = CfgFiles, + verbosity = Verbosity, event_handlers = EvHandlers, ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, + auto_compile = AutoCompile, include = Include, silent_connections = SilentConns, stylesheet = Stylesheet, @@ -894,7 +1028,7 @@ run_spec_file(Relaxed, log_ts_names(AbsSpecs), case catch ct_testspec:collect_tests_from_file(AbsSpecs, Relaxed) of {Error,CTReason} when Error == error ; Error == 'EXIT' -> - exit(CTReason); + exit({error,CTReason}); TS -> SpecOpts = get_data_for_node(TS, node()), Label = choose_val(Opts#opts.label, @@ -905,6 +1039,10 @@ run_spec_file(Relaxed, SpecOpts#opts.logdir), AllLogOpts = merge_vals([Opts#opts.logopts, SpecOpts#opts.logopts]), + Stylesheet = choose_val(Opts#opts.stylesheet, + SpecOpts#opts.stylesheet), + AllVerbosity = merge_keyvals([Opts#opts.verbosity, + SpecOpts#opts.verbosity]), AllConfig = merge_vals([CfgFiles, SpecOpts#opts.config]), Cover = choose_val(Opts#opts.cover, SpecOpts#opts.cover), @@ -918,21 +1056,44 @@ run_spec_file(Relaxed, SpecOpts#opts.event_handlers]), AllInclude = merge_vals([Opts#opts.include, SpecOpts#opts.include]), - AllCTHooks = merge_vals([Opts#opts.ct_hooks, - SpecOpts#opts.ct_hooks]), + SpecOpts#opts.ct_hooks]), EnableBuiltinHooks = choose_val(Opts#opts.enable_builtin_hooks, SpecOpts#opts.enable_builtin_hooks), application:set_env(common_test, include, AllInclude), + AutoCompile = case choose_val(Opts#opts.auto_compile, + SpecOpts#opts.auto_compile) of + undefined -> + true; + ACBool -> + application:set_env(common_test, auto_compile, + ACBool), + ACBool + end, + + BasicHtml = case choose_val(Opts#opts.basic_html, + SpecOpts#opts.basic_html) of + undefined -> + false; + BHBool -> + application:set_env(common_test, basic_html, + BHBool), + BHBool + end, + Opts1 = Opts#opts{label = Label, profile = Profile, cover = Cover, logdir = which(logdir, LogDir), logopts = AllLogOpts, + stylesheet = Stylesheet, + basic_html = BasicHtml, + verbosity = AllVerbosity, config = AllConfig, event_handlers = AllEvHs, + auto_compile = AutoCompile, include = AllInclude, testspecs = AbsSpecs, multiply_timetraps = MultTT, @@ -948,20 +1109,20 @@ run_spec_file(Relaxed, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), reformat_result(catch do_run(Run, Skip, Opts1, StartOpts)); {error,GCFReason} -> - exit(GCFReason) + exit({error,GCFReason}) end end. run_prepared(Run, Skip, Opts = #opts{logdir = LogDir, - config = CfgFiles }, + config = CfgFiles}, StartOpts) -> LogDir1 = which(logdir, LogDir), case check_and_install_configfiles(CfgFiles, LogDir1, Opts) of ok -> reformat_result(catch do_run(Run, Skip, Opts#opts{logdir = LogDir1}, StartOpts)); - {error,Reason} -> - exit(Reason) + {error,_Reason} = Error -> + exit(Error) end. check_config_file(Callback, File)-> @@ -969,7 +1130,7 @@ check_config_file(Callback, File)-> false -> case code:load_file(Callback) of {module,_} -> ok; - {error,Why} -> exit({cant_load_callback_module,Why}) + {error,Why} -> exit({error,{cant_load_callback_module,Why}}) end; _ -> ok @@ -980,16 +1141,17 @@ check_config_file(Callback, File)-> {ok,{config,_}}-> File; {error,{wrong_config,Message}}-> - exit({wrong_config,{Callback,Message}}); + exit({error,{wrong_config,{Callback,Message}}}); {error,{nofile,File}}-> - exit({no_such_file,?abs(File)}) + exit({error,{no_such_file,?abs(File)}}) end. run_dir(Opts = #opts{logdir = LogDir, config = CfgFiles, event_handlers = EvHandlers, ct_hooks = CTHook, - enable_builtin_hooks = EnableBuiltinHooks }, StartOpts) -> + enable_builtin_hooks = EnableBuiltinHooks}, + StartOpts) -> LogDir1 = which(logdir, LogDir), Opts1 = Opts#opts{logdir = LogDir1}, AbsCfgFiles = @@ -1002,7 +1164,8 @@ run_dir(Opts = #opts{logdir = LogDir, {module,Callback}-> ok; {error,_}-> - exit({no_such_module,Callback}) + exit({error,{no_such_module, + Callback}}) end end, {Callback, @@ -1015,7 +1178,7 @@ run_dir(Opts = #opts{logdir = LogDir, {ct_hooks, CTHook}, {enable_builtin_hooks,EnableBuiltinHooks}], LogDir1) of ok -> ok; - {error,IReason} -> exit(IReason) + {error,_IReason} = IError -> exit(IError) end, case {proplists:get_value(dir, StartOpts), proplists:get_value(suite, StartOpts), @@ -1057,7 +1220,7 @@ run_dir(Opts = #opts{logdir = LogDir, [], Opts1, StartOpts)); {undefined,[Hd,_|_],_GsAndCs} when not is_integer(Hd) -> - exit(multiple_suites_and_cases); + exit({error,multiple_suites_and_cases}); {undefined,Suite=[Hd|Tl],GsAndCs} when is_integer(Hd) ; (is_list(Hd) and (Tl == [])) ; @@ -1067,10 +1230,10 @@ run_dir(Opts = #opts{logdir = LogDir, [], Opts1, StartOpts)); {[Hd,_|_],_Suites,[]} when is_list(Hd) ; not is_integer(Hd) -> - exit(multiple_dirs_and_suites); + exit({error,multiple_dirs_and_suites}); {undefined,undefined,GsAndCs} when GsAndCs /= [] -> - exit(incorrect_start_options); + exit({error,incorrect_start_options}); {Dir,Suite,GsAndCs} when is_integer(hd(Dir)) ; (is_atom(Dir) and (Dir /= undefined)) ; @@ -1079,7 +1242,7 @@ run_dir(Opts = #opts{logdir = LogDir, Dir1 = if is_atom(Dir) -> atom_to_list(Dir); true -> Dir end, if Suite == undefined -> - exit(incorrect_start_options); + exit({error,incorrect_start_options}); is_integer(hd(Suite)) ; (is_atom(Suite) and (Suite /= undefined)) ; @@ -1098,7 +1261,7 @@ run_dir(Opts = #opts{logdir = LogDir, is_list(Suite) -> % multiple suites case [suite_to_test(Dir1, S) || S <- Suite] of [_,_|_] when GsAndCs /= [] -> - exit(multiple_suites_and_cases); + exit({error,multiple_suites_and_cases}); [{Dir2,Mod}] when GsAndCs /= [] -> reformat_result(catch do_run(tests(Dir2, Mod, GsAndCs), [], Opts1, StartOpts)); @@ -1109,10 +1272,10 @@ run_dir(Opts = #opts{logdir = LogDir, end; {undefined,undefined,[]} -> - exit(no_test_specified); + exit({error,no_test_specified}); {Dir,Suite,GsAndCs} -> - exit({incorrect_start_options,{Dir,Suite,GsAndCs}}) + exit({error,{incorrect_start_options,{Dir,Suite,GsAndCs}}}) end. %%%----------------------------------------------------------------- @@ -1157,7 +1320,7 @@ run_testspec2(File) when is_list(File), is_integer(hd(File)) -> run_testspec2(TestSpec) -> case catch ct_testspec:collect_tests_from_list(TestSpec, false) of {E,CTReason} when E == error ; E == 'EXIT' -> - exit(CTReason); + exit({error,CTReason}); TS -> Opts = get_data_for_node(TS, node()), @@ -1179,8 +1342,8 @@ run_testspec2(TestSpec) -> include = AllInclude}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), reformat_result(catch do_run(Run, Skip, Opts1, [])); - {error,GCFReason} -> - exit(GCFReason) + {error,_GCFReason} = GCFError -> + exit(GCFError) end end. @@ -1188,12 +1351,16 @@ get_data_for_node(#testspec{label = Labels, profile = Profiles, logdir = LogDirs, logopts = LogOptsList, + basic_html = BHs, + stylesheet = SSs, + verbosity = VLvls, cover = CoverFs, config = Cfgs, userconfig = UsrCfgs, event_handler = EvHs, ct_hooks = CTHooks, enable_builtin_hooks = EnableBuiltinHooks, + auto_compile = ACs, include = Incl, multiply_timetraps = MTs, scale_timetraps = STs, @@ -1208,6 +1375,12 @@ get_data_for_node(#testspec{label = Labels, undefined -> []; LOs -> LOs end, + BasicHtml = proplists:get_value(Node, BHs), + Stylesheet = proplists:get_value(Node, SSs), + Verbosity = case proplists:get_value(Node, VLvls) of + undefined -> []; + Lvls -> Lvls + end, Cover = proplists:get_value(Node, CoverFs), MT = proplists:get_value(Node, MTs), ST = proplists:get_value(Node, STs), @@ -1216,16 +1389,21 @@ get_data_for_node(#testspec{label = Labels, [CBF || {N,CBF} <- UsrCfgs, N==Node], EvHandlers = [{H,A} || {N,H,A} <- EvHs, N==Node], FiltCTHooks = [Hook || {N,Hook} <- CTHooks, N==Node], + AutoCompile = proplists:get_value(Node, ACs), Include = [I || {N,I} <- Incl, N==Node], #opts{label = Label, profile = Profile, logdir = LogDir, logopts = LogOpts, + basic_html = BasicHtml, + stylesheet = Stylesheet, + verbosity = Verbosity, cover = Cover, config = ConfigFiles, event_handlers = EvHandlers, ct_hooks = FiltCTHooks, enable_builtin_hooks = EnableBuiltinHooks, + auto_compile = AutoCompile, include = Include, multiply_timetraps = MT, scale_timetraps = ST, @@ -1267,6 +1445,14 @@ choose_val(V0, _V1) -> merge_vals(Vs) -> lists:append(Vs). +merge_keyvals(Vs) -> + make_unique(lists:append(Vs)). + +make_unique([Elem={Key,_} | Elems]) -> + [Elem | make_unique(proplists:delete(Key, Elems))]; +make_unique([]) -> + []. + listify([C|_]=Str) when is_integer(C) -> [Str]; listify(L) when is_list(L) -> L; listify(E) -> [E]. @@ -1376,7 +1562,8 @@ do_run(Tests, Misc, LogDir, LogOpts) when is_list(Misc), do_run(Tests, [], Opts1#opts{logdir = LogDir}, []); do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> - #opts{label = Label, profile = Profile, cover = Cover} = Opts, + #opts{label = Label, profile = Profile, cover = Cover, + verbosity = VLvls} = Opts, %% label - used by ct_logs TestLabel = if Label == undefined -> undefined; @@ -1397,7 +1584,7 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> case code:which(test_server) of non_existing -> - exit({error,no_path_to_test_server}); + {error,no_path_to_test_server}; _ -> Opts1 = if Cover == undefined -> Opts; @@ -1413,81 +1600,131 @@ do_run(Tests, Skip, Opts, Args) when is_record(Opts, opts) -> %% which framework it runs under. case os:getenv("TEST_SERVER_FRAMEWORK") of false -> - os:putenv("TEST_SERVER_FRAMEWORK", "ct_framework"); + os:putenv("TEST_SERVER_FRAMEWORK", "ct_framework"), + os:putenv("TEST_SERVER_FRAMEWORK_NAME", "common_test"); "ct_framework" -> ok; Other -> - erlang:display(list_to_atom("Note: TEST_SERVER_FRAMEWORK = " ++ Other)) + erlang:display( + list_to_atom( + "Note: TEST_SERVER_FRAMEWORK = " ++ Other)) end, - case ct_util:start(Opts#opts.logdir) of + Verbosity = add_verbosity_defaults(VLvls), + case ct_util:start(Opts#opts.logdir, Verbosity) of {error,interactive_mode} -> io:format("CT is started in interactive mode. " - "To exit this mode, run ct:stop_interactive().\n" + "To exit this mode, " + "run ct:stop_interactive().\n" "To enter the interactive mode again, " "run ct:start_interactive()\n\n",[]), {error,interactive_mode}; _Pid -> - %% save stylesheet info - ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), - %% save logopts - ct_util:set_testdata({logopts,Opts#opts.logopts}), - %% enable silent connections - case Opts#opts.silent_connections of - [] -> - Conns = ct_util:override_silence_all_connections(), - ct_logs:log("Silent connections", "~p", [Conns]); - Conns when is_list(Conns) -> - ct_util:override_silence_connections(Conns), - ct_logs:log("Silent connections", "~p", [Conns]); - _ -> - ok - end, - log_ts_names(Opts1#opts.testspecs), - TestSuites = suite_tuples(Tests), - - {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = - case application:get_env(common_test, auto_compile) of - {ok,false} -> - {TestSuites1,SuitesNotFound} = - verify_suites(TestSuites), - {TestSuites1,SuitesNotFound,SuitesNotFound}; - _ -> - {SuiteErrs,HelpErrs} = auto_compile(TestSuites), - {TestSuites,SuiteErrs,SuiteErrs++HelpErrs} - end, + compile_and_run(Tests, Skip, + Opts1#opts{verbosity=Verbosity}, Args) + end + end. - case continue(AllMakeErrors) of - true -> - SavedErrors = save_make_errors(SuiteMakeErrors), - ct_repeat:log_loop_info(Args), +compile_and_run(Tests, Skip, Opts, Args) -> + %% save stylesheet info + ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), + %% save logopts + ct_util:set_testdata({logopts,Opts#opts.logopts}), + %% enable silent connections + case Opts#opts.silent_connections of + [] -> + Conns = ct_util:override_silence_all_connections(), + ct_logs:log("Silent connections", "~p", [Conns]); + Conns when is_list(Conns) -> + ct_util:override_silence_connections(Conns), + ct_logs:log("Silent connections", "~p", [Conns]); + _ -> + ok + end, + log_ts_names(Opts#opts.testspecs), + TestSuites = suite_tuples(Tests), + + {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = + case application:get_env(common_test, auto_compile) of + {ok,false} -> + {TestSuites1,SuitesNotFound} = + verify_suites(TestSuites), + {TestSuites1,SuitesNotFound,SuitesNotFound}; + _ -> + {SuiteErrs,HelpErrs} = auto_compile(TestSuites), + {TestSuites,SuiteErrs,SuiteErrs++HelpErrs} + end, + + case continue(AllMakeErrors) of + true -> + SavedErrors = save_make_errors(SuiteMakeErrors), + ct_repeat:log_loop_info(Args), + + {Tests1,Skip1} = final_tests(Tests,Skip,SavedErrors), + + possibly_spawn(true == proplists:get_value(noinput, Args), + Tests1, Skip1, Opts); + false -> + io:nl(), + ct_util:stop(clean), + BadMods = + lists:foldr( + fun({{_,_},Ms}, Acc) -> + Ms ++ lists:foldl( + fun(M, Acc1) -> + lists:delete(M, Acc1) + end, Acc, Ms) + end, [], AllMakeErrors), + {error,{make_failed,BadMods}} + end. - {Tests1,Skip1} = final_tests(Tests,Skip,SavedErrors), +%% keep the shell as the top controlling process +possibly_spawn(false, Tests, Skip, Opts) -> + TestResult = (catch do_run_test(Tests, Skip, Opts)), + case TestResult of + {EType,_} = Error when EType == user_error; + EType == error -> + ct_util:stop(clean), + exit(Error); + _ -> + ct_util:stop(normal), + TestResult + end; - R = (catch do_run_test(Tests1, Skip1, Opts1)), - case R of - {EType,_} = Error when EType == user_error ; +%% we must return control to the shell now, so we spawn +%% a test supervisor process to keep an eye on the test run +possibly_spawn(true, Tests, Skip, Opts) -> + CTUtilSrv = whereis(ct_util_server), + Supervisor = + fun() -> + process_flag(trap_exit, true), + link(CTUtilSrv), + TestRun = + fun() -> + TestResult = (catch do_run_test(Tests, Skip, Opts)), + case TestResult of + {EType,_} = Error when EType == user_error; EType == error -> ct_util:stop(clean), exit(Error); _ -> ct_util:stop(normal), - R - end; - false -> - io:nl(), - ct_util:stop(clean), - BadMods = - lists:foldr( - fun({{_,_},Ms}, Acc) -> - Ms ++ lists:foldl( - fun(M, Acc1) -> - lists:delete(M, Acc1) - end, Acc, Ms) - end, [], AllMakeErrors), - {error,{make_failed,BadMods}} - end - end - end. + exit({ok,TestResult}) + end + end, + TestRunPid = spawn_link(TestRun), + receive + {'EXIT',TestRunPid,{ok,TestResult}} -> + io:format(user, "~nCommon Test returned ~p~n~n", + [TestResult]); + {'EXIT',TestRunPid,Error} -> + exit(Error) + end + end, + unlink(CTUtilSrv), + SupPid = spawn(Supervisor), + io:format(user, "~nTest control handed over to process ~p~n~n", + [SupPid]), + SupPid. %% attempt to compile the modules specified in TestSuites auto_compile(TestSuites) -> @@ -1503,11 +1740,13 @@ auto_compile(TestSuites) -> end, SuiteMakeErrors = lists:flatmap(fun({TestDir,Suite} = TS) -> - case run_make(suites, TestDir, Suite, UserInclude) of + case run_make(suites, TestDir, + Suite, UserInclude) of {error,{make_failed,Bad}} -> [{TS,Bad}]; {error,_} -> - [{TS,[filename:join(TestDir,"*_SUITE")]}]; + [{TS,[filename:join(TestDir, + "*_SUITE")]}]; _ -> [] end @@ -1546,23 +1785,29 @@ verify_suites(TestSuites) -> {[DS|Found],NotFound}; true -> Beam = filename:join(TestDir, - atom_to_list(Suite)++".beam"), + atom_to_list(Suite)++ + ".beam"), case filelib:is_regular(Beam) of true -> {[DS|Found],NotFound}; false -> case code:is_loaded(Suite) of {file,SuiteFile} -> - %% test suite is already loaded and - %% since auto_compile == false, + %% test suite is already + %% loaded and since + %% auto_compile == false, %% let's assume the user has - %% loaded the beam file explicitly - ActualDir = filename:dirname(SuiteFile), - {[{ActualDir,Suite}|Found],NotFound}; + %% loaded the beam file + %% explicitly + ActualDir = + filename:dirname(SuiteFile), + {[{ActualDir,Suite}|Found], + NotFound}; false -> Name = filename:join(TestDir, - atom_to_list(Suite)), + atom_to_list( + Suite)), io:format(user, "Suite ~w not found" "in directory ~s~n", @@ -1580,7 +1825,8 @@ verify_suites(TestSuites) -> ActualDir = filename:dirname(SuiteFile), {[{ActualDir,Suite}|Found],NotFound}; false -> - io:format(user, "Directory ~s is invalid~n", [Dir]), + io:format(user, "Directory ~s is " + "invalid~n", [Dir]), Name = filename:join(Dir, atom_to_list(Suite)), {Found,[{DS,[Name]}|NotFound]} end @@ -1594,7 +1840,8 @@ save_make_errors([]) -> save_make_errors(Errors) -> Suites = get_bad_suites(Errors,[]), ct_logs:log("MAKE RESULTS", - "Error compiling or locating the following suites: ~n~p",[Suites]), + "Error compiling or locating the " + "following suites: ~n~p",[Suites]), %% save the info for logger file:write_file(?missing_suites_info,term_to_binary(Errors)), Errors. @@ -1615,8 +1862,9 @@ step(TestDir, Suite, Case) -> %%%----------------------------------------------------------------- %%% @hidden %%% @equiv ct:step/4 -step(TestDir, Suite, Case, Opts) when is_list(TestDir), is_atom(Suite), is_atom(Case), - Suite =/= all, Case =/= all -> +step(TestDir, Suite, Case, Opts) when is_list(TestDir), + is_atom(Suite), is_atom(Case), + Suite =/= all, Case =/= all -> do_run([{TestDir,Suite,Case}], [{step,Opts}]). @@ -1734,9 +1982,11 @@ continue(_MakeErrors) -> case set_group_leader_same_as_shell() of true -> S = self(), - io:format("Failed to compile or locate one or more test suites\n" + io:format("Failed to compile or locate one " + "or more test suites\n" "Press \'c\' to continue or \'a\' to abort.\n" - "Will continue in 15 seconds if no answer is given!\n"), + "Will continue in 15 seconds if no " + "answer is given!\n"), Pid = spawn(fun() -> case io:get_line('(c/a) ') of "c\n" -> @@ -1768,7 +2018,8 @@ set_group_leader_same_as_shell() -> end end, case [P || P <- processes(), GS2or3(P), - true == lists:keymember(shell,1,element(2,process_info(P,dictionary)))] of + true == lists:keymember(shell,1, + element(2,process_info(P,dictionary)))] of [GL|_] -> group_leader(GL, self()); [] -> @@ -1814,12 +2065,14 @@ do_run_test(Tests, Skip, Opts) -> incl_mods = CovIncl, cross = CovCross, src = _CovSrc}} -> - ct_logs:log("COVER INFO","Using cover specification file: ~s~n" + ct_logs:log("COVER INFO", + "Using cover specification file: ~s~n" "App: ~w~n" "Cross cover: ~w~n" "Including ~w modules~n" "Excluding ~w modules", - [CovFile,CovApp,CovCross,length(CovIncl),length(CovExcl)]), + [CovFile,CovApp,CovCross, + length(CovIncl),length(CovExcl)]), %% cover export file will be used for export and import %% between tests so make sure it doesn't exist initially @@ -1827,7 +2080,8 @@ do_run_test(Tests, Skip, Opts) -> true -> DelResult = file:delete(CovExport), ct_logs:log("COVER INFO", - "Warning! Export file ~s already exists. " + "Warning! " + "Export file ~s already exists. " "Deleting with result: ~p", [CovExport,DelResult]); false -> @@ -1843,7 +2097,8 @@ do_run_test(Tests, Skip, Opts) -> %% start cover on specified nodes if (CovNodes /= []) and (CovNodes /= undefined) -> ct_logs:log("COVER INFO", - "Nodes included in cover session: ~w", + "Nodes included in cover " + "session: ~w", [CovNodes]), cover:start(CovNodes); true -> @@ -1868,17 +2123,27 @@ do_run_test(Tests, Skip, Opts) -> ct_logs:log("TEST INFO","~w test(s), ~w suite(s)", [NoOfTests,NoOfSuites]); true -> - io:format("~nTEST INFO: ~w test(s), ~w case(s) in ~w suite(s)~n~n", + io:format("~nTEST INFO: ~w test(s), ~w case(s) " + "in ~w suite(s)~n~n", [NoOfTests,NoOfCases,NoOfSuites]), - ct_logs:log("TEST INFO","~w test(s), ~w case(s) in ~w suite(s)", + ct_logs:log("TEST INFO","~w test(s), ~w case(s) " + "in ~w suite(s)", [NoOfTests,NoOfCases,NoOfSuites]) end, - + %% if the verbosity level is set lower than ?STD_IMPORTANCE, tell + %% test_server to ignore stdout printouts to the test case log file + case proplists:get_value(default, Opts#opts.verbosity) of + VLvl when is_integer(VLvl), (?STD_IMPORTANCE < (100-VLvl)) -> + test_server_ctrl:reject_io_reqs(true); + _Lower -> + ok + end, test_server_ctrl:multiply_timetraps(Opts#opts.multiply_timetraps), test_server_ctrl:scale_timetraps(Opts#opts.scale_timetraps), - test_server_ctrl:create_priv_dir(choose_val(Opts#opts.create_priv_dir, - auto_per_run)), + test_server_ctrl:create_priv_dir(choose_val( + Opts#opts.create_priv_dir, + auto_per_run)), ct_event:notify(#event{name=start_info, node=node(), data={NoOfTests,NoOfSuites,NoOfCases}}), @@ -1897,9 +2162,15 @@ do_run_test(Tests, Skip, Opts) -> maybe_cleanup_interpret(Suite, Opts#opts.step) end, CleanUp), [code:del_path(Dir) || Dir <- AddedToPath], - ok; + + case ct_util:get_testdata(stats) of + Stats = {_Ok,_Failed,{_UserSkipped,_AutoSkipped}} -> + Stats; + _ -> + {error,test_result_unknown} + end; Error -> - Error + exit(Error) end. delete_dups([S | Suites]) -> @@ -2328,7 +2599,7 @@ ct_hooks_args2opts(Args) -> Acc end,[],Args). -ct_hooks_args2opts([CTH,Arg,Prio,"and"| Rest],Acc) -> +ct_hooks_args2opts([CTH,Arg,Prio,"and"| Rest],Acc) when Arg /= "and" -> ct_hooks_args2opts(Rest,[{list_to_atom(CTH), parse_cth_args(Arg), parse_cth_args(Prio)}|Acc]); @@ -2356,7 +2627,6 @@ parse_cth_args(String) -> String end. - event_handler_args2opts(Args) -> case proplists:get_value(event_handler, Args) of undefined -> @@ -2379,6 +2649,42 @@ event_handler_init_args2opts([EH, Arg]) -> event_handler_init_args2opts([]) -> []. +verbosity_args2opts(Args) -> + case proplists:get_value(verbosity, Args) of + undefined -> + []; + VArgs -> + GetVLvls = + fun("and", {new,SoFar}) when is_list(SoFar) -> + {new,SoFar}; + ("and", {Lvl,SoFar}) when is_list(SoFar) -> + {new,[{'$unspecified',list_to_integer(Lvl)} | SoFar]}; + (CatOrLvl, {new,SoFar}) when is_list(SoFar) -> + {CatOrLvl,SoFar}; + (Lvl, {Cat,SoFar}) -> + {new,[{list_to_atom(Cat),list_to_integer(Lvl)} | SoFar]} + end, + case lists:foldl(GetVLvls, {new,[]}, VArgs) of + {new,Parsed} -> + Parsed; + {Lvl,Parsed} -> + [{'$unspecified',list_to_integer(Lvl)} | Parsed] + end + end. + +add_verbosity_defaults(VLvls) -> + case {proplists:get_value('$unspecified', VLvls), + proplists:get_value(default, VLvls)} of + {undefined,undefined} -> + ?default_verbosity ++ VLvls; + {Lvl,undefined} -> + [{default,Lvl} | VLvls]; + {undefined,_Lvl} -> + [{'$unspecified',?MAX_VERBOSITY} | VLvls]; + _ -> + VLvls + end. + %% This function reads pa and pz arguments, converts dirs from relative %% to absolute, and re-inserts them in the code path. The order of the %% dirs in the code path remain the same. Note however that since this @@ -2445,7 +2751,11 @@ make_abs1([], Path) -> %% to ct_run start arguments (on the init arguments format) - %% this is useful mainly for testing the ct_run start functions. opts2args(EnvStartOpts) -> - lists:flatmap(fun({config,CfgFiles}) -> + lists:flatmap(fun({exit_status,ExitStatusOpt}) when is_atom(ExitStatusOpt) -> + [{exit_status,[atom_to_list(ExitStatusOpt)]}]; + ({halt_with,{HaltM,HaltF}}) -> + [{halt_with,[atom_to_list(HaltM),atom_to_list(HaltF)]}]; + ({config,CfgFiles}) -> [{ct_config,[CfgFiles]}]; ({userconfig,{CBM,CfgStr=[X|_]}}) when is_integer(X) -> [{userconfig,[atom_to_list(CBM),CfgStr]}]; @@ -2453,10 +2763,14 @@ opts2args(EnvStartOpts) -> [{userconfig,[atom_to_list(CBM) | CfgStrs]}]; ({userconfig,UserCfg}) when is_list(UserCfg) -> Strs = - lists:map(fun({CBM,CfgStr=[X|_]}) when is_integer(X) -> - [atom_to_list(CBM),CfgStr,"and"]; - ({CBM,CfgStrs}) when is_list(CfgStrs) -> - [atom_to_list(CBM) | CfgStrs] ++ ["and"] + lists:map(fun({CBM,CfgStr=[X|_]}) + when is_integer(X) -> + [atom_to_list(CBM), + CfgStr,"and"]; + ({CBM,CfgStrs}) + when is_list(CfgStrs) -> + [atom_to_list(CBM) | CfgStrs] ++ + ["and"] end, UserCfg), [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), [{userconfig,lists:reverse(StrsR)}]; @@ -2491,7 +2805,7 @@ opts2args(EnvStartOpts) -> ({decrypt,{file,File}}) -> [{ct_decrypt_file,[File]}]; ({basic_html,true}) -> - ({basic_html,[]}); + [{basic_html,[]}]; ({basic_html,false}) -> []; ({event_handler,EH}) when is_atom(EH) -> @@ -2504,12 +2818,32 @@ opts2args(EnvStartOpts) -> ({event_handler,{EHs,Arg}}) when is_list(EHs) -> ArgStr = lists:flatten(io_lib:format("~p", [Arg])), Strs = lists:map(fun(EH) -> - [atom_to_list(EH),ArgStr,"and"] + [atom_to_list(EH), + ArgStr,"and"] end, EHs), [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), [{event_handler_init,lists:reverse(StrsR)}]; ({logopts,LOs}) when is_list(LOs) -> [{logopts,[atom_to_list(LO) || LO <- LOs]}]; + ({verbosity,?default_verbosity}) -> + []; + ({verbosity,VLvl}) when is_integer(VLvl) -> + [{verbosity,[integer_to_list(VLvl)]}]; + ({verbosity,VLvls}) when is_list(VLvls) -> + VLvlArgs = + lists:flatmap(fun({'$unspecified',Lvl}) -> + [integer_to_list(Lvl), + "and"]; + ({Cat,Lvl}) -> + [atom_to_list(Cat), + integer_to_list(Lvl), + "and"]; + (Lvl) -> + [integer_to_list(Lvl), + "and"] + end, VLvls), + [_LastAnd|VLvlArgsR] = lists:reverse(VLvlArgs), + [{verbosity,lists:reverse(VLvlArgsR)}]; ({ct_hooks,[]}) -> []; ({ct_hooks,CTHs}) when is_list(CTHs) -> diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index aebb28bc42..09cd4ef02a 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -182,19 +182,22 @@ connect(KeyOrName, ConnType, ExtraOpts) -> undefined -> {ssh,undefined,AllOpts}; SFTPAddr -> - log(heading(connect,KeyOrName), - "Note: Opening ssh connection to sftp host.\n", + try_log(heading(connect,KeyOrName), + "Note: Opening ssh connection " + "to sftp host.\n", []), {ssh,SFTPAddr, - [{ssh,SFTPAddr}|proplists:delete(sftp, AllOpts)]} + [{ssh,SFTPAddr} | + proplists:delete(sftp, AllOpts)]} end; undefined when ConnType == sftp -> case proplists:get_value(ssh, AllOpts) of undefined -> {sftp,undefined,AllOpts}; SSHAddr -> - log(heading(connect,KeyOrName), - "Note: Opening sftp connection to ssh host.\n", + try_log(heading(connect,KeyOrName), + "Note: Opening sftp connection " + "to ssh host.\n", []), {sftp,SSHAddr, [{sftp,SSHAddr}|proplists:delete(ssh, AllOpts)]} @@ -209,15 +212,15 @@ connect(KeyOrName, ConnType, ExtraOpts) -> [{not_available,{KeyOrName,ConnType1}}]), {error,{not_available,{KeyOrName,ConnType1}}}; {_,undefined} -> - log(heading(connect,KeyOrName), - "Opening ~w connection to ~p:22\n", - [ConnType1,Addr]), + try_log(heading(connect,KeyOrName), + "Opening ~w connection to ~p:22\n", + [ConnType1,Addr]), ct_gen_conn:start(KeyOrName, {ConnType1,Addr,22}, AllOpts1, ?MODULE); {_,Port} -> - log(heading(connect,KeyOrName), - "Opening ~w connection to ~p:~w\n", - [ConnType1,Addr,Port]), + try_log(heading(connect,KeyOrName), + "Opening ~w connection to ~p:~w\n", + [ConnType1,Addr,Port]), ct_gen_conn:start(KeyOrName, {ConnType1,Addr,Port}, AllOpts1, ?MODULE) end @@ -232,7 +235,7 @@ connect(KeyOrName, ConnType, ExtraOpts) -> disconnect(SSH) -> case get_handle(SSH) of {ok,Pid} -> - log(heading(disconnect,SSH), "Handle: ~p", [Pid]), + try_log(heading(disconnect,SSH), "Handle: ~p", [Pid], 5000), case ct_gen_conn:stop(Pid) of {error,{process_down,Pid,noproc}} -> {error,already_closed}; @@ -968,8 +971,9 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) -> Error; Ok -> SSHRef = element(2, Ok), - log(heading(init,KeyOrName), - "Opened ~w connection:\nHost: ~p (~p)\nUser: ~p\nPassword: ~p\n", + try_log(heading(init,KeyOrName), + "Opened ~w connection:\n" + "Host: ~p (~p)\nUser: ~p\nPassword: ~p\n", [ConnType,Addr,Port,User,lists:duplicate(length(Password),$*)]), {ok,SSHRef,#state{ssh_ref=SSHRef, conn_type=ConnType, target=KeyOrName}} @@ -978,25 +982,26 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) -> %% @hidden handle_msg(sftp_connect, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(sftp_connect,Target), "SSH Ref: ~p", [SSHRef]), + try_log(heading(sftp_connect,Target), "SSH Ref: ~p", [SSHRef]), {ssh_sftp:start_channel(SSHRef),State}; handle_msg({session_open,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(session_open,Target), "SSH Ref: ~p, Timeout: ~p", [SSHRef,TO]), + try_log(heading(session_open,Target), "SSH Ref: ~p, Timeout: ~p", + [SSHRef,TO]), {ssh_connection:session_channel(SSHRef, TO),State}; handle_msg({session_close,Chn}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(session_close,Target), "SSH Ref: ~p, Chn: ~p", [SSHRef,Chn]), + try_log(heading(session_close,Target), "SSH Ref: ~p, Chn: ~p", [SSHRef,Chn]), {ssh_connection:close(SSHRef, Chn),State}; handle_msg({exec,Chn,Command,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, Chn1 = if Chn == undefined -> - log(heading(exec,Target), - "Opening channel for exec, SSH Ref: ~p", [SSHRef]), + try_log(heading(exec,Target), + "Opening channel for exec, SSH Ref: ~p", [SSHRef]), case ssh_connection:session_channel(SSHRef, TO) of {ok,C} -> C; CErr -> CErr @@ -1009,9 +1014,9 @@ handle_msg({exec,Chn,Command,TO}, State) -> log(heading(exec,Target), "Opening channel failed: ~p", [ChnError]), {ChnError,State}; _ -> - log(heading(exec,Target), - "SSH Ref: ~p, Chn: ~p, Command: ~p, Timeout: ~p", - [SSHRef,Chn1,Command,TO]), + try_log(heading(exec,Target), + "SSH Ref: ~p, Chn: ~p, Command: ~p, Timeout: ~p", + [SSHRef,Chn1,Command,TO]), case ssh_connection:exec(SSHRef, Chn1, Command, TO) of success -> Result = do_recv_response(SSHRef, Chn1, [], close, TO), @@ -1024,24 +1029,24 @@ handle_msg({exec,Chn,Command,TO}, State) -> handle_msg({receive_response,Chn,End,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(receive_response,Target), - "SSH Ref: ~p, Chn: ~p, Timeout: ~p", [SSHRef,Chn,TO]), + try_log(heading(receive_response,Target), + "SSH Ref: ~p, Chn: ~p, Timeout: ~p", [SSHRef,Chn,TO]), Result = do_recv_response(SSHRef, Chn, [], End, TO), {Result,State}; handle_msg({send,Chn,Type,Data,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(send,Target), - "SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n" - "Data: ~p", [SSHRef,Chn,Type,TO,Data]), + try_log(heading(send,Target), + "SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n" + "Data: ~p", [SSHRef,Chn,Type,TO,Data]), Result = ssh_connection:send(SSHRef, Chn, Type, Data, TO), {Result,State}; handle_msg({send_and_receive,Chn,Type,Data,End,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(send_and_receive,Target), - "SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n" - "Data: ~p", [SSHRef,Chn,Type,TO,Data]), + try_log(heading(send_and_receive,Target), + "SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n" + "Data: ~p", [SSHRef,Chn,Type,TO,Data]), case ssh_connection:send(SSHRef, Chn, Type, Data, TO) of ok -> Result = do_recv_response(SSHRef, Chn, [], End, TO), @@ -1052,137 +1057,162 @@ handle_msg({send_and_receive,Chn,Type,Data,End,TO}, State) -> handle_msg({subsystem,Chn,Subsystem,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, - log(heading(subsystem,Target), - "SSH Ref: ~p, Chn: ~p, Subsys: ~p, Timeout: ~p", - [SSHRef,Chn,Subsystem,TO]), + try_log(heading(subsystem,Target), + "SSH Ref: ~p, Chn: ~p, Subsys: ~p, Timeout: ~p", + [SSHRef,Chn,Subsystem,TO]), Result = ssh_connection:subsystem(SSHRef, Chn, Subsystem, TO), {Result,State}; %% --- SFTP Commands --- handle_msg({read_file,Srv,File}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:read_file(ref(Srv,SSHRef), File),S}; handle_msg({write_file,Srv,File,Iolist}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:write_file(ref(Srv,SSHRef), File, Iolist),S}; handle_msg({list_dir,Srv,Path}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:list_dir(ref(Srv,SSHRef), Path),S}; handle_msg({open,Srv,File,Mode}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:open(ref(Srv,SSHRef), File, Mode),S}; handle_msg({opendir,Srv,Path}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:opendir(ref(Srv,SSHRef), Path),S}; handle_msg({close,Srv,Handle}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:close(ref(Srv,SSHRef), Handle),S}; handle_msg({read,Srv,Handle,Len}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:read(ref(Srv,SSHRef), Handle, Len),S}; handle_msg({pread,Srv,Handle,Position,Length}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:pread(ref(Srv,SSHRef),Handle,Position,Length),S}; handle_msg({aread,Srv,Handle,Len}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:aread(ref(Srv,SSHRef), Handle, Len),S}; handle_msg({apread,Srv,Handle,Position,Length}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:apread(ref(Srv,SSHRef), Handle, Position, Length),S}; handle_msg({write,Srv,Handle,Data}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:write(ref(Srv,SSHRef), Handle, Data),S}; handle_msg({pwrite,Srv,Handle,Position,Data}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:pwrite(ref(Srv,SSHRef), Handle, Position, Data),S}; handle_msg({awrite,Srv,Handle,Data}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:awrite(ref(Srv,SSHRef), Handle, Data),S}; handle_msg({apwrite,Srv,Handle,Position,Data}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:apwrite(ref(Srv,SSHRef), Handle, Position, Data),S}; handle_msg({position,Srv,Handle,Location}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:position(ref(Srv,SSHRef), Handle, Location),S}; handle_msg({read_file_info,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:read_file_info(ref(Srv,SSHRef), Name),S}; handle_msg({get_file_info,Srv,Handle}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:get_file_info(ref(Srv,SSHRef), Handle),S}; handle_msg({read_link_info,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:read_link_info(ref(Srv,SSHRef), Name),S}; handle_msg({write_file_info,Srv,Name,Info}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:write_file_info(ref(Srv,SSHRef), Name, Info),S}; handle_msg({read_link,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:read_link(ref(Srv,SSHRef), Name),S}; handle_msg({make_symlink,Srv,Name,Target}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:make_symlink(ref(Srv,SSHRef), Name, Target),S}; handle_msg({rename,Srv,OldName,NewName}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:rename(ref(Srv,SSHRef), OldName, NewName),S}; handle_msg({delete,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:delete(ref(Srv,SSHRef), Name),S}; handle_msg({make_dir,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:make_dir(ref(Srv,SSHRef), Name),S}; handle_msg({del_dir,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) -> - log(heading(sftp,S#state.target), - "SSH Ref: ~p, Server: ~p~nCmd: ~p", [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), + try_log(heading(sftp,S#state.target), + "SSH Ref: ~p, Server: ~p~nCmd: ~p", + [SSHRef,ref(Srv,SSHRef),mod(Cmd)]), {ssh_sftp:del_dir(ref(Srv,SSHRef), Name),S}. %% @hidden @@ -1197,12 +1227,12 @@ close(SSHRef) -> terminate(SSHRef, State) -> case State#state.conn_type of ssh -> - log(heading(disconnect_ssh,State#state.target), - "SSH Ref: ~p",[SSHRef]), + try_log(heading(disconnect_ssh,State#state.target), + "SSH Ref: ~p",[SSHRef], 5000), ssh:close(SSHRef); sftp -> - log(heading(disconnect_sftp,State#state.target), - "SFTP Ref: ~p",[SSHRef]), + try_log(heading(disconnect_sftp,State#state.target), + "SFTP Ref: ~p",[SSHRef], 5000), ssh_sftp:stop_channel(SSHRef) end. @@ -1217,7 +1247,7 @@ do_recv_response(SSH, Chn, Data, End, Timeout) -> {ssh_cm, SSH, {open,Chn,RemoteChn,{session}}} -> debug("RECVD open"), {ok,{open,Chn,RemoteChn,{session}}}; - + {ssh_cm, SSH, {closed,Chn}} -> ssh_connection:close(SSH, Chn), debug("CLSD~n~p ~p", [SSH,Chn]), @@ -1245,38 +1275,38 @@ do_recv_response(SSH, Chn, Data, End, Timeout) -> {ssh_cm, SSH, {exit_signal,Chn,Signal,Err,_Lang}} -> debug("RECVD exit_signal~n~p ~p~n~p ~p", [SSH,Chn,Signal,Err]), do_recv_response(SSH, Chn, Data, End, Timeout); -%% {ok,{exit_signal,Chn,Signal,Err,_Lang}}; + %% {ok,{exit_signal,Chn,Signal,Err,_Lang}}; {ssh_cm, SSH, {exit_status,Chn,Status}} -> debug("RECVD exit_status~n~p ~p~n~p", [SSH,Chn,Status]), do_recv_response(SSH, Chn, Data, End, Timeout); -%% {ok,{exit_status,Chn,_Status}}; + %% {ok,{exit_status,Chn,_Status}}; -%% --- INTERACTIVE MESSAGES - NOT HANDLED --- -%% -%% {ssh_cm, SSH, {subsystem,Chn,WantReply,Name}} -> -%% debug("RECVD SUBS WNTRPLY~n~p ~p~n~p~n~p", -%% [SSH,Chn,WantReply]), -%% ssh_connection:reply_request(SSH, WantReply, success, Chn), -%% do_recv_response(SSH, Chn, Data, End, Timeout); - -%% {ssh_cm, SSH, {shell,WantReply}} -> -%% debug("RECVD SHELL WNTRPLY~n~p ~p~n~p~n~p", -%% [SSH,Chn,WantReply]), -%% ssh_connection:reply_request(SSH, WantReply, success, Chn), -%% do_recv_response(SSH,Chn,Data,End,Timeout); - -%% {ssh_cm, SSH, {pty,Chn,WantReply,Pty}} -> -%% debug("RECVD PTY WNTRPLY~n~p ~p~n~p~n~p", -%% [SSH,Chn,WantReply,Pty]), -%% ssh_connection:reply_request(SSH, WantReply, success, Chn), -%% do_recv_response(SSH, Chn, Data, End, Timeout); - -%% {ssh_cm, SSH, WCh={window_change,_Chn,_Width,_Height,_PixWidth,_PixHeight}} -> -%% debug("RECVD WINCH"), -%% {ok,WCh}; - + %% --- INTERACTIVE MESSAGES - NOT HANDLED --- + %% + %% {ssh_cm, SSH, {subsystem,Chn,WantReply,Name}} -> + %% debug("RECVD SUBS WNTRPLY~n~p ~p~n~p~n~p", + %% [SSH,Chn,WantReply]), + %% ssh_connection:reply_request(SSH, WantReply, success, Chn), + %% do_recv_response(SSH, Chn, Data, End, Timeout); + + %% {ssh_cm, SSH, {shell,WantReply}} -> + %% debug("RECVD SHELL WNTRPLY~n~p ~p~n~p~n~p", + %% [SSH,Chn,WantReply]), + %% ssh_connection:reply_request(SSH, WantReply, success, Chn), + %% do_recv_response(SSH,Chn,Data,End,Timeout); + + %% {ssh_cm, SSH, {pty,Chn,WantReply,Pty}} -> + %% debug("RECVD PTY WNTRPLY~n~p ~p~n~p~n~p", + %% [SSH,Chn,WantReply,Pty]), + %% ssh_connection:reply_request(SSH, WantReply, success, Chn), + %% do_recv_response(SSH, Chn, Data, End, Timeout); + + %% {ssh_cm, SSH, WCh={window_change,_Chn,_Width,_Height,_PixWidth,_PixHeight}} -> + %% debug("RECVD WINCH"), + %% {ok,WCh}; + Other -> debug("UNEXPECTED MESSAGE~n~p ~p~n~p", [SSH,Chn,Other]), do_recv_response(SSH, Chn, Data, End, Timeout) @@ -1307,9 +1337,12 @@ get_handle(SSH) -> %%%----------------------------------------------------------------- %%% call(SSH, Msg) -> + call(SSH, Msg, infinity). + +call(SSH, Msg, Timeout) -> case get_handle(SSH) of {ok,Pid} -> - ct_gen_conn:call(Pid, Msg); + ct_gen_conn:call(Pid, Msg, Timeout); Error -> Error end. @@ -1318,13 +1351,13 @@ call(SSH, Msg) -> %%% ref(sftp, SSHRef) -> SSHRef; ref(Server, _) -> Server. - + %%%----------------------------------------------------------------- %%% mod(Cmd) -> [Op,_Server|Args] = tuple_to_list(Cmd), list_to_tuple([Op|Args]). - + %%%----------------------------------------------------------------- %%% heading(Function, Ref) -> @@ -1335,6 +1368,20 @@ heading(Function, Ref) -> log(Heading, Str, Args) -> ct_gen_conn:log(Heading, Str, Args). +%%%----------------------------------------------------------------- +%%% +try_log(Heading, Str, Args) -> + try_log(Heading, Str, Args, infinity). + +try_log(Heading, Str, Args, Timeout) -> + case ct_util:is_silenced(ssh, Timeout) of + true -> + ok; + false -> + ct_gen_conn:log(Heading, Str, Args); + _Error -> + ok + end. %%%----------------------------------------------------------------- %%% @@ -1342,5 +1389,5 @@ debug(Str) -> debug(Str, []). debug(_Str, _Args) -> -%% io:format("~n--- ct_ssh debug ---~n" ++ _Str ++ "~n", _Args), + %% io:format("~n--- ct_ssh debug ---~n" ++ _Str ++ "~n", _Args), ok. diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 5b197c0c81..7759aca16b 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. 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 @@ -29,6 +29,8 @@ -include("ct_util.hrl"). +-define(testspec_fields, record_info(fields, testspec)). + %%%------------------------------------------------------------------ %%% NOTE: %%% Multiple testspecs may be used as input with the result that @@ -46,7 +48,8 @@ %%% Version 1 - extract and return all tests and skips for Node %%% (incl all_nodes) %%%------------------------------------------------------------------- -prepare_tests(TestSpec,Node) when is_record(TestSpec,testspec), is_atom(Node) -> +prepare_tests(TestSpec,Node) when is_record(TestSpec,testspec), + is_atom(Node) -> case lists:keysearch(Node,1,prepare_tests(TestSpec)) of {value,{Node,Run,Skip}} -> {Run,Skip}; @@ -249,22 +252,23 @@ collect_tests_from_file1([Spec|Specs],TestSpec,Relaxed) -> SpecDir = filename:dirname(filename:absname(Spec)), case file:consult(Spec) of {ok,Terms} -> - TestSpec1 = collect_tests(Terms, - TestSpec#testspec{spec_dir=SpecDir}, - Relaxed), - collect_tests_from_file1(Specs,TestSpec1,Relaxed); + case collect_tests(Terms, + TestSpec#testspec{spec_dir=SpecDir}, + Relaxed) of + TS = #testspec{tests=Tests, logdir=LogDirs} when Specs == [] -> + LogDirs1 = lists:delete(".",LogDirs) ++ ["."], + TS#testspec{tests=lists:flatten(Tests), logdir=LogDirs1}; + TS = #testspec{alias = As, nodes = Ns} -> + TS1 = TS#testspec{alias = lists:reverse(As), + nodes = lists:reverse(Ns)}, + collect_tests_from_file1(Specs,TS1,Relaxed) + end; {error,Reason} -> ReasonStr = lists:flatten(io_lib:format("~s", [file:format_error(Reason)])), throw({error,{Spec,ReasonStr}}) - end; -collect_tests_from_file1([],TS=#testspec{config=Cfgs,event_handler=EvHs, - include=Incl,tests=Tests},_) -> - TS#testspec{config=lists:reverse(Cfgs), - event_handler=lists:reverse(EvHs), - include=lists:reverse(Incl), - tests=lists:flatten(Tests)}. + end. collect_tests_from_list(Terms,Relaxed) -> collect_tests_from_list(Terms,[node()],Relaxed). @@ -278,30 +282,163 @@ collect_tests_from_list(Terms,Nodes,Relaxed) when is_list(Nodes) -> E = {error,_} -> E; TS -> - #testspec{config=Cfgs,event_handler=EvHs,include=Incl,tests=Tests} = TS, - TS#testspec{config=lists:reverse(Cfgs), - event_handler=lists:reverse(EvHs), - include=lists:reverse(Incl), - tests=lists:flatten(Tests)} + #testspec{tests=Tests, logdir=LogDirs} = TS, + LogDirs1 = lists:delete(".",LogDirs) ++ ["."], + TS#testspec{tests=lists:flatten(Tests), logdir=LogDirs1} end. collect_tests(Terms,TestSpec,Relaxed) -> put(relaxed,Relaxed), - TestSpec1 = get_global(Terms,TestSpec), - TestSpec2 = get_all_nodes(Terms,TestSpec1), - {Terms2, TestSpec3} = filter_init_terms(Terms, [], TestSpec2), + Terms1 = replace_names(Terms), + TestSpec1 = get_global(Terms1,TestSpec), + TestSpec2 = get_all_nodes(Terms1,TestSpec1), + {Terms2, TestSpec3} = filter_init_terms(Terms1, [], TestSpec2), add_tests(Terms2,TestSpec3). -get_global([{merge_tests, Bool} | Ts], Spec) -> - get_global(Ts,Spec#testspec{ merge_tests = Bool }); +%% replace names (atoms) in the testspec matching those in 'define' terms by +%% searching recursively through tuples and lists +replace_names(Terms) -> + Defs = + lists:flatmap(fun(Def={define,Name,_Replacement}) -> + %% check that name follows convention + if not is_atom(Name) -> + throw({illegal_name_in_testspec,Name}); + true -> + [First|_] = atom_to_list(Name), + if ((First == $?) or (First == $$) + or (First == $_) + or ((First >= $A) + and (First =< $Z))) -> + [Def]; + true -> + throw({illegal_name_in_testspec, + Name}) + end + end; + (_) -> [] + end, Terms), + DefProps = replace_names_in_defs(Defs,[]), + replace_names(Terms,[],DefProps). + +replace_names_in_defs([Def|Left],ModDefs) -> + [{define,Name,Replacement}] = replace_names([Def],[],ModDefs), + replace_names_in_defs(Left,[{Name,Replacement}|ModDefs]); +replace_names_in_defs([],ModDefs) -> + ModDefs. + +replace_names([Term|Ts],Modified,Defs) when is_tuple(Term) -> + [TypeTag|Data] = tuple_to_list(Term), + Term1 = list_to_tuple([TypeTag|replace_names_in_elems(Data,[],Defs)]), + replace_names(Ts,[Term1|Modified],Defs); +replace_names([Term|Ts],Modified,Defs) when is_atom(Term) -> + case proplists:get_value(Term,Defs) of + undefined -> + replace_names(Ts,[Term|Modified],Defs); + Replacement -> + replace_names(Ts,[Replacement|Modified],Defs) + end; +replace_names([Term=[Ch|_]|Ts],Modified,Defs) when is_integer(Ch) -> + %% Term *could* be a string, attempt to search through it + Term1 = replace_names_in_string(Term,Defs), + replace_names(Ts,[Term1|Modified],Defs); +replace_names([Term|Ts],Modified,Defs) -> + replace_names(Ts,[Term|Modified],Defs); +replace_names([],Modified,_Defs) -> + lists:reverse(Modified). + +replace_names_in_elems([Elem|Es],Modified,Defs) when is_tuple(Elem) -> + Elem1 = list_to_tuple(replace_names_in_elems(tuple_to_list(Elem),[],Defs)), + replace_names_in_elems(Es,[Elem1|Modified],Defs); +replace_names_in_elems([Elem|Es],Modified,Defs) when is_atom(Elem) -> + case proplists:get_value(Elem,Defs) of + undefined -> + %% if Term is a node name, check it for replacements as well + Elem1 = replace_names_in_node(Elem,Defs), + replace_names_in_elems(Es,[Elem1|Modified],Defs); + Replacement -> + replace_names_in_elems(Es,[Replacement|Modified],Defs) + end; +replace_names_in_elems([Elem=[Ch|_]|Es],Modified,Defs) when is_integer(Ch) -> + %% Term *could* be a string, attempt to search through it + case replace_names_in_string(Elem,Defs) of + Elem -> + List = replace_names_in_elems(Elem,[],Defs), + replace_names_in_elems(Es,[List|Modified],Defs); + Elem1 -> + replace_names_in_elems(Es,[Elem1|Modified],Defs) + end; +replace_names_in_elems([Elem|Es],Modified,Defs) when is_list(Elem) -> + List = replace_names_in_elems(Elem,[],Defs), + replace_names_in_elems(Es,[List|Modified],Defs); +replace_names_in_elems([Elem|Es],Modified,Defs) -> + replace_names_in_elems(Es,[Elem|Modified],Defs); +replace_names_in_elems([],Modified,_Defs) -> + lists:reverse(Modified). + +replace_names_in_string(Term,Defs=[{Name,Replacement=[Ch|_]}|Ds]) + when is_integer(Ch) -> + try re:replace(Term,[$'|atom_to_list(Name)]++"'", + Replacement,[{return,list}]) of + Term -> % no match, proceed + replace_names_in_string(Term,Ds); + Term1 -> + replace_names_in_string(Term1,Defs) + catch + _:_ -> Term % Term is not a string + end; +replace_names_in_string(Term,[_|Ds]) -> + replace_names_in_string(Term,Ds); +replace_names_in_string(Term,[]) -> + Term. + +replace_names_in_node(Node,Defs) -> + String = atom_to_list(Node), + case lists:member($@,String) of + true -> + list_to_atom(replace_names_in_node1(String,Defs)); + false -> + Node + end. + +replace_names_in_node1(NodeStr,Defs=[{Name,Replacement}|Ds]) -> + ReplStr = case Replacement of + [Ch|_] when is_integer(Ch) -> Replacement; + _ when is_atom(Replacement) -> atom_to_list(Replacement); + _ -> false + end, + if ReplStr == false -> + replace_names_in_node1(NodeStr,Ds); + true -> + case re:replace(NodeStr,atom_to_list(Name), + ReplStr,[{return,list}]) of + NodeStr -> % no match, proceed + replace_names_in_node1(NodeStr,Ds); + NodeStr1 -> + replace_names_in_node1(NodeStr1,Defs) + end + end; +replace_names_in_node1(NodeStr,[]) -> + NodeStr. + + +%% global terms that will be used for analysing all other terms in the spec +get_global([{merge_tests,Bool} | Ts], Spec) -> + get_global(Ts,Spec#testspec{merge_tests=Bool}); + +%% the 'define' term replaces the 'alias' and 'node' terms, but we need to keep +%% the latter two for backwards compatibility... get_global([{alias,Ref,Dir}|Ts],Spec=#testspec{alias=Refs}) -> get_global(Ts,Spec#testspec{alias=[{Ref,get_absdir(Dir,Spec)}|Refs]}); get_global([{node,Ref,Node}|Ts],Spec=#testspec{nodes=Refs}) -> - get_global(Ts,Spec#testspec{nodes=[{Ref,Node}|lists:keydelete(Node,2,Refs)]}); -get_global([_|Ts],Spec) -> get_global(Ts,Spec); -get_global([],Spec) -> Spec. + get_global(Ts,Spec#testspec{nodes=[{Ref,Node} | + lists:keydelete(Node,2,Refs)]}); -get_absfile(Callback, FullName,#testspec{spec_dir=SpecDir}) -> +get_global([_|Ts],Spec) -> + get_global(Ts,Spec); +get_global([],Spec=#testspec{nodes=Ns, alias=As}) -> + Spec#testspec{nodes=lists:reverse(Ns), alias=lists:reverse(As)}. + +get_absfile(Callback,FullName,#testspec{spec_dir=SpecDir}) -> % we need to temporary switch to new cwd here, because % otherwise config files cannot be found {ok, OldWd} = file:get_cwd(), @@ -329,29 +466,45 @@ get_absfile(FullName,#testspec{spec_dir=SpecDir}) -> get_absdir(Dir,#testspec{spec_dir=SpecDir}) -> get_absname(Dir,SpecDir). -get_absname(TestDir,SpecDir) -> - AbsName = filename:absname(TestDir,SpecDir), - TestDirName = filename:basename(AbsName), - Path = filename:dirname(AbsName), - TopDir = filename:basename(Path), - Path1 = - case TopDir of - "." -> - [_|Rev] = lists:reverse(filename:split(Path)), - filename:join(lists:reverse(Rev)); - ".." -> - [_,_|Rev] = lists:reverse(filename:split(Path)), - filename:join(lists:reverse(Rev)); - _ -> - Path - end, - filename:join(Path1,TestDirName). +get_absname(Dir,SpecDir) -> + AbsName = filename:absname(Dir,SpecDir), + shorten_path(AbsName,SpecDir). + +shorten_path(Path,SpecDir) -> + case shorten_split_path(filename:split(Path),[]) of + [] -> + [Root|_] = filename:split(SpecDir), + Root; + Short -> + filename:join(Short) + end. + +shorten_split_path([".."|Path],SoFar) -> + shorten_split_path(Path,tl(SoFar)); +shorten_split_path(["."|Path],SoFar) -> + shorten_split_path(Path,SoFar); +shorten_split_path([Dir|Path],SoFar) -> + shorten_split_path(Path,[Dir|SoFar]); +shorten_split_path([],SoFar) -> + lists:reverse(SoFar). %% go through all tests and register all nodes found get_all_nodes([{suites,Nodes,_,_}|Ts],Spec) when is_list(Nodes) -> get_all_nodes(Ts,save_nodes(Nodes,Spec)); get_all_nodes([{suites,Node,_,_}|Ts],Spec) -> get_all_nodes(Ts,save_nodes([Node],Spec)); +get_all_nodes([{groups,[Char|_],_,_,_}|Ts],Spec) when is_integer(Char) -> + get_all_nodes(Ts,Spec); +get_all_nodes([{groups,Nodes,_,_,_}|Ts],Spec) when is_list(Nodes) -> + get_all_nodes(Ts,save_nodes(Nodes,Spec)); +get_all_nodes([{groups,Nodes,_,_,_,_}|Ts],Spec) when is_list(Nodes) -> + get_all_nodes(Ts,save_nodes(Nodes,Spec)); +get_all_nodes([{groups,_,_,_,{cases,_}}|Ts],Spec) -> + get_all_nodes(Ts,Spec); +get_all_nodes([{groups,Node,_,_,_}|Ts],Spec) -> + get_all_nodes(Ts,save_nodes([Node],Spec)); +get_all_nodes([{groups,Node,_,_,_,_}|Ts],Spec) -> + get_all_nodes(Ts,save_nodes([Node],Spec)); get_all_nodes([{cases,Nodes,_,_,_}|Ts],Spec) when is_list(Nodes) -> get_all_nodes(Ts,save_nodes(Nodes,Spec)); get_all_nodes([{cases,Node,_,_,_}|Ts],Spec) -> @@ -360,74 +513,93 @@ get_all_nodes([{skip_suites,Nodes,_,_,_}|Ts],Spec) when is_list(Nodes) -> get_all_nodes(Ts,save_nodes(Nodes,Spec)); get_all_nodes([{skip_suites,Node,_,_,_}|Ts],Spec) -> get_all_nodes(Ts,save_nodes([Node],Spec)); +get_all_nodes([{skip_groups,[Char|_],_,_,_,_}|Ts],Spec) when is_integer(Char) -> + get_all_nodes(Ts,Spec); +get_all_nodes([{skip_groups,Nodes,_,_,_,_}|Ts],Spec) when is_list(Nodes) -> + get_all_nodes(Ts,save_nodes(Nodes,Spec)); +get_all_nodes([{skip_groups,Node,_,_,_,_}|Ts],Spec) -> + get_all_nodes(Ts,save_nodes([Node],Spec)); +get_all_nodes([{skip_groups,Nodes,_,_,_,_,_}|Ts],Spec) when is_list(Nodes) -> + get_all_nodes(Ts,save_nodes(Nodes,Spec)); +get_all_nodes([{skip_groups,Node,_,_,_,_,_}|Ts],Spec) -> + get_all_nodes(Ts,save_nodes([Node],Spec)); get_all_nodes([{skip_cases,Nodes,_,_,_,_}|Ts],Spec) when is_list(Nodes) -> get_all_nodes(Ts,save_nodes(Nodes,Spec)); get_all_nodes([{skip_cases,Node,_,_,_,_}|Ts],Spec) -> get_all_nodes(Ts,save_nodes([Node],Spec)); -get_all_nodes([_|Ts],Spec) -> +get_all_nodes([_Other|Ts],Spec) -> get_all_nodes(Ts,Spec); get_all_nodes([],Spec) -> Spec. -filter_init_terms([{init, InitOptions}|Ts], NewTerms, Spec)-> - filter_init_terms([{init, list_nodes(Spec), InitOptions}|Ts], NewTerms, Spec); -filter_init_terms([{init, NodeRef, InitOptions}|Ts], NewTerms, Spec) - when is_atom(NodeRef)-> - filter_init_terms([{init, [NodeRef], InitOptions}|Ts], NewTerms, Spec); -filter_init_terms([{init, NodeRefs, InitOption}|Ts], NewTerms, Spec) when is_tuple(InitOption) -> - filter_init_terms([{init, NodeRefs, [InitOption]}|Ts], NewTerms, Spec); -filter_init_terms([{init, [NodeRef|NodeRefs], InitOptions}|Ts], NewTerms, Spec=#testspec{init=InitData})-> - NodeStartOptions = case lists:keyfind(node_start, 1, InitOptions) of - {node_start, NSOptions}-> - case lists:keyfind(callback_module, 1, NSOptions) of - {callback_module, _Callback}-> - NSOptions; - false-> - [{callback_module, ct_slave}|NSOptions] - end; - false-> - [] - end, - EvalTerms = case lists:keyfind(eval, 1, InitOptions) of - {eval, MFA} when is_tuple(MFA)-> - [MFA]; - {eval, MFAs} when is_list(MFAs)-> - MFAs; - false-> - [] - end, +filter_init_terms([{init,InitOptions}|Ts],NewTerms,Spec) -> + filter_init_terms([{init,list_nodes(Spec),InitOptions}|Ts], + NewTerms,Spec); +filter_init_terms([{init,all_nodes,InitOptions}|Ts],NewTerms,Spec) -> + filter_init_terms([{init,list_nodes(Spec),InitOptions}|Ts], + NewTerms,Spec); +filter_init_terms([{init,NodeRef,InitOptions}|Ts], + NewTerms,Spec) when is_atom(NodeRef) -> + filter_init_terms([{init,[NodeRef],InitOptions}|Ts],NewTerms,Spec); +filter_init_terms([{init,NodeRefs,InitOption}|Ts], + NewTerms,Spec) when is_tuple(InitOption) -> + filter_init_terms([{init,NodeRefs,[InitOption]}|Ts],NewTerms,Spec); +filter_init_terms([{init,[NodeRef|NodeRefs],InitOptions}|Ts], + NewTerms,Spec=#testspec{init=InitData}) -> + NodeStartOptions = + case lists:keyfind(node_start,1,InitOptions) of + {node_start,NSOptions}-> + case lists:keyfind(callback_module,1,NSOptions) of + {callback_module,_Callback}-> + NSOptions; + false-> + [{callback_module,ct_slave}|NSOptions] + end; + false-> + [] + end, + EvalTerms = case lists:keyfind(eval,1,InitOptions) of + {eval,MFA} when is_tuple(MFA) -> + [MFA]; + {eval,MFAs} when is_list(MFAs) -> + MFAs; + false-> + [] + end, Node = ref2node(NodeRef,Spec#testspec.nodes), - InitData2 = add_option({node_start, NodeStartOptions}, Node, InitData, true), - InitData3 = add_option({eval, EvalTerms}, Node, InitData2, false), - filter_init_terms([{init, NodeRefs, InitOptions}|Ts], NewTerms, Spec#testspec{init=InitData3}); -filter_init_terms([{init, [], _}|Ts], NewTerms, Spec)-> - filter_init_terms(Ts, NewTerms, Spec); -filter_init_terms([Term|Ts], NewTerms, Spec)-> - filter_init_terms(Ts, [Term|NewTerms], Spec); -filter_init_terms([], NewTerms, Spec)-> - {lists:reverse(NewTerms), Spec}. - -add_option({Key, Value}, Node, List, WarnIfExists) when is_list(Value)-> - OldOptions = case lists:keyfind(Node, 1, List) of - {Node, Options}-> + InitData2 = add_option({node_start,NodeStartOptions},Node,InitData,true), + InitData3 = add_option({eval,EvalTerms},Node,InitData2,false), + filter_init_terms([{init,NodeRefs,InitOptions}|Ts], + NewTerms,Spec#testspec{init=InitData3}); +filter_init_terms([{init,[],_}|Ts],NewTerms,Spec) -> + filter_init_terms(Ts,NewTerms,Spec); +filter_init_terms([Term|Ts],NewTerms,Spec) -> + filter_init_terms(Ts,[Term|NewTerms],Spec); +filter_init_terms([],NewTerms,Spec) -> + {lists:reverse(NewTerms),Spec}. + +add_option({Key,Value},Node,List,WarnIfExists) when is_list(Value) -> + OldOptions = case lists:keyfind(Node,1,List) of + {Node,Options}-> Options; false-> [] end, - NewOption = case lists:keyfind(Key, 1, OldOptions) of - {Key, OldOption} when WarnIfExists, OldOption/=[]-> - io:format("There is an option ~w=~w already defined for node ~p, skipping new ~w~n", - [Key, OldOption, Node, Value]), + NewOption = case lists:keyfind(Key,1,OldOptions) of + {Key,OldOption} when WarnIfExists,OldOption/=[]-> + io:format("There is an option ~w=~w already " + "defined for node ~p, skipping new ~w~n", + [Key,OldOption,Node,Value]), OldOption; - {Key, OldOption}-> + {Key,OldOption}-> OldOption ++ Value; false-> Value end, - lists:keystore(Node, 1, List, - {Node, lists:keystore(Key, 1, OldOptions, {Key, NewOption})}); -add_option({Key, Value}, Node, List, WarnIfExists)-> - add_option({Key, [Value]}, Node, List, WarnIfExists). + lists:keystore(Node,1,List, + {Node,lists:keystore(Key,1,OldOptions,{Key,NewOption})}); +add_option({Key,Value},Node,List,WarnIfExists) -> + add_option({Key,[Value]},Node,List,WarnIfExists). save_nodes(Nodes,Spec=#testspec{nodes=NodeRefs}) -> NodeRefs1 = @@ -446,267 +618,18 @@ save_nodes(Nodes,Spec=#testspec{nodes=NodeRefs}) -> end end end,NodeRefs,Nodes), - Spec#testspec{nodes=NodeRefs1}. + Spec#testspec{nodes=NodeRefs1}. list_nodes(#testspec{nodes=NodeRefs}) -> lists:map(fun({_Ref,Node}) -> Node end, NodeRefs). - -%% --------------------------------------------------------- -%% / \ -%% | When adding tests, remember to update valid_terms/0 also! | -%% \ / -%% --------------------------------------------------------- - - -%% Associate a "global" logdir with all nodes -%% except those with specific logdir, e.g: -%% ["/tmp/logdir",{ct1@finwe,"/tmp/logdir2"}] -%% means all nodes should write to /tmp/logdir -%% except ct1@finwe that should use /tmp/logdir2. - -%% --- logdir --- -add_tests([{logdir,all_nodes,Dir}|Ts],Spec) -> - Dirs = Spec#testspec.logdir, - Tests = [{logdir,N,get_absdir(Dir,Spec)} || - N <- list_nodes(Spec), - lists:keymember(ref2node(N,Spec#testspec.nodes), - 1,Dirs) == false], - add_tests(Tests++Ts,Spec); -add_tests([{logdir,Nodes,Dir}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,logdir,[Dir],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{logdir,Node,Dir}|Ts],Spec) -> - Dirs = Spec#testspec.logdir, - Dirs1 = [{ref2node(Node,Spec#testspec.nodes),get_absdir(Dir,Spec)} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,Dirs)], - add_tests(Ts,Spec#testspec{logdir=Dirs1}); -add_tests([{logdir,Dir}|Ts],Spec) -> - add_tests([{logdir,all_nodes,Dir}|Ts],Spec); - -%% --- logopts --- -add_tests([{logopts,all_nodes,Opts}|Ts],Spec) -> - LogOpts = Spec#testspec.logopts, - Tests = [{logopts,N,Opts} || - N <- list_nodes(Spec), - lists:keymember(ref2node(N,Spec#testspec.nodes),1, - LogOpts) == false], - add_tests(Tests++Ts,Spec); -add_tests([{logopts,Nodes,Opts}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,logopts,[Opts],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{logopts,Node,Opts}|Ts],Spec) -> - LogOpts = Spec#testspec.logopts, - LogOpts1 = [{ref2node(Node,Spec#testspec.nodes),Opts} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes), - 1,LogOpts)], - add_tests(Ts,Spec#testspec{logopts=LogOpts1}); -add_tests([{logopts,Opts}|Ts],Spec) -> - add_tests([{logopts,all_nodes,Opts}|Ts],Spec); - -%% --- label --- -add_tests([{label,all_nodes,Lbl}|Ts],Spec) -> - Labels = Spec#testspec.label, - Tests = [{label,N,Lbl} || N <- list_nodes(Spec), - lists:keymember(ref2node(N,Spec#testspec.nodes), - 1,Labels) == false], - add_tests(Tests++Ts,Spec); -add_tests([{label,Nodes,Lbl}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,label,[Lbl],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{label,Node,Lbl}|Ts],Spec) -> - Labels = Spec#testspec.label, - Labels1 = [{ref2node(Node,Spec#testspec.nodes),Lbl} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,Labels)], - add_tests(Ts,Spec#testspec{label=Labels1}); -add_tests([{label,Lbl}|Ts],Spec) -> - add_tests([{label,all_nodes,Lbl}|Ts],Spec); - -%% --- cover --- -add_tests([{cover,all_nodes,File}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {cover,N,File} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{cover,Nodes,File}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,cover,[File],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{cover,Node,File}|Ts],Spec) -> - CoverFs = Spec#testspec.cover, - CoverFs1 = [{ref2node(Node,Spec#testspec.nodes),get_absfile(File,Spec)} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,CoverFs)], - add_tests(Ts,Spec#testspec{cover=CoverFs1}); -add_tests([{cover,File}|Ts],Spec) -> - add_tests([{cover,all_nodes,File}|Ts],Spec); - -%% --- multiply_timetraps --- -add_tests([{multiply_timetraps,all_nodes,MT}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {multiply_timetraps,N,MT} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{multiply_timetraps,Nodes,MT}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,multiply_timetraps,[MT],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{multiply_timetraps,Node,MT}|Ts],Spec) -> - MTs = Spec#testspec.multiply_timetraps, - MTs1 = [{ref2node(Node,Spec#testspec.nodes),MT} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,MTs)], - add_tests(Ts,Spec#testspec{multiply_timetraps=MTs1}); -add_tests([{multiply_timetraps,MT}|Ts],Spec) -> - add_tests([{multiply_timetraps,all_nodes,MT}|Ts],Spec); - -%% --- scale_timetraps --- -add_tests([{scale_timetraps,all_nodes,ST}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {scale_timetraps,N,ST} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{scale_timetraps,Nodes,ST}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,scale_timetraps,[ST],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{scale_timetraps,Node,ST}|Ts],Spec) -> - STs = Spec#testspec.scale_timetraps, - STs1 = [{ref2node(Node,Spec#testspec.nodes),ST} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,STs)], - add_tests(Ts,Spec#testspec{scale_timetraps=STs1}); -add_tests([{scale_timetraps,ST}|Ts],Spec) -> - add_tests([{scale_timetraps,all_nodes,ST}|Ts],Spec); - -%% --- create_priv_dir --- -add_tests([{create_priv_dir,all_nodes,PD}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {create_priv_dir,N,PD} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{create_priv_dir,Nodes,PD}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,create_priv_dir,[PD],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{create_priv_dir,Node,PD}|Ts],Spec) -> - PDs = Spec#testspec.create_priv_dir, - PDs1 = [{ref2node(Node,Spec#testspec.nodes),PD} | - lists:keydelete(ref2node(Node,Spec#testspec.nodes),1,PDs)], - add_tests(Ts,Spec#testspec{create_priv_dir=PDs1}); -add_tests([{create_priv_dir,PD}|Ts],Spec) -> - add_tests([{create_priv_dir,all_nodes,PD}|Ts],Spec); - -%% --- config --- -add_tests([{config,all_nodes,Files}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {config,N,Files} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{config,Nodes,Files}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,config,[Files],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{config,Node,[F|Fs]}|Ts],Spec) when is_list(F) -> - Cfgs = Spec#testspec.config, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests([{config,Node,Fs}|Ts], - Spec#testspec{config=[{Node1,get_absfile(F,Spec)}|Cfgs]}); -add_tests([{config,_Node,[]}|Ts],Spec) -> - add_tests(Ts,Spec); -add_tests([{config,Node,F}|Ts],Spec) -> - add_tests([{config,Node,[F]}|Ts],Spec); -add_tests([{config,Files}|Ts],Spec) -> - add_tests([{config,all_nodes,Files}|Ts],Spec); - - -%% --- userconfig --- -add_tests([{userconfig,all_nodes,CBF}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {userconfig,N,CBF} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{userconfig,Nodes,CBF}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,userconfig,[CBF],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{userconfig,Node,[{Callback, Config}|CBF]}|Ts],Spec) -> - Cfgs = Spec#testspec.userconfig, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests([{userconfig,Node,CBF}|Ts], - Spec#testspec{userconfig=[{Node1,{Callback, - get_absfile(Callback, Config ,Spec)}}|Cfgs]}); -add_tests([{userconfig,_Node,[]}|Ts],Spec) -> - add_tests(Ts,Spec); -add_tests([{userconfig,Node,CBF}|Ts],Spec) -> - add_tests([{userconfig,Node,[CBF]}|Ts],Spec); -add_tests([{userconfig,CBF}|Ts],Spec) -> - add_tests([{userconfig,all_nodes,CBF}|Ts],Spec); - -%% --- event_handler --- -add_tests([{event_handler,all_nodes,Hs}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {event_handler,N,Hs,[]} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{event_handler,all_nodes,Hs,Args}|Ts],Spec) when is_list(Args) -> - Tests = lists:map(fun(N) -> {event_handler,N,Hs,Args} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{event_handler,Hs}|Ts],Spec) -> - add_tests([{event_handler,all_nodes,Hs,[]}|Ts],Spec); -add_tests([{event_handler,HsOrNodes,HsOrArgs}|Ts],Spec) -> - case is_noderef(HsOrNodes,Spec#testspec.nodes) of - true -> % HsOrNodes == Nodes, HsOrArgs == Hs - case {HsOrNodes,HsOrArgs} of - {Nodes,Hs} when is_list(Nodes) -> - Ts1 = separate(Nodes,event_handler,[Hs,[]],Ts, - Spec#testspec.nodes), - add_tests(Ts1,Spec); - {_Node,[]} -> - add_tests(Ts,Spec); - {Node,HOrHs} -> - EvHs = Spec#testspec.event_handler, - Node1 = ref2node(Node,Spec#testspec.nodes), - case HOrHs of - [H|Hs] when is_atom(H) -> - add_tests([{event_handler,Node,Hs}|Ts], - Spec#testspec{event_handler=[{Node1,H,[]}|EvHs]}); - H when is_atom(H) -> - add_tests(Ts,Spec#testspec{event_handler=[{Node1,H,[]}|EvHs]}) - end - end; - false -> % HsOrNodes == Hs, HsOrArgs == Args - add_tests([{event_handler,all_nodes,HsOrNodes,HsOrArgs}|Ts],Spec) - end; -add_tests([{event_handler,Nodes,Hs,Args}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,event_handler,[Hs,Args],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{event_handler,Node,[H|Hs],Args}|Ts],Spec) when is_atom(H) -> - EvHs = Spec#testspec.event_handler, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests([{event_handler,Node,Hs,Args}|Ts], - Spec#testspec{event_handler=[{Node1,H,Args}|EvHs]}); -add_tests([{event_handler,_Node,[],_Args}|Ts],Spec) -> - add_tests(Ts,Spec); -add_tests([{event_handler,Node,H,Args}|Ts],Spec) when is_atom(H) -> - EvHs = Spec#testspec.event_handler, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests(Ts,Spec#testspec{event_handler=[{Node1,H,Args}|EvHs]}); - -%% --- ct_hooks -- -add_tests([{ct_hooks, all_nodes, Hooks} | Ts], Spec) -> - Tests = [{ct_hooks,N,Hooks} || N <- list_nodes(Spec)], - add_tests(Tests ++ Ts, Spec); -add_tests([{ct_hooks, Node, [Hook|Hooks]}|Ts], Spec) -> - SuiteCbs = Spec#testspec.ct_hooks, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests([{ct_hooks, Node, Hooks} | Ts], - Spec#testspec{ct_hooks = [{Node1,Hook} | SuiteCbs]}); -add_tests([{ct_hooks, _Node, []}|Ts], Spec) -> - add_tests(Ts, Spec); -add_tests([{ct_hooks, Hooks}|Ts], Spec) -> - add_tests([{ct_hooks, all_nodes, Hooks}|Ts], Spec); - -%% -- enable_builtin_hooks -- -add_tests([{enable_builtin_hooks,Bool}|Ts],Spec) -> - add_tests(Ts, Spec#testspec{ enable_builtin_hooks = Bool }); - -%% --- include --- -add_tests([{include,all_nodes,InclDirs}|Ts],Spec) -> - Tests = lists:map(fun(N) -> {include,N,InclDirs} end, list_nodes(Spec)), - add_tests(Tests++Ts,Spec); -add_tests([{include,Nodes,InclDirs}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,include,[InclDirs],Ts,Spec#testspec.nodes), - add_tests(Ts1,Spec); -add_tests([{include,Node,[D|Ds]}|Ts],Spec) when is_list(D) -> - Dirs = Spec#testspec.include, - Node1 = ref2node(Node,Spec#testspec.nodes), - add_tests([{include,Node,Ds}|Ts], - Spec#testspec{include=[{Node1,get_absdir(D,Spec)}|Dirs]}); -add_tests([{include,_Node,[]}|Ts],Spec) -> - add_tests(Ts,Spec); -add_tests([{include,Node,D}|Ts],Spec) -> - add_tests([{include,Node,[D]}|Ts],Spec); -add_tests([{include,InclDirs}|Ts],Spec) -> - add_tests([{include,all_nodes,InclDirs}|Ts],Spec); +%% ----------------------------------------------------- +%% / \ +%% | When adding test/config terms, remember to update | +%% | valid_terms/0 also! | +%% \ / +%% ----------------------------------------------------- %% --- suites --- add_tests([{suites,all_nodes,Dir,Ss}|Ts],Spec) -> @@ -719,7 +642,7 @@ add_tests([{suites,Nodes,Dir,Ss}|Ts],Spec) when is_list(Nodes) -> add_tests([{suites,Node,Dir,Ss}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_suites(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Ss,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); @@ -739,20 +662,22 @@ add_tests([{groups,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> add_tests([{groups,Nodes,Dir,Suite,Gs}|Ts],Spec) when is_list(Nodes) -> Ts1 = separate(Nodes,groups,[Dir,Suite,Gs],Ts,Spec#testspec.nodes), add_tests(Ts1,Spec); -add_tests([{groups,Nodes,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,groups,[Dir,Suite,Gs,{cases,TCs}],Ts,Spec#testspec.nodes), +add_tests([{groups,Nodes,Dir,Suite,Gs,{cases,TCs}}|Ts], + Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,groups,[Dir,Suite,Gs,{cases,TCs}],Ts, + Spec#testspec.nodes), add_tests(Ts1,Spec); add_tests([{groups,Node,Dir,Suite,Gs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Gs,all,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{groups,Node,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Gs,TCs,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); @@ -768,7 +693,7 @@ add_tests([{cases,Nodes,Dir,Suite,Cs}|Ts],Spec) when is_list(Nodes) -> add_tests([{cases,Node,Dir,Suite,Cs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_cases(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Cs,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); @@ -783,7 +708,7 @@ add_tests([{skip_suites,Nodes,Dir,Ss,Cmt}|Ts],Spec) when is_list(Nodes) -> add_tests([{skip_suites,Node,Dir,Ss,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_suites(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Ss,Cmt,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); @@ -792,7 +717,8 @@ add_tests([{skip_suites,Node,Dir,Ss,Cmt}|Ts],Spec) -> add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,Cmt}|Ts],Spec) -> add_tests([{skip_groups,list_nodes(Spec),Dir,Suite,Gs,Cmt}|Ts],Spec); add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> - add_tests([{skip_groups,list_nodes(Spec),Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec); + add_tests([{skip_groups,list_nodes(Spec),Dir,Suite,Gs,{cases,TCs},Cmt}|Ts], + Spec); add_tests([{skip_groups,Dir,Suite,Gs,Cmt}|Ts],Spec) -> add_tests([{skip_groups,all_nodes,Dir,Suite,Gs,Cmt}|Ts],Spec); add_tests([{skip_groups,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> @@ -800,20 +726,22 @@ add_tests([{skip_groups,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> add_tests([{skip_groups,Nodes,Dir,Suite,Gs,Cmt}|Ts],Spec) when is_list(Nodes) -> Ts1 = separate(Nodes,skip_groups,[Dir,Suite,Gs,Cmt],Ts,Spec#testspec.nodes), add_tests(Ts1,Spec); -add_tests([{skip_groups,Nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) when is_list(Nodes) -> - Ts1 = separate(Nodes,skip_groups,[Dir,Suite,Gs,{cases,TCs},Cmt],Ts,Spec#testspec.nodes), +add_tests([{skip_groups,Nodes,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts], + Spec) when is_list(Nodes) -> + Ts1 = separate(Nodes,skip_groups,[Dir,Suite,Gs,{cases,TCs},Cmt],Ts, + Spec#testspec.nodes), add_tests(Ts1,Spec); add_tests([{skip_groups,Node,Dir,Suite,Gs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Gs,all,Cmt,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{skip_groups,Node,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Gs,TCs,Cmt,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); @@ -829,45 +757,101 @@ add_tests([{skip_cases,Nodes,Dir,Suite,Cs,Cmt}|Ts],Spec) when is_list(Nodes) -> add_tests([{skip_cases,Node,Dir,Suite,Cs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_cases(ref2node(Node,Spec#testspec.nodes), - ref2dir(Dir,Spec#testspec.alias), + ref2dir(Dir,Spec), Suite,Cs,Cmt,Tests,Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); +%% --- various configuration terms --- +add_tests([{config,Nodes,CfgDir,Files}|Ts],Spec) when is_list(Nodes); + Nodes == all_nodes -> + add_tests([{config,Nodes,{CfgDir,Files}}|Ts],Spec); +add_tests([{config,Node,CfgDir,FileOrFiles}|Ts],Spec) -> + add_tests([{config,Node,{CfgDir,FileOrFiles}}|Ts],Spec); +add_tests([{config,CfgDir=[Ch|_],Files}|Ts],Spec) when is_integer(Ch) -> + add_tests([{config,all_nodes,{CfgDir,Files}}|Ts],Spec); + +add_tests([{event_handler,Nodes,Hs,Args}|Ts],Spec) when is_list(Nodes); + Nodes == all_nodes -> + add_tests([{event_handler,Nodes,{Hs,Args}}|Ts],Spec); +add_tests([{event_handler,Node,HOrHs,Args}|Ts],Spec) -> + add_tests([{event_handler,Node,{HOrHs,Args}}|Ts],Spec); + +add_tests([{enable_builtin_hooks,Bool}|Ts],Spec) -> + add_tests(Ts, Spec#testspec{enable_builtin_hooks = Bool}); + +add_tests([{noinput,Bool}|Ts],Spec) -> + add_tests(Ts, Spec#testspec{noinput = Bool}); + %% --- handled/errors --- +add_tests([{define,_,_}|Ts],Spec) -> % handled + add_tests(Ts,Spec); + add_tests([{alias,_,_}|Ts],Spec) -> % handled add_tests(Ts,Spec); add_tests([{node,_,_}|Ts],Spec) -> % handled add_tests(Ts,Spec); -add_tests([{merge_tests, _} | Ts], Spec) -> % handled +add_tests([{merge_tests, _} | Ts], Spec) -> % handled add_tests(Ts,Spec); -%% check if it's a CT term that has bad format or if the user seems to -%% have added something of his/her own, which we'll let pass if relaxed -%% mode is enabled. -add_tests([Other|Ts],Spec) when is_tuple(Other) -> - [Name|_] = tuple_to_list(Other), - case lists:keymember(Name,1,valid_terms()) of - true -> % halt - throw({error,{bad_term_in_spec,Other}}); - false -> % ignore - case get(relaxed) of - true -> - %% warn if name resembles a CT term - case resembles_ct_term(Name,size(Other)) of - true -> - io:format("~nSuspicious term, please check:~n" - "~p~n", [Other]); - false -> - ok - end, - add_tests(Ts,Spec); - false -> - throw({error,{undefined_term_in_spec,Other}}) - end +%% -------------------------------------------------- +%% / \ +%% | General add_tests/2 clauses below will work for | +%% | most test spec configuration terms | +%% \ / +%% -------------------------------------------------- + +%% create one test entry per known node and reinsert +add_tests([Term={Tag,all_nodes,Data}|Ts],Spec) -> + case check_term(Term) of + valid -> + Tests = [{Tag,Node,Data} || Node <- list_nodes(Spec), + should_be_added(Tag,Node,Data,Spec)], + add_tests(Tests++Ts,Spec); + invalid -> % ignore term + add_tests(Ts,Spec) end; - +%% create one test entry per node in Nodes and reinsert +add_tests([{Tag,[],Data}|Ts],Spec) -> + add_tests([{Tag,all_nodes,Data}|Ts],Spec); +add_tests([{Tag,String=[Ch|_],Data}|Ts],Spec) when is_integer(Ch) -> + add_tests([{Tag,all_nodes,{String,Data}}|Ts],Spec); +add_tests([{Tag,NodesOrOther,Data}|Ts],Spec) when is_list(NodesOrOther) -> + case lists:all(fun(Test) -> is_node(Test,Spec#testspec.nodes) + end, NodesOrOther) of + true -> + Ts1 = separate(NodesOrOther,Tag,[Data],Ts,Spec#testspec.nodes), + add_tests(Ts1,Spec); + false -> + add_tests([{Tag,all_nodes,{NodesOrOther,Data}}|Ts],Spec) + end; +%% update data for testspec term of type Tag +add_tests([Term={Tag,NodeOrOther,Data}|Ts],Spec) -> + case is_node(NodeOrOther,Spec#testspec.nodes) of + true -> + case check_term(Term) of + valid -> + Node = ref2node(NodeOrOther,Spec#testspec.nodes), + NodeIxData = + update_recorded(Tag,Node,Spec) ++ + handle_data(Tag,Node,Data,Spec), + add_tests(Ts,mod_field(Spec,Tag,NodeIxData)); + invalid -> % ignore term + add_tests(Ts,Spec) + end; + false -> + add_tests([{Tag,all_nodes,{NodeOrOther,Data}}|Ts],Spec) + end; +%% this test should be added for all known nodes +add_tests([Term={Tag,Data}|Ts],Spec) -> + case check_term(Term) of + valid -> + add_tests([{Tag,all_nodes,Data}|Ts],Spec); + invalid -> + add_tests(Ts,Spec) + end; +%% some other data than a tuple add_tests([Other|Ts],Spec) -> case get(relaxed) of true -> @@ -879,6 +863,112 @@ add_tests([Other|Ts],Spec) -> add_tests([],Spec) -> % done Spec. +%% check if it's a CT term that has bad format or if the user seems to +%% have added something of his/her own, which we'll let pass if relaxed +%% mode is enabled. +check_term(Term) -> + Size = size(Term), + [Name|_] = tuple_to_list(Term), + Valid = valid_terms(), + case lists:member({Name,Size},Valid) of + true -> + valid; + false -> + case lists:keymember(Name,1,Valid) of + true -> % halt + throw({error,{bad_term_in_spec,Term}}); + false -> % ignore + case get(relaxed) of + true -> + %% warn if name resembles a CT term + case resembles_ct_term(Name,size(Term)) of + true -> + io:format("~nSuspicious term, " + "please check:~n" + "~p~n", [Term]), + invalid; + false -> + invalid + end; + false -> + throw({error,{undefined_term_in_spec,Term}}) + end + end + end. + +%% specific data handling before saving in testspec record, e.g. +%% converting relative paths to absolute for directories and files +%% (introduce a clause *only* if the data value needs processing) +handle_data(logdir,Node,Dir,Spec) -> + [{Node,ref2dir(Dir,Spec)}]; +handle_data(cover,Node,File,Spec) -> + [{Node,get_absfile(File,Spec)}]; +handle_data(include,Node,Dirs=[D|_],Spec) when is_list(D) -> + [{Node,ref2dir(Dir,Spec)} || Dir <- Dirs]; +handle_data(include,Node,Dir=[Ch|_],Spec) when is_integer(Ch) -> + handle_data(include,Node,[Dir],Spec); +handle_data(config,Node,File=[Ch|_],Spec) when is_integer(Ch) -> + handle_data(config,Node,[File],Spec); +handle_data(config,Node,{CfgDir,File=[Ch|_]},Spec) when is_integer(Ch) -> + handle_data(config,Node,{CfgDir,[File]},Spec); +handle_data(config,Node,Files=[F|_],Spec) when is_list(F) -> + [{Node,get_absfile(File,Spec)} || File <- Files]; +handle_data(config,Node,{CfgDir,Files=[F|_]},Spec) when is_list(F) -> + [{Node,filename:join(ref2dir(CfgDir,Spec),File)} || File <- Files]; +handle_data(userconfig,Node,CBs,Spec) when is_list(CBs) -> + [{Node,{Callback,get_absfile(Callback,Config,Spec)}} || + {Callback,Config} <- CBs]; +handle_data(userconfig,Node,CB,Spec) when is_tuple(CB) -> + handle_data(userconfig,Node,[CB],Spec); +handle_data(event_handler,Node,H,Spec) when is_atom(H) -> + handle_data(event_handler,Node,{[H],[]},Spec); +handle_data(event_handler,Node,{H,Args},Spec) when is_atom(H) -> + handle_data(event_handler,Node,{[H],Args},Spec); +handle_data(event_handler,Node,Hs,_Spec) when is_list(Hs) -> + [{Node,EvH,[]} || EvH <- Hs]; +handle_data(event_handler,Node,{Hs,Args},_Spec) when is_list(Hs) -> + [{Node,EvH,Args} || EvH <- Hs]; +handle_data(ct_hooks,Node,Hooks,_Spec) when is_list(Hooks) -> + [{Node,Hook} || Hook <- Hooks ]; +handle_data(ct_hooks,Node,Hook,_Spec) -> + [{Node,Hook}]; +handle_data(stylesheet,Node,CSSFile,Spec) -> + [{Node,get_absfile(CSSFile,Spec)}]; +handle_data(verbosity,Node,VLvls,_Spec) when is_integer(VLvls) -> + [{Node,[{'$unspecified',VLvls}]}]; +handle_data(verbosity,Node,VLvls,_Spec) when is_list(VLvls) -> + VLvls1 = lists:map(fun(VLvl = {_Cat,_Lvl}) -> VLvl; + (Lvl) -> {'$unspecified',Lvl} end, VLvls), + [{Node,VLvls1}]; +handle_data(_Tag,Node,Data,_Spec) -> + [{Node,Data}]. + +%% check if duplicates should be saved or not +should_be_added(Tag,Node,_Data,Spec) -> + if + %% list terms *without* possible duplicates here + Tag == logdir; Tag == logopts; + Tag == basic_html; Tag == label; + Tag == auto_compile; Tag == stylesheet; + Tag == verbosity -> + lists:keymember(ref2node(Node,Spec#testspec.nodes),1, + read_field(Spec,Tag)) == false; + %% for terms *with* possible duplicates + true -> + true + end. + +%% check if previous elements for Node should be deleted +update_recorded(Tag,Node,Spec) -> + if Tag == config; Tag == userconfig; Tag == event_handler; + Tag == ct_hooks; Tag == include -> + read_field(Spec,Tag); + true -> + %% delete previous value for Tag + lists:keydelete(Node,1,read_field(Spec,Tag)) + end. + +%% create one test term per node separate(Nodes,Tag,Data,Tests,Refs) -> Separated = separate(Nodes,Tag,Data,Refs), Separated ++ Tests. @@ -886,7 +976,25 @@ separate([N|Ns],Tag,Data,Refs) -> [list_to_tuple([Tag,ref2node(N,Refs)|Data])|separate(Ns,Tag,Data,Refs)]; separate([],_,_,_) -> []. - + +%% read the value for FieldName in record Rec#testspec +read_field(Rec, FieldName) -> + catch lists:foldl(fun(F, Pos) when F == FieldName -> + throw(element(Pos, Rec)); + (_,Pos) -> + Pos+1 + end,2,?testspec_fields). + +%% modify the value for FieldName in record Rec#testspec +mod_field(Rec, FieldName, NewVal) -> + [_testspec|RecList] = tuple_to_list(Rec), + RecList1 = + (catch lists:foldl(fun(F, {Prev,[_OldVal|Rest]}) when F == FieldName -> + throw(lists:reverse(Prev) ++ [NewVal|Rest]); + (_,{Prev,[Field|Rest]}) -> + {[Field|Prev],Rest} + end,{[],RecList},?testspec_fields)), + list_to_tuple([testspec|RecList1]). %% Representation: %% {{Node,Dir},[{Suite1,[GrOrCase11,GrOrCase12,...]}, @@ -1094,33 +1202,40 @@ ref2node(all_nodes,_Refs) -> ref2node(master,_Refs) -> master; ref2node(RefOrNode,Refs) -> - case string:chr(atom_to_list(RefOrNode),$@) of - 0 -> % a ref + case lists:member($@,atom_to_list(RefOrNode)) of + false -> % a ref case lists:keysearch(RefOrNode,1,Refs) of {value,{RefOrNode,Node}} -> Node; false -> throw({error,{noderef_missing,RefOrNode}}) end; - _ -> % a node + true -> % a node RefOrNode end. -ref2dir(Ref,Refs) when is_atom(Ref) -> +ref2dir(Ref,Spec) -> + ref2dir(Ref,Spec#testspec.alias,Spec). + +ref2dir(Ref,Refs,Spec) when is_atom(Ref) -> case lists:keysearch(Ref,1,Refs) of {value,{Ref,Dir}} -> - Dir; + get_absdir(Dir,Spec); false -> throw({error,{alias_missing,Ref}}) end; -ref2dir(Dir,_) when is_list(Dir) -> - Dir. - -is_noderef(What,Nodes) when is_atom(What) -> - is_noderef([What],Nodes); -is_noderef([master|_],_Nodes) -> +ref2dir(Dir,_,Spec) when is_list(Dir) -> + get_absdir(Dir,Spec); +ref2dir(What,_,_) -> + throw({error,{invalid_directory_name,What}}). + +is_node(What,Nodes) when is_atom(What) -> + is_node([What],Nodes); +is_node([master|_],_Nodes) -> true; -is_noderef([What|_],Nodes) -> +is_node(What={N,H},Nodes) when is_atom(N), is_atom(H) -> + is_node([What],Nodes); +is_node([What|_],Nodes) -> case lists:keymember(What,1,Nodes) or lists:keymember(What,2,Nodes) of true -> @@ -1128,24 +1243,30 @@ is_noderef([What|_],Nodes) -> false -> false end; -is_noderef([],_) -> +is_node([],_) -> false. valid_terms() -> [ + {define,3}, {node,3}, {cover,2}, {cover,3}, {config,2}, {config,3}, + {config,4}, {userconfig,2}, {userconfig,3}, {alias,3}, - {merge_tests,1}, + {merge_tests,2}, {logdir,2}, {logdir,3}, {logopts,2}, {logopts,3}, + {basic_html,2}, + {basic_html,3}, + {verbosity,2}, + {verbosity,3}, {label,2}, {label,3}, {event_handler,2}, @@ -1153,13 +1274,18 @@ valid_terms() -> {event_handler,4}, {ct_hooks,2}, {ct_hooks,3}, - {enable_builtin_hooks,1}, + {enable_builtin_hooks,2}, + {noinput,2}, {multiply_timetraps,2}, {multiply_timetraps,3}, {scale_timetraps,2}, {scale_timetraps,3}, {include,2}, {include,3}, + {auto_compile,2}, + {auto_compile,3}, + {stylesheet,2}, + {stylesheet,3}, {suites,3}, {suites,4}, {groups,4}, @@ -1174,7 +1300,8 @@ valid_terms() -> {skip_groups,7}, {skip_cases,5}, {skip_cases,6}, - {create_priv_dir,2} + {create_priv_dir,2}, + {create_priv_dir,3} ]. %% this function "guesses" if the user has misspelled a term name diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index e9bfb2590b..efc85543ac 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -25,7 +25,8 @@ %%% -module(ct_util). --export([start/0,start/1,start/2,stop/1,update_last_run_index/0]). +-export([start/0,start/1,start/2,start/3, + stop/1,update_last_run_index/0]). -export([register_connection/4,unregister_connection/1, does_connection_exist/3,get_key_from_name/1]). @@ -36,14 +37,15 @@ save_suite_data_async/3, save_suite_data_async/2, read_suite_data/1, delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, - delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, + delete_testdata/0, delete_testdata/1, + set_testdata/1, get_testdata/1, get_testdata/2, set_testdata_async/1, update_testdata/2]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, delete_overridden_silenced_connections/0, - silence_all_connections/0, silence_connections/1, is_silenced/1, - reset_silent_connections/0]). + silence_all_connections/0, silence_connections/1, + is_silenced/1, is_silenced/2, reset_silent_connections/0]). -export([get_mode/0, create_table/3, read_opts/0]). @@ -64,9 +66,13 @@ -export([get_profile_data/0, get_profile_data/1, get_profile_data/2, open_url/3]). +-include("ct.hrl"). -include("ct_event.hrl"). -include("ct_util.hrl"). +-define(default_verbosity, [{default,?MAX_VERBOSITY}, + {'$unspecified',?MAX_VERBOSITY}]). + -record(suite_data, {key,name,value}). %%%----------------------------------------------------------------- @@ -85,18 +91,21 @@ %%% %%% @see ct start() -> - start(normal,"."). + start(normal, ".", ?default_verbosity). start(LogDir) when is_list(LogDir) -> - start(normal,LogDir); + start(normal, LogDir, ?default_verbosity); start(Mode) -> - start(Mode,"."). + start(Mode, ".", ?default_verbosity). + +start(LogDir, Verbosity) when is_list(LogDir) -> + start(normal, LogDir, Verbosity). -start(Mode,LogDir) -> +start(Mode, LogDir, Verbosity) -> case whereis(ct_util_server) of undefined -> S = self(), - Pid = spawn_link(fun() -> do_start(S,Mode,LogDir) end), + Pid = spawn_link(fun() -> do_start(S, Mode, LogDir, Verbosity) end), receive {Pid,started} -> Pid; {Pid,Error} -> exit(Error); @@ -113,7 +122,7 @@ start(Mode,LogDir) -> end end. -do_start(Parent,Mode,LogDir) -> +do_start(Parent, Mode, LogDir, Verbosity) -> process_flag(trap_exit,true), register(ct_util_server,self()), create_table(?conn_table,#conn.handle), @@ -173,7 +182,7 @@ do_start(Parent,Mode,LogDir) -> false -> ok end, - {StartTime,TestLogDir} = ct_logs:init(Mode), + {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), ct_event:notify(#event{name=test_start, node=node(), @@ -193,7 +202,7 @@ do_start(Parent,Mode,LogDir) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, - loop(Mode,[],StartDir). + loop(Mode, [{{verbosity,Cat},Lvl} || {Cat,Lvl} <- Verbosity], StartDir). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -254,6 +263,9 @@ set_testdata_async(TestData) -> get_testdata(Key) -> call({get_testdata, Key}). +get_testdata(Key, Timeout) -> + call({get_testdata, Key}, Timeout). + set_cwd(Dir) -> call({set_cwd,Dir}). @@ -369,14 +381,25 @@ loop(Mode,TestData,StartDir) -> {'EXIT',_Pid,normal} -> loop(Mode,TestData,StartDir); {'EXIT',Pid,Reason} -> - %% Let process crash in case of error, this shouldn't happen! - io:format("\n\nct_util_server got EXIT from ~p: ~p\n\n", - [Pid,Reason]), - file:set_cwd(StartDir), - exit(Reason) + case ets:lookup(?conn_table,Pid) of + [#conn{address=A,callback=CB}] -> + %% A connection crashed - remove the connection but don't die + ct_logs:tc_log_async(ct_error_notify, + "Connection process died: " + "Pid: ~p, Address: ~p, Callback: ~p\n" + "Reason: ~p\n\n", + [Pid,A,CB,Reason]), + catch CB:close(Pid), + loop(Mode,TestData,StartDir); + _ -> + %% Let process crash in case of error, this shouldn't happen! + io:format("\n\nct_util_server got EXIT from ~p: ~p\n\n", + [Pid,Reason]), + file:set_cwd(StartDir), + exit(Reason) + end end. - close_connections([#conn{handle=Handle,callback=CB}|Conns]) -> CB:close(Handle), close_connections(Conns); @@ -508,7 +531,7 @@ close_connections() -> %%% %%% @doc override_silence_all_connections() -> - Protocols = [telnet,ftp,rpc,snmp], + Protocols = [telnet,ftp,rpc,snmp,ssh], override_silence_connections(Protocols), Protocols. @@ -545,7 +568,10 @@ silence_connections(Conns) when is_list(Conns) -> set_testdata({silent_connections,Conns1}). is_silenced(Conn) -> - case get_testdata(silent_connections) of + is_silenced(Conn, infinity). + +is_silenced(Conn, Timeout) -> + case get_testdata(silent_connections, Timeout) of Conns when is_list(Conns) -> case lists:keysearch(Conn,1,Conns) of {value,{Conn,true}} -> @@ -553,6 +579,8 @@ is_silenced(Conn) -> _ -> false end; + Error = {error,_} -> + Error; _ -> false end. @@ -827,19 +855,28 @@ get_profile_data(Profile, Key, StartDir) -> %%%----------------------------------------------------------------- %%% Internal functions call(Msg) -> - case whereis(ct_util_server) of - undefined -> + call(Msg, infinity). + +call(Msg, Timeout) -> + case {self(),whereis(ct_util_server)} of + {_,undefined} -> {error,ct_util_server_not_running}; - Pid -> + {Pid,Pid} -> + %% the caller is ct_util_server, which must + %% be a mistake + {error,bad_invocation}; + {Self,Pid} -> MRef = erlang:monitor(process, Pid), Ref = make_ref(), - ct_util_server ! {Msg,{self(),Ref}}, + ct_util_server ! {Msg,{Self,Ref}}, receive {Ref, Result} -> erlang:demonitor(MRef, [flush]), Result; {'DOWN',MRef,process,_,Reason} -> {error,{ct_util_server_down,Reason}} + after + Timeout -> {error,timeout} end end. diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 082599a9c6..7015014441 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -34,13 +34,18 @@ profile=[], logdir=["."], logopts=[], + basic_html=[], + verbosity=[], cover=[], config=[], userconfig=[], event_handler=[], ct_hooks=[], enable_builtin_hooks=true, + noinput=false, include=[], + auto_compile=[], + stylesheet=[], multiply_timetraps=[], scale_timetraps=[], create_priv_dir=[], @@ -64,3 +69,11 @@ -define(ct_config_txt, ct_config_plain). -define(ct_profile_file, ".common_test"). + +-define(css_default, "ct_default.css"). +-define(sortable_table_name, "SortableTable"). +-define(jquery_script, "jquery-latest.js"). +-define(tablesorter_script, "jquery.tablesorter.min.js"). + +%% Logging information for error handler +-record(conn_log, {client, name, address, action, module}). diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl new file mode 100644 index 0000000000..3af89db3a5 --- /dev/null +++ b/lib/common_test/src/cth_conn_log.erl @@ -0,0 +1,124 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. 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% +%% +%%---------------------------------------------------------------------- +%% CT hook for logging of connections. +%% +%% HookOptions can be hardcoded in the test suite: +%% +%% suite() -> +%% [{ct_hooks, [{cth_conn_log, +%% [{ct_netconfc:conn_mod(),ct_netconfc:hook_options()}]}]}]. +%% +%% or specified in a configuration file: +%% +%% {ct_conn_log,[{ct_netconfc:conn_mod(),ct_netconfc:hook_options()}]}. +%% +%% The conn_mod() is the common test module implementing the protocol, +%% e.g. ct_netconfc, ct_telnet, etc. This module must log by calling +%% +%% error_logger:info_report(ConnLogInfo,Data). +%% ConnLogInfo = #conn_log{} | {ct_connection,Action,ConnName} +%% Action = open | close | send | recv | term() +%% ConnName = atom() - The 'KeyOrName' argument used when opening the connection +%% +%% ct_conn_log_h will print to html log or separate file (depending on +%% log_type() option). conn_mod() must implement and export +%% +%% format_data(log_type(), Data). +%% +%% If logging to separate file, ct_conn_log_h will also log error +%% reports which are witten like this: +%% +%% error_logger:error_report([{ct_connection,ConnName} | Report]). +%% +%%---------------------------------------------------------------------- +-module(cth_conn_log). + +-include_lib("common_test/include/ct.hrl"). + +-export([init/2, + pre_init_per_testcase/3, + post_end_per_testcase/4]). + +-spec init(Id, HookOpts) -> Result when + Id :: term(), + HookOpts :: ct:hook_options(), + Result :: {ok,[{ct_netconfc:conn_mod(), + {ct_netconfc:log_type(),[ct_netconfc:key_or_name()]}}]}. +init(_Id, HookOpts) -> + ConfOpts = ct:get_config(ct_conn_log,[]), + {ok,merge_log_info(ConfOpts,HookOpts)}. + +merge_log_info([{Mod,ConfOpts}|ConfList],HookList) -> + {Opts,HookList1} = + case lists:keytake(Mod,1,HookList) of + false -> + {ConfOpts,HookList}; + {value,{_,HookOpts},HL1} -> + {ConfOpts ++ HookOpts, HL1} % ConfOpts overwrites HookOpts! + end, + [{Mod,get_log_opts(Opts)} | merge_log_info(ConfList,HookList1)]; +merge_log_info([],HookList) -> + [{Mod,get_log_opts(Opts)} || {Mod,Opts} <- HookList]. + +get_log_opts(Opts) -> + LogType = proplists:get_value(log_type,Opts,html), + Hosts = proplists:get_value(hosts,Opts,[]), + {LogType,Hosts}. + + +pre_init_per_testcase(TestCase,Config,CthState) -> + Logs = + lists:map( + fun({ConnMod,{LogType,Hosts}}) -> + case LogType of + LogType when LogType==raw; LogType==pretty -> + Dir = ?config(priv_dir,Config), + TCStr = atom_to_list(TestCase), + ConnModStr = atom_to_list(ConnMod), + DefLogName = TCStr ++ "-" ++ ConnModStr ++ ".txt", + DefLog = filename:join(Dir,DefLogName), + Ls = [{Host, + filename:join(Dir,TCStr ++ "-"++ + atom_to_list(Host) ++ "-" ++ + ConnModStr ++ + ".txt")} + || Host <- Hosts] + ++[{default,DefLog}], + Str = + "<table borders=1>" + "<b>" ++ ConnModStr ++ " logs:</b>\n" ++ + [io_lib:format( + "<tr><td>~p</td><td><a href=~p>~s</a></td></tr>", + [S,L,filename:basename(L)]) + || {S,L} <- Ls] ++ + "</table>", + io:format(Str,[]), + {ConnMod,{LogType,Ls}}; + _ -> + {ConnMod,{LogType,[]}} + end + end, + CthState), + error_logger:add_report_handler(ct_conn_log_h,{group_leader(),Logs}), + {Config,CthState}. + +post_end_per_testcase(_TestCase,_Config,Return,CthState) -> + error_logger:delete_report_handler(ct_conn_log_h), + {Return,CthState}. diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index ea79251cfc..77f57c6195 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2012. 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 diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl new file mode 100644 index 0000000000..e7bd84e51b --- /dev/null +++ b/lib/common_test/src/cth_surefire.erl @@ -0,0 +1,219 @@ +%%% @doc Common Test Framework functions handling test specifications. +%%% +%%% <p>This module creates a junit report of the test run if plugged in +%%% as a suite_callback.</p> + +-module(cth_surefire). + +%% Suite Callbacks +-export([id/1, init/2]). + +-export([pre_init_per_suite/3]). +-export([post_init_per_suite/4]). +-export([pre_end_per_suite/3]). +-export([post_end_per_suite/4]). + +-export([pre_init_per_group/3]). +-export([post_init_per_group/4]). +-export([pre_end_per_group/3]). +-export([post_end_per_group/4]). + +-export([pre_init_per_testcase/3]). +-export([post_end_per_testcase/4]). + +-export([on_tc_fail/3]). +-export([on_tc_skip/3]). + +-export([terminate/1]). + +-record(state, { filepath, axis, properties, package, hostname, + curr_suite, curr_suite_ts, curr_group = [], curr_tc, + curr_log_dir, timer, tc_log, + test_cases = [], + test_suites = [] }). + +-record(testcase, { log, group, classname, name, time, failure, timestamp }). +-record(testsuite, { errors, failures, hostname, name, tests, + time, timestamp, id, package, + properties, testcases }). + +id(Opts) -> + filename:absname(proplists:get_value(path, Opts, "junit_report.xml")). + +init(Path, Opts) -> + {ok, Host} = inet:gethostname(), + #state{ filepath = Path, + hostname = proplists:get_value(hostname,Opts,Host), + package = proplists:get_value(package,Opts), + axis = proplists:get_value(axis,Opts,[]), + properties = proplists:get_value(properties,Opts,[]), + timer = now() }. + +pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> + {Config, init_tc(State#state{ curr_suite = Suite, curr_suite_ts = now() }, + Config) }; +pre_init_per_suite(Suite,Config,State) -> + %% Have to close the previous suite + pre_init_per_suite(Suite,Config,close_suite(State)). + +post_init_per_suite(_Suite,Config, Result, State) -> + {Result, end_tc(init_per_suite,Config,Result,State)}. + +pre_end_per_suite(_Suite,Config,State) -> {Config, init_tc(State, Config)}. + +post_end_per_suite(_Suite,Config,Result,State) -> + {Result, end_tc(end_per_suite,Config,Result,State)}. + +pre_init_per_group(Group,Config,State) -> + {Config, init_tc(State#state{ curr_group = [Group|State#state.curr_group]}, + Config)}. + +post_init_per_group(_Group,Config,Result,State) -> + {Result, end_tc(init_per_group,Config,Result,State)}. + +pre_end_per_group(_Group,Config,State) -> {Config, init_tc(State, Config)}. + +post_end_per_group(_Group,Config,Result,State) -> + NewState = end_tc(end_per_group, Config, Result, State), + {Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}. + +pre_init_per_testcase(_TC,Config,State) -> {Config, init_tc(State, Config)}. + +post_end_per_testcase(TC,Config,Result,State) -> + {Result, end_tc(TC,Config, Result,State)}. + +on_tc_fail(_TC, _Res, State = #state{test_cases = []}) -> + State; +on_tc_fail(_TC, Res, State) -> + TCs = State#state.test_cases, + TC = hd(TCs), + NewTC = TC#testcase{ + failure = + {fail,lists:flatten(io_lib:format("~p",[Res]))} }, + State#state{ test_cases = [NewTC | tl(TCs)]}. + +on_tc_skip(Tc,{Type,Reason} = Res, State) when Type == tc_auto_skip -> + do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[]))); +on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) -> + State; +on_tc_skip(_Tc, Res, State) -> + do_tc_skip(Res, State). + +do_tc_skip(Res, State) -> + TCs = State#state.test_cases, + TC = hd(TCs), + NewTC = TC#testcase{ + failure = + {skipped,lists:flatten(io_lib:format("~p",[Res]))} }, + State#state{ test_cases = [NewTC | tl(TCs)]}. + +init_tc(State, Config) when is_list(Config) == false -> + State#state{ timer = now(), tc_log = "" }; +init_tc(State, Config) -> + State#state{ timer = now(), + tc_log = proplists:get_value(tc_logfile, Config, [])}. + +end_tc(Func, Config, Res, State) when is_atom(Func) -> + end_tc(atom_to_list(Func), Config, Res, State); +end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, + curr_group = Groups, + timer = TS, tc_log = Log } ) -> + ClassName = atom_to_list(Suite), + PGroup = string:join([ atom_to_list(Group)|| + Group <- lists:reverse(Groups)],"."), + TimeTakes = io_lib:format("~f",[timer:now_diff(now(),TS) / 1000000]), + State#state{ test_cases = [#testcase{ log = Log, + timestamp = now_to_string(TS), + classname = ClassName, + group = PGroup, + name = Name, + time = TimeTakes, + failure = passed }| State#state.test_cases]}. +close_suite(#state{ test_cases = [] } = State) -> + State; +close_suite(#state{ test_cases = TCs } = State) -> + Total = length(TCs), + Succ = length(lists:filter(fun(#testcase{ failure = F }) -> + F == passed + end,TCs)), + Fail = Total - Succ, + TimeTaken = timer:now_diff(now(),State#state.curr_suite_ts) / 1000000, + Suite = #testsuite{ name = atom_to_list(State#state.curr_suite), + package = State#state.package, + time = io_lib:format("~f",[TimeTaken]), + timestamp = now_to_string(State#state.curr_suite_ts), + errors = Fail, tests = Total, + testcases = lists:reverse(TCs) }, + State#state{ test_cases = [], + test_suites = [Suite | State#state.test_suites]}. + +terminate(State = #state{ test_cases = [] }) -> + {ok,D} = file:open(State#state.filepath,[write,{encoding,utf8}]), + io:format(D, "<?xml version=\"1.0\" encoding= \"UTF-8\" ?>", []), + io:format(D, to_xml(State), []), + catch file:sync(D), + catch file:close(D); +terminate(State) -> + %% Have to close the last suite + terminate(close_suite(State)). + + + +to_xml(#testcase{ group = Group, classname = CL, log = L, name = N, time = T, timestamp = TS, failure = F}) -> + ["<testcase ", + [["group=\"",Group,"\""]||Group /= ""]," " + "name=\"",N,"\" " + "time=\"",T,"\" " + "timestamp=\"",TS,"\" " + "log=\"",L,"\">", + case F of + passed -> + []; + {skipped,Reason} -> + ["<skipped type=\"skip\" message=\"Test ",N," in ",CL, + " skipped!\">", sanitize(Reason),"</skipped>"]; + {fail,Reason} -> + ["<failure message=\"Test ",N," in ",CL," failed!\" type=\"crash\">", + sanitize(Reason),"</failure>"] + end,"</testcase>"]; +to_xml(#testsuite{ package = P, hostname = H, errors = E, time = Time, + timestamp = TS, tests = T, name = N, testcases = Cases }) -> + ["<testsuite ", + [["package=\"",P,"\" "]||P /= undefined], + [["hostname=\"",P,"\" "]||H /= undefined], + [["name=\"",N,"\" "]||N /= undefined], + [["time=\"",Time,"\" "]||Time /= undefined], + [["timestamp=\"",TS,"\" "]||TS /= undefined], + "errors=\"",integer_to_list(E),"\" " + "tests=\"",integer_to_list(T),"\">", + [to_xml(Case) || Case <- Cases], + "</testsuite>"]; +to_xml(#state{ test_suites = TestSuites, axis = Axis, properties = Props }) -> + ["<testsuites>",properties_to_xml(Axis,Props), + [to_xml(TestSuite) || TestSuite <- TestSuites],"</testsuites>"]. + +properties_to_xml(Axis,Props) -> + ["<properties>", + [["<property name=\"",Name,"\" axis=\"yes\" value=\"",Value,"\" />"] || {Name,Value} <- Axis], + [["<property name=\"",Name,"\" value=\"",Value,"\" />"] || {Name,Value} <- Props], + "</properties>" + ]. + +sanitize([$>|T]) -> + ">" ++ sanitize(T); +sanitize([$<|T]) -> + "<" ++ sanitize(T); +sanitize([$"|T]) -> + """ ++ sanitize(T); +sanitize([$'|T]) -> + "'" ++ sanitize(T); +sanitize([$&|T]) -> + "&" ++ sanitize(T); +sanitize([H|T]) -> + [H|sanitize(T)]; +sanitize([]) -> + []. + +now_to_string(Now) -> + {{YY,MM,DD},{HH,Mi,SS}} = calendar:now_to_local_time(Now), + io_lib:format("~p-~2..0B-~2..0BT~2..0B:~2..0B:~2..0B",[YY,MM,DD,HH,Mi,SS]). diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index cc8a932887..b340c6fdd1 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -766,10 +766,6 @@ report1(tc_done,{_Suite,init_per_group,_},State) -> State; report1(tc_done,{_Suite,end_per_group,_},State) -> State; -report1(tc_done,{_Suite,ct_init_per_group,_},State) -> - State; -report1(tc_done,{_Suite,ct_end_per_group,_},State) -> - State; report1(tc_done,{_Suite,_Case,ok},State) -> State#state{ok=State#state.ok+1}; report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> |