diff options
Diffstat (limited to 'lib/common_test/src/ct_util.erl')
| -rw-r--r-- | lib/common_test/src/ct_util.erl | 1303 |
1 files changed, 1303 insertions, 0 deletions
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl new file mode 100644 index 0000000000..ba3d789f8d --- /dev/null +++ b/lib/common_test/src/ct_util.erl @@ -0,0 +1,1303 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% @doc Common Test Framework Utilities. +%%% +%%% <p>This is a support module for the Common Test Framework. It +%%% implements the process ct_util_server which acts like a data +%%% holder for suite, configuration and connection data.</p> +%%% +-module(ct_util). + +-export([start/0,start/1,start/2,stop/1,update_last_run_index/0]). + +-export([register_connection/4,unregister_connection/1, + does_connection_exist/3,get_key_from_name/1]). + +-export([require/1, require/2, get_config/1, get_config/2, get_config/3, + set_default_config/2, set_default_config/3, delete_default_config/1, + get_all_config/0, update_config/2, + release_allocated/0, close_connections/0]). + +-export([save_suite_data/3, save_suite_data/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, + 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]). + +-export([set_cwd/1, reset_cwd/0]). + +-export([parse_table/1]). + +-export([listenv/1]). + +-export([get_target_name/1, get_connections/2]). + +-export([is_test_dir/1, get_testdir/2]). + +-export([encrypt_config_file/2, encrypt_config_file/3, + decrypt_config_file/2, decrypt_config_file/3]). + +-export([kill_attached/2, get_attached/1]). + +-export([warn_duplicates/1]). + +-include("ct_event.hrl"). +-include("ct_util.hrl"). + +-record(ct_conf,{key,value,ref,name='_UNDEF',default=false}). +%% default = {true,suite} | {true,testcase} | false + +-record(suite_data, {key,name,value}). + +-define(cryptfile, ".ct_config.crypt"). + +%%%----------------------------------------------------------------- +%%% @spec start(Mode) -> Pid | exit(Error) +%%% Mode = normal | interactive +%%% Pid = pid() +%%% +%%% @doc Start start the ct_util_server process +%%% (tool-internal use only). +%%% +%%% <p>This function is called from ct_run.erl. It starts and initiates +%%% the <code>ct_util_server</code></p> +%%% +%%% <p>Returns the process identity of the +%%% <code>ct_util_server</code>.</p> +%%% +%%% @see ct +start() -> + start(normal,"."). + +start(LogDir) when is_list(LogDir) -> + start(normal,LogDir); +start(Mode) -> + start(Mode,"."). + +start(Mode,LogDir) -> + case whereis(ct_util_server) of + undefined -> + S = self(), + Pid = spawn_link(fun() -> do_start(S,Mode,LogDir) end), + receive + {Pid,started} -> Pid; + {Pid,Error} -> exit(Error) + end; + Pid -> + case get_mode() of + interactive when Mode==interactive -> + Pid; + interactive -> + {error,interactive_mode}; + _OtherMode -> + Pid + end + end. + +do_start(Parent,Mode,LogDir) -> + process_flag(trap_exit,true), + register(ct_util_server,self()), + create_table(?attr_table,bag,#ct_conf.key), + create_table(?conn_table,#conn.handle), + create_table(?board_table,2), + create_table(?suite_table,#suite_data.key), + {ok,StartDir} = file:get_cwd(), + case file:set_cwd(LogDir) of + ok -> ok; + E -> exit(E) + end, + Opts = case read_opts() of + {ok,Opts1} -> + Opts1; + Error -> + Parent ! {self(),Error}, + exit(Error) + end, + + %% start an event manager (if not already started by master) + case ct_event:start_link() of + {error,{already_started,_}} -> + ok; + _ -> + case whereis(vts) of + undefined -> + ct_event:add_handler(); + VtsPid -> + ct_event:add_handler([{vts,VtsPid}]) + end + end, + case read_config_files(Opts) of + ok -> + %% add user handlers + case lists:keysearch(event_handler,1,Opts) of + {value,{_,Handlers}} -> + Add = fun({H,Args}) -> + case catch gen_event:add_handler(?CT_EVMGR_REF,H,Args) of + ok -> ok; + {'EXIT',Why} -> exit(Why); + Other -> exit({event_handler,Other}) + end + end, + case catch lists:foreach(Add,Handlers) of + {'EXIT',Reason} -> + Parent ! {self(),Reason}; + _ -> + ok + end; + false -> + ok + end, + {StartTime,TestLogDir} = ct_logs:init(Mode), + ct_event:notify(#event{name=test_start, + node=node(), + data={StartTime, + lists:flatten(TestLogDir)}}), + Parent ! {self(),started}, + loop(Mode,[],StartDir); + ReadError -> + Parent ! {self(),ReadError}, + exit(ReadError) + end. + +create_table(TableName,KeyPos) -> + create_table(TableName,set,KeyPos). +create_table(TableName,Type,KeyPos) -> + catch ets:delete(TableName), + ets:new(TableName,[Type,named_table,public,{keypos,KeyPos}]). + +read_opts() -> + case file:consult(ct_run:variables_file_name("./")) of + {ok,Opts} -> + {ok,Opts}; + {error,enoent} -> + {error,not_installed}; + Error -> + {error,{bad_installation,Error}} + end. + +read_config_files(Opts) -> + ConfigFiles = + lists:foldl(fun({config,Files},Acc) -> + Acc ++ Files; + (_,Acc) -> + Acc + end,[],Opts), + read_config_files1(ConfigFiles). + +read_config_files1([ConfigFile|Files]) -> + case file:consult(ConfigFile) of + {ok,Config} -> + set_config(Config), + read_config_files1(Files); + {error,enoent} -> + {user_error,{config_file_error,ConfigFile,enoent}}; + {error,Reason} -> + Key = + case application:get_env(common_test, decrypt) of + {ok,KeyOrFile} -> + case KeyOrFile of + {key,K} -> + K; + {file,F} -> + get_crypt_key_from_file(F) + end; + _ -> + get_crypt_key_from_file() + end, + case Key of + {error,no_crypt_file} -> + {user_error,{config_file_error,ConfigFile,Reason}}; + {error,CryptError} -> + {user_error,{decrypt_file_error,ConfigFile,CryptError}}; + _ when is_list(Key) -> + case decrypt_config_file(ConfigFile, undefined, {key,Key}) of + {ok,CfgBin} -> + case read_config_terms(CfgBin) of + {error,ReadFail} -> + {user_error,{config_file_error,ConfigFile,ReadFail}}; + Config -> + set_config(Config), + read_config_files1(Files) + end; + {error,DecryptFail} -> + {user_error,{decrypt_config_error,ConfigFile,DecryptFail}} + end; + _ -> + {user_error,{bad_decrypt_key,ConfigFile,Key}} + end + end; +read_config_files1([]) -> + ok. + +read_config_terms(Bin) when is_binary(Bin) -> + case catch binary_to_list(Bin) of + {'EXIT',_} -> + {error,invalid_textfile}; + Lines -> + read_config_terms(Lines) + end; +read_config_terms(Lines) when is_list(Lines) -> + read_config_terms1(erl_scan:tokens([], Lines, 0), 1, [], []). + +read_config_terms1({done,{ok,Ts,EL},Rest}, L, Terms, _) -> + case erl_parse:parse_term(Ts) of + {ok,Term} when Rest == [] -> + lists:reverse([Term|Terms]); + {ok,Term} -> + read_config_terms1(erl_scan:tokens([], Rest, 0), + EL+1, [Term|Terms], Rest); + _ -> + {error,{bad_term,{L,EL}}} + end; +read_config_terms1({done,{eof,_},_}, _, Terms, Rest) when Rest == [] -> + lists:reverse(Terms); +read_config_terms1({done,{eof,EL},_}, L, _, _) -> + {error,{bad_term,{L,EL}}}; +read_config_terms1({done,{error,Info,EL},_}, L, _, _) -> + {error,{Info,{L,EL}}}; +read_config_terms1({more,_}, L, Terms, Rest) -> + case string:tokens(Rest, [$\n,$\r,$\t]) of + [] -> + lists:reverse(Terms); + _ -> + {error,{bad_term,L}} + end. + +set_default_config(NewConfig, Scope) -> + call({set_default_config, {NewConfig, Scope}}). + +set_default_config(Name, NewConfig, Scope) -> + call({set_default_config, {Name, NewConfig, Scope}}). + +delete_default_config(Scope) -> + call({delete_default_config, Scope}). + +update_config(Name, Config) -> + call({update_config, {Name, Config}}). + +save_suite_data(Key, Value) -> + call({save_suite_data, {Key, undefined, Value}}). + +save_suite_data(Key, Name, Value) -> + call({save_suite_data, {Key, Name, Value}}). + +read_suite_data(Key) -> + call({read_suite_data, Key}). + +delete_suite_data() -> + call({delete_suite_data, all}). + +delete_suite_data(Key) -> + call({delete_suite_data, Key}). + +match_delete_suite_data(KeyPat) -> + call({match_delete_suite_data, KeyPat}). + +delete_testdata() -> + call(delete_testdata). + +delete_testdata(Key) -> + call({delete_testdata, Key}). + +update_testdata(Key, Fun) -> + call({update_testdata, Key, Fun}). + +set_testdata(TestData) -> + call({set_testdata, TestData}). + +get_testdata(Key) -> + call({get_testdata, Key}). + +set_cwd(Dir) -> + call({set_cwd,Dir}). + +reset_cwd() -> + call(reset_cwd). + +loop(Mode,TestData,StartDir) -> + receive + {update_last_run_index,From} -> + ct_logs:make_last_run_index(), + return(From,ok), + loop(Mode,TestData,StartDir); + {{require,Name,Tag,SubTags},From} -> + Result = do_require(Name,Tag,SubTags), + return(From,Result), + loop(Mode,TestData,StartDir); + {{set_default_config,{Config,Scope}},From} -> + set_config(Config,{true,Scope}), + return(From,ok), + loop(Mode,TestData,StartDir); + {{set_default_config,{Name,Config,Scope}},From} -> + set_config(Name,Config,{true,Scope}), + return(From,ok), + loop(Mode,TestData,StartDir); + {{delete_default_config,Scope},From} -> + delete_config({true,Scope}), + return(From,ok), + loop(Mode,TestData,StartDir); + {{update_config,{Name,NewConfig}},From} -> + update_conf(Name,NewConfig), + return(From,ok), + loop(Mode,TestData,StartDir); + {{save_suite_data,{Key,Name,Value}},From} -> + ets:insert(?suite_table, #suite_data{key=Key, + name=Name, + value=Value}), + return(From,ok), + loop(Mode,TestData,StartDir); + {{read_suite_data,Key},From} -> + case ets:lookup(?suite_table, Key) of + [#suite_data{key=Key,name=undefined,value=Value}] -> + return(From,Value); + [#suite_data{key=Key,name=Name,value=Value}] -> + return(From,{Name,Value}); + _ -> + return(From,undefined) + end, + loop(Mode,TestData,StartDir); + {{delete_suite_data,Key},From} -> + if Key == all -> + ets:delete_all_objects(?suite_table); + true -> + ets:delete(?suite_table, Key) + end, + return(From,ok), + loop(Mode,TestData,StartDir); + {{match_delete_suite_data,KeyPat},From} -> + ets:match_delete(?suite_table, #suite_data{key=KeyPat, + name='_', + value='_'}), + return(From,ok), + loop(Mode,TestData,StartDir); + {delete_testdata,From} -> + return(From,ok), + loop(From,[],StartDir); + {{delete_testdata,Key},From} -> + TestData1 = lists:keydelete(Key,1,TestData), + return(From,ok), + loop(From,TestData1,StartDir); + {{set_testdata,New = {Key,_Val}},From} -> + TestData1 = lists:keydelete(Key,1,TestData), + return(From,ok), + loop(Mode,[New|TestData1],StartDir); + {{get_testdata,Key},From} -> + case lists:keysearch(Key,1,TestData) of + {value,{Key,Val}} -> + return(From,Val); + _ -> + return(From,undefined) + end, + loop(From,TestData,StartDir); + {{update_testdata,Key,Fun},From} -> + TestData1 = + case lists:keysearch(Key,1,TestData) of + {value,{Key,Val}} -> + NewVal = Fun(Val), + return(From,NewVal), + [{Key,NewVal}|lists:keydelete(Key,1,TestData)]; + _ -> + return(From,undefined), + TestData + end, + loop(From,TestData1,StartDir); + {{set_cwd,Dir},From} -> + return(From,file:set_cwd(Dir)), + loop(From,TestData,StartDir); + {reset_cwd,From} -> + return(From,file:set_cwd(StartDir)), + loop(From,TestData,StartDir); + {{stop,How},From} -> + Time = calendar:local_time(), + ct_event:sync_notify(#event{name=test_done, + node=node(), + data=Time}), + ets:delete(?attr_table), + close_connections(ets:tab2list(?conn_table)), + ets:delete(?conn_table), + ets:delete(?board_table), + ets:delete(?suite_table), + ct_logs:close(How), + file:set_cwd(StartDir), + ct_event:stop(), + return(From,ok); + {get_mode,From} -> + return(From,Mode), + 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) + end. + + +close_connections([#conn{handle=Handle,callback=CB}|Conns]) -> + CB:close(Handle), + close_connections(Conns); +close_connections([]) -> + ok. + + +%%%----------------------------------------------------------------- +%%% @spec register_connection(TargetName,Address,Callback,Handle) -> +%%% ok | {error,Reason} +%%% TargetName = ct:target_name() +%%% Address = term() +%%% Callback = atom() +%%% Handle = term +%%% +%%% @doc Register a new connection (tool-internal use only). +%%% +%%% <p>This function can be called when a new connection is +%%% established. The connection data is stored in the connection +%%% table, and ct_util will close all registered connections when the +%%% test is finished by calling <code>Callback:close/1</code>.</p> +register_connection(TargetName,Address,Callback,Handle) -> + TargetRef = + case get_ref_from_name(TargetName) of + {ok,Ref} -> + Ref; + _ -> + %% no config name associated with connection, + %% use handle for identification instead + Handle + end, + ets:insert(?conn_table,#conn{handle=Handle, + targetref=TargetRef, + address=Address, + callback=Callback}), + ok. + +%%%----------------------------------------------------------------- +%%% @spec unregister_connection(Handle) -> ok +%%% Handle = term +%%% +%%% @doc Unregister a connection (tool-internal use only). +%%% +%%% <p>This function should be called when a registered connection is +%%% closed. It removes the connection data from the connection +%%% table.</p> +unregister_connection(Handle) -> + ets:delete(?conn_table,Handle), + ok. + + +%%%----------------------------------------------------------------- +%%% @spec does_connection_exist(TargetName,Address,Callback) -> +%%% {ok,Handle} | false +%%% TargetName = ct:target_name() +%%% Address = address +%%% Callback = atom() +%%% Handle = term() +%%% +%%% @doc Check if a connection already exists. +does_connection_exist(TargetName,Address,Callback) -> + case get_ref_from_name(TargetName) of + {ok,TargetRef} -> + case ets:select(?conn_table,[{#conn{handle='$1', + targetref=TargetRef, + address=Address, + callback=Callback}, + [], + ['$1']}]) of + [Handle] -> + {ok,Handle}; + [] -> + false + end; + _ -> + false + end. + +%%%----------------------------------------------------------------- +%%% @spec get_connections(TargetName,Callback) -> +%%% {ok,Connections} | {error,Reason} +%%% TargetName = ct:target_name() +%%% Callback = atom() +%%% Connections = [Connection] +%%% Connection = {Handle,Address} +%%% Handle = term() +%%% Address = term() +%%% +%%% @doc Return all connections for the <code>Callback</code> on the +%%% given target (<code>TargetName</code>). +get_connections(TargetName,Callback) -> + case get_ref_from_name(TargetName) of + {ok,Ref} -> + {ok,ets:select(?conn_table,[{#conn{handle='$1', + address='$2', + targetref=Ref, + callback=Callback}, + [], + [{{'$1','$2'}}]}])}; + Error -> + Error + end. + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:get_target_name/1 +get_target_name(ConnPid) -> + case ets:select(?conn_table,[{#conn{handle=ConnPid,targetref='$1',_='_'}, + [], + ['$1']}]) of + [TargetRef] -> + get_name_from_ref(TargetRef); + [] -> + {error,{unknown_connection,ConnPid}} + end. + + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:require/1 +require(Key) when is_atom(Key) -> + require({Key,[]}); +require({Key,SubKeys}) when is_atom(Key) -> + allocate('_UNDEF',Key,to_list(SubKeys)); +require(Key) -> + {error,{invalid,Key}}. + + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:require/2 +require(Name,Key) when is_atom(Key) -> + require(Name,{Key,[]}); +require(Name,{Key,SubKeys}) when is_atom(Name), is_atom(Key) -> + call({require,Name,Key,to_list(SubKeys)}); +require(Name,Keys) -> + {error,{invalid,{Name,Keys}}}. + +to_list(X) when is_list(X) -> X; +to_list(X) -> [X]. + +do_require(Name,Key,SubKeys) when is_list(SubKeys) -> + case get_key_from_name(Name) of + {error,_} -> + allocate(Name,Key,SubKeys); + {ok,Key} -> + %% already allocated - check that it has all required subkeys + Vals = [Val || {_Ref,Val} <- lookup_name(Name)], + case get_subconfig(SubKeys,Vals) of + {ok,_SubMapped} -> + ok; + Error -> + Error + end; + {ok,OtherKey} -> + {error,{name_in_use,Name,OtherKey}} + end. + +allocate(Name,Key,SubKeys) -> + case ets:match_object(?attr_table,#ct_conf{key=Key,name='_UNDEF',_='_'}) of + [] -> + {error,{not_available,Key}}; + Available -> + case allocate_subconfig(Name,SubKeys,Available,false) of + ok -> + ok; + Error -> + Error + end + end. + +allocate_subconfig(Name,SubKeys,[C=#ct_conf{value=Value}|Rest],Found) -> + case do_get_config(SubKeys,Value,[]) of + {ok,_SubMapped} -> + ets:insert(?attr_table,C#ct_conf{name=Name}), + allocate_subconfig(Name,SubKeys,Rest,true); + _Error -> + allocate_subconfig(Name,SubKeys,Rest,Found) + end; +allocate_subconfig(_Name,_SubKeys,[],true) -> + ok; +allocate_subconfig(_Name,SubKeys,[],false) -> + {error,{not_available,SubKeys}}. + + + + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:get_config/1 +get_config(KeyOrName) -> + get_config(KeyOrName,undefined,[]). + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:get_config/2 +get_config(KeyOrName,Default) -> + get_config(KeyOrName,Default,[]). + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:get_config/3 +get_config(KeyOrName,Default,Opts) when is_atom(KeyOrName) -> + case lookup_config(KeyOrName) of + [] -> + Default; + [{_Ref,Val}|_] = Vals -> + case {lists:member(all,Opts),lists:member(element,Opts)} of + {true,true} -> + [{KeyOrName,V} || {_R,V} <- lists:sort(Vals)]; + {true,false} -> + [V || {_R,V} <- lists:sort(Vals)]; + {false,true} -> + {KeyOrName,Val}; + {false,false} -> + Val + end + end; + +get_config({KeyOrName,SubKey},Default,Opts) -> + case lookup_config(KeyOrName) of + [] -> + Default; + Vals -> + Vals1 = case [Val || {_Ref,Val} <- lists:sort(Vals)] of + Result=[L|_] when is_list(L) -> + case L of + [{_,_}|_] -> + Result; + _ -> + [] + end; + _ -> + [] + end, + case get_subconfig([SubKey],Vals1,[],Opts) of + {ok,[{_,SubVal}|_]=SubVals} -> + case {lists:member(all,Opts),lists:member(element,Opts)} of + {true,true} -> + [{{KeyOrName,SubKey},Val} || {_,Val} <- SubVals]; + {true,false} -> + [Val || {_SubKey,Val} <- SubVals]; + {false,true} -> + {{KeyOrName,SubKey},SubVal}; + {false,false} -> + SubVal + end; + _ -> + Default + end + end. + + +get_subconfig(SubKeys,Values) -> + get_subconfig(SubKeys,Values,[],[]). + +get_subconfig(SubKeys,[Value|Rest],Mapped,Opts) -> + case do_get_config(SubKeys,Value,[]) of + {ok,SubMapped} -> + case lists:member(all,Opts) of + true -> + get_subconfig(SubKeys,Rest,Mapped++SubMapped,Opts); + false -> + {ok,SubMapped} + end; + _Error -> + get_subconfig(SubKeys,Rest,Mapped,Opts) + end; +get_subconfig(SubKeys,[],[],_) -> + {error,{not_available,SubKeys}}; +get_subconfig(_SubKeys,[],Mapped,_) -> + {ok,Mapped}. + +do_get_config([Key|Required],Available,Mapped) -> + case lists:keysearch(Key,1,Available) of + {value,{Key,Value}} -> + NewAvailable = lists:keydelete(Key,1,Available), + NewMapped = [{Key,Value}|Mapped], + do_get_config(Required,NewAvailable,NewMapped); + false -> + {error,{not_available,Key}} + end; +do_get_config([],_Available,Mapped) -> + {ok,lists:reverse(Mapped)}. + +get_all_config() -> + ets:select(?attr_table,[{#ct_conf{name='$1',key='$2',value='$3', + default='$4',_='_'}, + [], + [{{'$1','$2','$3','$4'}}]}]). + +lookup_config(KeyOrName) -> + case lookup_name(KeyOrName) of + [] -> + lookup_key(KeyOrName); + Values -> + Values + end. + +lookup_name(Name) -> + ets:select(?attr_table,[{#ct_conf{ref='$1',value='$2',name=Name,_='_'}, + [], + [{{'$1','$2'}}]}]). +lookup_key(Key) -> + ets:select(?attr_table,[{#ct_conf{key=Key,ref='$1',value='$2',name='_UNDEF',_='_'}, + [], + [{{'$1','$2'}}]}]). + +set_config(Config) -> + set_config('_UNDEF',Config,false). + +set_config(Config,Default) -> + set_config('_UNDEF',Config,Default). + +set_config(Name,Config,Default) -> + [ets:insert(?attr_table, + #ct_conf{key=Key,value=Val,ref=ct_make_ref(), + name=Name,default=Default}) || + {Key,Val} <- Config]. + +delete_config(Default) -> + ets:match_delete(?attr_table,#ct_conf{default=Default,_='_'}), + ok. + + +%%%----------------------------------------------------------------- +%%% @spec release_allocated() -> ok +%%% +%%% @doc Release all allocated resources, but don't take down any +%%% connections. +release_allocated() -> + Allocated = ets:select(?attr_table,[{#ct_conf{name='$1',_='_'}, + [{'=/=','$1','_UNDEF'}], + ['$_']}]), + release_allocated(Allocated). +release_allocated([H|T]) -> + ets:delete_object(?attr_table,H), + ets:insert(?attr_table,H#ct_conf{name='_UNDEF'}), + release_allocated(T); +release_allocated([]) -> + ok. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +update_conf(Name, NewConfig) -> + Old = ets:select(?attr_table,[{#ct_conf{name=Name,_='_'},[],['$_']}]), + lists:foreach(fun(OldElem) -> + NewElem = OldElem#ct_conf{value=NewConfig}, + ets:delete_object(?attr_table, OldElem), + ets:insert(?attr_table, NewElem) + end, Old), + ok. + +%%%----------------------------------------------------------------- +%%% @spec close_connections() -> ok +%%% +%%% @doc Close all open connections. +close_connections() -> + close_connections(ets:tab2list(?conn_table)), + ok. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +override_silence_all_connections() -> + Protocols = [telnet,ftp,rpc,snmp], + override_silence_connections(Protocols), + Protocols. + +override_silence_connections(Conns) when is_list(Conns) -> + Conns1 = lists:map(fun({C,B}) -> {C,B}; + (C) -> {C,true} + end, Conns), + set_testdata({override_silent_connections,Conns1}). + +get_overridden_silenced_connections() -> + case get_testdata(override_silent_connections) of + {error,_} -> + undefined; + Conns -> % list() or undefined + Conns + end. + +delete_overridden_silenced_connections() -> + delete_testdata(override_silent_connections). + +silence_all_connections() -> + Protocols = [telnet,ftp,rpc,snmp], + silence_connections(Protocols), + Protocols. + +silence_connections(Conn) when is_tuple(Conn) -> + silence_connections([Conn]); +silence_connections(Conn) when is_atom(Conn) -> + silence_connections([{Conn,true}]); +silence_connections(Conns) when is_list(Conns) -> + Conns1 = lists:map(fun({C,B}) -> {C,B}; + (C) -> {C,true} + end, Conns), + set_testdata({silent_connections,Conns1}). + +is_silenced(Conn) -> + case get_testdata(silent_connections) of + Conns when is_list(Conns) -> + case lists:keysearch(Conn,1,Conns) of + {value,{Conn,true}} -> + true; + _ -> + false + end; + _ -> + false + end. + +reset_silent_connections() -> + delete_testdata(silent_connections). + + +%%%----------------------------------------------------------------- +%%% @spec stop(How) -> ok +%%% +%%% @doc Stop the ct_util_server and close all existing connections +%%% (tool-internal use only). +%%% +%%% @see ct +stop(How) -> + case whereis(ct_util_server) of + undefined -> ok; + _ -> call({stop,How}) + end. + +%%%----------------------------------------------------------------- +%%% @spec update_last_run_index() -> ok +%%% +%%% @doc Update <code>ct_run.<timestamp>/index.html</code> +%%% (tool-internal use only). +update_last_run_index() -> + call(update_last_run_index). + + +%%%----------------------------------------------------------------- +%%% @spec get_mode() -> Mode +%%% Mode = normal | interactive +%%% +%%% @doc Return the current mode of the ct_util_server +%%% (tool-internal use only). +get_mode() -> + call(get_mode). + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:listenv/1 +listenv(Telnet) -> + case ct_telnet:send(Telnet,"listenv") of + ok -> + {ok,Data,_} = ct_telnet:expect(Telnet, + ["(^.+)=(.*$)"], + [{timeout,seconds(3)}, + repeat]), + {ok,[{Name,Val} || [_,Name,Val] <- Data]}; + {error,Reason} -> + {error,{could_not_send_command,Telnet,"listenv",Reason}} + end. + +%%%----------------------------------------------------------------- +%%% @hidden +%%% @equiv ct:parse_table/1 +parse_table(Data) -> + [Heading|Lines]= + [remove_space(string:tokens(L, "|"),[]) || L <- Data, hd(L)==$|], + {Heading,Lines}. + +remove_space([Str|Rest],Acc) -> + remove_space(Rest,[string:strip(string:strip(Str),both,$')|Acc]); +remove_space([],Acc) -> + list_to_tuple(lists:reverse(Acc)). + + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +is_test_dir(Dir) -> + lists:last(string:tokens(filename:basename(Dir), "_")) == "test". + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +get_testdir(Dir, all) -> + Abs = abs_name(Dir), + case is_test_dir(Abs) of + true -> + Abs; + false -> + AbsTest = filename:join(Abs, "test"), + case filelib:is_dir(AbsTest) of + true -> AbsTest; + false -> Abs + end + end; + +get_testdir(Dir, [Suite | _]) when is_atom(Suite) -> + get_testdir(Dir, atom_to_list(Suite)); + +get_testdir(Dir, [Suite | _]) when is_list(Suite) -> + get_testdir(Dir, Suite); + +get_testdir(Dir, Suite) when is_atom(Suite) -> + get_testdir(Dir, atom_to_list(Suite)); + +get_testdir(Dir, Suite) when is_list(Suite) -> + Abs = abs_name(Dir), + case is_test_dir(Abs) of + true -> + Abs; + false -> + AbsTest = filename:join(Abs, "test"), + Mod = case filename:extension(Suite) of + ".erl" -> Suite; + _ -> Suite ++ ".erl" + end, + case filelib:is_file(filename:join(AbsTest, Mod)) of + true -> AbsTest; + false -> Abs + end + end; + +get_testdir(Dir, _) -> + get_testdir(Dir, all). + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +encrypt_config_file(SrcFileName, EncryptFileName) -> + case get_crypt_key_from_file() of + {error,_} = E -> + E; + Key -> + encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) + end. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +encrypt_config_file(SrcFileName, EncryptFileName, {file,KeyFile}) -> + case get_crypt_key_from_file(KeyFile) of + {error,_} = E -> + E; + Key -> + encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) + end; + +encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> + crypto:start(), + {K1,K2,K3,IVec} = make_crypto_key(Key), + case file:read_file(SrcFileName) of + {ok,Bin0} -> + Bin1 = term_to_binary({SrcFileName,Bin0}), + Bin2 = case byte_size(Bin1) rem 8 of + 0 -> Bin1; + N -> list_to_binary([Bin1,random_bytes(8-N)]) + end, + EncBin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin2), + case file:write_file(EncryptFileName, EncBin) of + ok -> + io:format("~s --(encrypt)--> ~s~n", + [SrcFileName,EncryptFileName]), + ok; + {error,Reason} -> + {error,{Reason,EncryptFileName}} + end; + {error,Reason} -> + {error,{Reason,SrcFileName}} + end. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +decrypt_config_file(EncryptFileName, TargetFileName) -> + case get_crypt_key_from_file() of + {error,_} = E -> + E; + Key -> + decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) + end. + + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +decrypt_config_file(EncryptFileName, TargetFileName, {file,KeyFile}) -> + case get_crypt_key_from_file(KeyFile) of + {error,_} = E -> + E; + Key -> + decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) + end; + +decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> + crypto:start(), + {K1,K2,K3,IVec} = make_crypto_key(Key), + case file:read_file(EncryptFileName) of + {ok,Bin} -> + DecBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), + case catch binary_to_term(DecBin) of + {'EXIT',_} -> + {error,bad_file}; + {_SrcFile,SrcBin} -> + case TargetFileName of + undefined -> + {ok,SrcBin}; + _ -> + case file:write_file(TargetFileName, SrcBin) of + ok -> + io:format("~s --(decrypt)--> ~s~n", + [EncryptFileName,TargetFileName]), + ok; + {error,Reason} -> + {error,{Reason,TargetFileName}} + end + end + end; + {error,Reason} -> + {error,{Reason,EncryptFileName}} + end. + + +get_crypt_key_from_file(File) -> + case file:read_file(File) of + {ok,Bin} -> + case catch string:tokens(binary_to_list(Bin), [$\n,$\r]) of + [Key] -> + Key; + _ -> + {error,{bad_crypt_file,File}} + end; + {error,Reason} -> + {error,{Reason,File}} + end. + +get_crypt_key_from_file() -> + CwdFile = filename:join(".",?cryptfile), + {Result,FullName} = + case file:read_file(CwdFile) of + {ok,Bin} -> + {Bin,CwdFile}; + _ -> + case init:get_argument(home) of + {ok,[[Home]]} -> + HomeFile = filename:join(Home,?cryptfile), + case file:read_file(HomeFile) of + {ok,Bin} -> + {Bin,HomeFile}; + _ -> + {{error,no_crypt_file},noent} + end; + _ -> + {{error,no_crypt_file},noent} + end + end, + case FullName of + noent -> + Result; + _ -> + case catch string:tokens(binary_to_list(Result), [$\n,$\r]) of + [Key] -> + io:format("~nCrypt key file: ~s~n", [FullName]), + Key; + _ -> + {error,{bad_crypt_file,FullName}} + end + end. + +make_crypto_key(String) -> + <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), + <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|lists:reverse(String)]), + {K1,K2,K3,IVec}. + +random_bytes(N) -> + {A,B,C} = now(), + random:seed(A, B, C), + random_bytes_1(N, []). + +random_bytes_1(0, Acc) -> Acc; +random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). + + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +get_attached(TCPid) -> + case dbg_iserver:safe_call({get_attpid,TCPid}) of + {ok,AttPid} when is_pid(AttPid) -> + AttPid; + _ -> + undefined + end. + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +kill_attached(undefined,_AttPid) -> + ok; +kill_attached(_TCPid,undefined) -> + ok; +kill_attached(TCPid,AttPid) -> + case process_info(TCPid) of + undefined -> + exit(AttPid,kill); + _ -> + ok + end. + + +%%%----------------------------------------------------------------- +%%% @spec +%%% +%%% @doc +warn_duplicates(Suites) -> + Warn = + fun(Mod) -> + case catch apply(Mod,sequences,[]) of + {'EXIT',_} -> + ok; + [] -> + ok; + _ -> + io:format(user,"~nWARNING! Deprecated function: ~w:sequences/0.~n" + " Use group with sequence property instead.~n",[Mod]) + end + end, + lists:foreach(Warn, Suites), + ok. + + +%%%----------------------------------------------------------------- +%%% Internal functions +call(Msg) -> + MRef = erlang:monitor(process,whereis(ct_util_server)), + Ref = make_ref(), + ct_util_server ! {Msg,{self(),Ref}}, + receive + {Ref, Result} -> + erlang:demonitor(MRef), + Result; + {'DOWN',MRef,process,_,Reason} -> + {error,{ct_util_server_down,Reason}} + end. + +return({To,Ref},Result) -> + To ! {Ref, Result}. + +seconds(T) -> + test_server:seconds(T). + +ct_make_ref() -> + Pid = case whereis(ct_make_ref) of + undefined -> + spawn_link(fun() -> ct_make_ref_init() end); + P -> + P + end, + Pid ! {self(),ref_req}, + receive + {Pid,Ref} -> Ref + end. + +ct_make_ref_init() -> + register(ct_make_ref,self()), + ct_make_ref_loop(0). + +ct_make_ref_loop(N) -> + receive + {From,ref_req} -> + From ! {self(),N}, + ct_make_ref_loop(N+1) + end. + +get_ref_from_name(Name) -> + case ets:select(?attr_table,[{#ct_conf{name=Name,ref='$1',_='_'}, + [], + ['$1']}]) of + [Ref] -> + {ok,Ref}; + _ -> + {error,{no_such_name,Name}} + end. + +get_name_from_ref(Ref) -> + case ets:select(?attr_table,[{#ct_conf{name='$1',ref=Ref,_='_'}, + [], + ['$1']}]) of + [Name] -> + {ok,Name}; + _ -> + {error,{no_such_ref,Ref}} + end. + +get_key_from_name(Name) -> + case ets:select(?attr_table,[{#ct_conf{name=Name,key='$1',_='_'}, + [], + ['$1']}]) of + [Key|_] -> + {ok,Key}; + _ -> + {error,{no_such_name,Name}} + end. + + +abs_name(Dir0) -> + Abs = filename:absname(Dir0), + Dir = case lists:reverse(Abs) of + [$/|Rest] -> lists:reverse(Rest); + _ -> Abs + end, + abs_name1(Dir,[]). + +abs_name1([Drv,$:,$/],Acc) -> + Split = [[Drv,$:,$/]|Acc], + abs_name2(Split,[]); +abs_name1("/",Acc) -> + Split = ["/"|Acc], + abs_name2(Split,[]); +abs_name1(Dir,Acc) -> + abs_name1(filename:dirname(Dir),[filename:basename(Dir)|Acc]). + +abs_name2([".."|T],[_|Acc]) -> + abs_name2(T,Acc); +abs_name2(["."|T],Acc) -> + abs_name2(T,Acc); +abs_name2([H|T],Acc) -> + abs_name2(T,[H|Acc]); +abs_name2([],Acc) -> + filename:join(lists:reverse(Acc)). |