%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2003-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. %% %% %CopyrightEnd% %% %%% @doc Common Test Framework Utilities. %%% %%%
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.
%%% -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([close_connections/0]). -export([save_suite_data/3, save_suite_data/2, 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, 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([get_mode/0, create_table/3, read_opts/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([kill_attached/2, get_attached/1, ct_make_ref/0]). -export([warn_duplicates/1]). -include("ct_event.hrl"). -include("ct_util.hrl"). -record(suite_data, {key,name,value}). %%%----------------------------------------------------------------- %%% @spec start(Mode) -> Pid | exit(Error) %%% Mode = normal | interactive %%% Pid = pid() %%% %%% @doc Start start the ct_util_server process %%% (tool-internal use only). %%% %%%This function is called from ct_run.erl. It starts and initiates
%%% the ct_util_server
Returns the process identity of the
%%% ct_util_server.
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 Callback:close/1.
This function should be called when a registered connection is %%% closed. It removes the connection data from the connection %%% table.
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 ct_config: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 theCallback on the
%%% given target (TargetName).
get_connections(TargetName,Callback) ->
    case ct_config: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] ->
	    ct_config:get_name_from_ref(TargetRef);
	[] ->
	    {error,{unknown_connection,ConnPid}}
    end.
%%%-----------------------------------------------------------------
%%% @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 ct_run.<timestamp>/index.html 
%%% (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, Rest} = get_headings(Data),
    Lines = parse_row(Rest,[],size(Heading)),
    {Heading,Lines}.
get_headings(["|" ++ Headings | Rest]) ->
    {remove_space(string:tokens(Headings, "|"),[]), Rest};
get_headings([_ | Rest]) ->
    get_headings(Rest);
get_headings([]) ->
    {{},[]}.
parse_row(["|" ++ _ = Row | T], Rows, NumCols) when NumCols > 1 ->
    case string:tokens(Row, "|") of
	Values when length(Values) =:= NumCols ->
	    parse_row(T,[remove_space(Values,[])|Rows], NumCols);
	Values when length(Values) < NumCols ->
	    parse_row([Row ++"\n"++ hd(T) | tl(T)], Rows, NumCols)
    end;
parse_row(["|" ++ _ = Row | T], Rows, 1 = NumCols) ->
    case string:rchr(Row, $|) of
	1 ->
	    parse_row([Row ++"\n"++hd(T) | tl(T)], Rows, NumCols);
	_Else ->
	    parse_row(T, [remove_space(string:tokens(Row,"|"),[])|Rows],
		      NumCols)
    end;
parse_row([_Skip | T], Rows, NumCols) ->
    parse_row(T, Rows, NumCols);
parse_row([], Rows, _NumCols) ->
    lists:reverse(Rows).
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
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, [flush]),
	    Result;
	{'DOWN',MRef,process,_,Reason}  -> 
	    {error,{ct_util_server_down,Reason}}
    end.
return({To,Ref},Result) ->
    To ! {Ref, Result}.
cast(Msg) ->
    ct_util_server ! {Msg, {ct_util_server, make_ref()}}.
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.
   
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)).