aboutsummaryrefslogblamecommitdiffstats
path: root/lib/test_server/src/test_server_sup.erl
blob: 7a1f7803eb7e7cd025b9731a42dee63bf470adc2 (plain) (tree)
1
2
3
4
5
6
7
8
9
10

                   
  
                                                        
  




                                                                      
  



                                                                         
  






                                                                      

                                                          



                                                                       
                                                            
                      
                                                  

                        


                                             
                                            

                                                  
                                        




                                                                

                                                               

                          
                                            

                                 


                                             
                                


                                                                       
                             
           
                    





                                                                        
                                                                






                                                                               
                                                              

                                                             
                                             




                                                            
                      







                                                  



                                             





                                              
 







                                   







                                    
                    

                                       















                                                   
                                                                                


                                                  
                                                                                



















































































































                                                                             










































































































































































































                                                                                 
                                






































                                                                               
















































                                                                 
                                                                    







                                                
                                                                    






















































                                                                           
                                                                      






                                           
                                                                             










                                                                                 
                                                                               

                 
                                                          




                                   
                                              




                                                                     
                                                            





















































                                                                       

                                   































                                                                             

                                              








                                                           
                                                                       






                                             
                                                                   


                        










                                                      

















                                                               
                                        
                  
                              





                                                                            
                               


                                                         



                                                                         
            
                                                       

        







                                                      
                                                  












































                                                                      

                                                   














                                                                   





































                                                                                          
%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1998-2014. 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%
%%

%%%-------------------------------------------------------------------
%%% Purpose: Test server support functions.
%%%-------------------------------------------------------------------
-module(test_server_sup).
-export([timetrap/2, timetrap/3, timetrap/4,
	 timetrap_cancel/1, capture_get/1, messages_get/1,
	 timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0,
	 cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
	 get_username/0, get_os_family/0, 
	 hostatom/0, hostatom/1, hoststr/0, hoststr/1,
	 framework_call/2,framework_call/3,framework_call/4,
	 format_loc/1,
	 util_start/0, util_stop/0, unique_name/0,
	 call_trace/1,
	 appup_test/1]).
-include("test_server_internal.hrl").
-define(crash_dump_tar,"crash_dumps.tar.gz").
-define(src_listing_ext, ".src.html").
-record(util_state, {starter, latest_name}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap(Timeout,Scale,Pid) -> Handle
%% Handle = term()
%%
%% Creates a time trap, that will kill the given process if the 
%% trap is not cancelled with timetrap_cancel/1, within Timeout
%% milliseconds.
%% Scale says if the time should be scaled up to compensate for
%% delays during the test (e.g. if cover is running).

timetrap(Timeout0, Pid) ->
    timetrap(Timeout0, Timeout0, true, Pid).

timetrap(Timeout0, Scale, Pid) ->
    timetrap(Timeout0, Timeout0, Scale, Pid).

timetrap(Timeout0, ReportTVal, Scale, Pid) ->
    process_flag(priority, max),
    Timeout = if not Scale -> Timeout0;
		 true -> test_server:timetrap_scale_factor() * Timeout0
	      end,
    TruncTO = trunc(Timeout),
    receive
    after TruncTO ->
	    case is_process_alive(Pid) of
		true ->
		    TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
				      true -> ReportTVal end,
		    MFLs = test_server:get_loc(Pid),
		    Mon = erlang:monitor(process, Pid),
		    Trap = {timetrap_timeout,TimeToReport,MFLs},
		    exit(Pid, Trap),
		    receive
			{'DOWN', Mon, process, Pid, _} ->
			    ok
		    after 10000 ->
			    %% Pid is probably trapping exits, hit it harder...
			    catch error_logger:warning_msg(
				    "Testcase process ~w not "
				    "responding to timetrap "
				    "timeout:~n"
				    "  ~p.~n"
				    "Killing testcase...~n",
				    [Pid, Trap]),
			    exit(Pid, kill)
		    end;
		false ->
		    ok
	    end
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
%% Handle = term()
%%
%% Cancels a time trap.
timetrap_cancel(Handle) ->
    unlink(Handle),
    MonRef = erlang:monitor(process, Handle),
    exit(Handle, kill),
    receive {'DOWN',MonRef,_,_,_} -> ok
    after
	2000 ->
	    erlang:demonitor(MonRef, [flush]),
	    ok
    end.

capture_get(Msgs) ->
    receive
	{captured,Msg} ->
	    capture_get([Msg|Msgs])
    after 0 ->
	    lists:reverse(Msgs)
    end.

messages_get(Msgs) ->
    receive
	Msg ->
	    messages_get([Msg|Msgs])
    after 0 ->
	    lists:reverse(Msgs)
    end.

timecall(M, F, A) ->
    {Elapsed, Val} = timer:tc(M, F, A),
    {Elapsed / 1000000, Val}.


call_crash(Time,Crash,M,F,A) ->
    OldTrapExit = process_flag(trap_exit,true),
    Pid = spawn_link(M,F,A),
    Answer =
	receive
	    {'EXIT',Crash} ->
		ok;
	    {'EXIT',Pid,Crash} ->
		ok;
	    {'EXIT',_Reason} when Crash==any ->
		ok;
	    {'EXIT',Pid,_Reason} when Crash==any ->
		ok;
	    {'EXIT',Reason} ->
		test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
		      [Crash, Reason]),
		exit({wrong_crash_reason,Reason});
	    {'EXIT',Pid,Reason} ->
		test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
		      [Crash, Reason]),
		exit({wrong_crash_reason,Reason});
	    {'EXIT',OtherPid,Reason} when OldTrapExit == false ->
		exit({'EXIT',OtherPid,Reason})
	after do_trunc(Time) ->
		exit(call_crash_timeout)
	end,
    process_flag(trap_exit,OldTrapExit),
    Answer.

do_trunc(infinity) -> infinity;
do_trunc(T) -> trunc(T).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% app_test/2
%%
%% Checks one applications .app file for obvious errors.
%% Checks..
%% * .. required fields
%% * .. that all modules specified actually exists
%% * .. that all requires applications exists
%% * .. that no module included in the application has export_all
%% * .. that all modules in the ebin/ dir is included
%%      (This only produce a warning, as all modules does not
%%       have to be included (If the `pedantic' option isn't used))
app_test(Application, Mode) ->
    case is_app(Application) of
	{ok, AppFile} ->
	    do_app_tests(AppFile, Application, Mode);
	Error ->
	    test_server:fail(Error)
    end.

is_app(Application) ->
    case file:consult(filename:join([code:lib_dir(Application),"ebin",
		   atom_to_list(Application)++".app"])) of
	{ok, [{application, Application, AppFile}] } ->
	    {ok, AppFile};
	_ ->
	    test_server:format(minor,
			       "Application (.app) file not found, "
			       "or it has very bad syntax.~n"),
	    {error, not_an_application}
    end.


do_app_tests(AppFile, AppName, Mode) ->
    DictList=
	[
	 {missing_fields, []},
	 {missing_mods, []},
	 {superfluous_mods_in_ebin, []},
	 {export_all_mods, []},
	 {missing_apps, []}
	],
    fill_dictionary(DictList),

    %% An appfile must (?) have some fields..
    check_fields([description, modules, registered, applications], AppFile),

    %% Check for missing and extra modules.
    {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile),
    EBinList=lists:sort(get_ebin_modnames(AppName)),
    {Missing, Extra} = common(lists:sort(Mods), EBinList),
    put(superfluous_mods_in_ebin, Extra),
    put(missing_mods, Missing),

    %% Check that no modules in the application has export_all.
    app_check_export_all(Mods),

    %% Check that all specified applications exists.
    {value, {applications, Apps}}=
	lists:keysearch(applications, 1, AppFile),
    check_apps(Apps),

    A=check_dict(missing_fields, "Inconsistent app file, "
	       "missing fields"),
    B=check_dict(missing_mods, "Inconsistent app file, "
	       "missing modules"),
    C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, "
	       "Modules not included in app file.", Mode),
    D=check_dict(export_all_mods, "Inconsistent app file, "
	       "Modules have `export_all'."),
    E=check_dict(missing_apps, "Inconsistent app file, "
	       "missing applications."),

    erase_dictionary(DictList),
    case A+B+C+D+E of
	5 ->
	    ok;
	_ ->
	    test_server:fail()
    end.

app_check_export_all([]) ->
    ok;
app_check_export_all([Mod|Mods]) ->
    case catch apply(Mod, module_info, [compile]) of
	{'EXIT', {undef,_}} ->
	    app_check_export_all(Mods);
	COpts ->
	    case lists:keysearch(options, 1, COpts) of
		false ->
		    app_check_export_all(Mods);
		{value, {options, List}} ->
		    case lists:member(export_all, List) of
			true ->
			    put(export_all_mods, [Mod|get(export_all_mods)]),
			    app_check_export_all(Mods);
			false ->
			    app_check_export_all(Mods)
		    end
	    end
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% appup_test/1
%%
%% Checks one applications .appup file for obvious errors.
%% Checks..
%% * .. syntax
%% * .. that version in app file matches appup file version
%% * .. validity of appup instructions
%%
%% For library application this function checks that the proper
%% 'restart_application' upgrade and downgrade clauses exist.
appup_test(Application) ->
    case is_app(Application) of
        {ok, AppFile} ->
            case is_appup(Application, proplists:get_value(vsn, AppFile)) of
                {ok, Up, Down} ->
                    StartMod = proplists:get_value(mod, AppFile),
                    Modules = proplists:get_value(modules, AppFile),
                    do_appup_tests(StartMod, Application, Up, Down, Modules);
                Error ->
                    test_server:fail(Error)
            end;
        Error ->
            test_server:fail(Error)
    end.

is_appup(Application, Version) ->
    AppupFile = atom_to_list(Application) ++ ".appup",
    AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]),
    case file:consult(AppupPath) of
        {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) ->
            {ok, Up, Down};
        _ ->
            test_server:format(
              minor,
              "Application upgrade (.appup) file not found, "
              "or it has very bad syntax.~n"),
            {error, appup_not_readable}
    end.

do_appup_tests(undefined, Application, Up, Down, _Modules) ->
    %% library application
    case Up of
        [{<<".*">>, [{restart_application, Application}]}] ->
            case Down of
                [{<<".*">>, [{restart_application, Application}]}] ->
                    ok;
                _ ->
                    test_server:format(
                      minor,
                      "Library application needs restart_application "
                      "downgrade instruction.~n"),
                    {error, library_downgrade_instruction_malformed}
            end;
        _ ->
            test_server:format(
              minor,
              "Library application needs restart_application "
              "upgrade instruction.~n"),
            {error, library_upgrade_instruction_malformed}
    end;
do_appup_tests(_, _Application, Up, Down, Modules) ->
    %% normal application
    case check_appup_clauses_plausible(Up, up, Modules) of
        ok ->
            case check_appup_clauses_plausible(Down, down, Modules) of
                ok ->
                    test_server:format(minor, "OK~n");
                Error ->
                    test_server:format(minor, "ERROR ~p~n", [Error]),
                    test_server:fail(Error)
            end;
        Error ->
            test_server:format(minor, "ERROR ~p~n", [Error]),
            test_server:fail(Error)
    end.
    
check_appup_clauses_plausible([], _Direction, _Modules) ->
    ok;
check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules)
  when is_binary(Re) ->
    case re:compile(Re) of
        {ok, _} ->
            case check_appup_instructions(Instrs, Direction, Modules) of
                ok ->
                    check_appup_clauses_plausible(Rest, Direction, Modules);
                Error ->
                    Error
            end;
        {error, Error} ->
            {error, {version_regex_malformed, Re, Error}}
    end;
check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules)
  when is_list(V) ->
    case check_appup_instructions(Instrs, Direction, Modules) of
        ok ->
            check_appup_clauses_plausible(Rest, Direction, Modules);
        Error ->
            Error
    end;
check_appup_clauses_plausible(Clause, _Direction, _Modules) ->
    {error, {clause_malformed, Clause}}.

check_appup_instructions(Instrs, Direction, Modules) ->
    case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of
        {_Good, []} ->
            ok;
        {_, Bad} ->
            {error, {bad_instructions, Bad}}
    end.

check_instructions(_, [], _, Good, Bad, _) ->
    {lists:reverse(Good), lists:reverse(Bad)};
check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) ->
    case catch check_instruction(UpDown, Instr, All, Modules) of
        ok ->
            check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules);
        {error, Reason} ->
            NewBad = [{Instr, Reason} | Bad],
            check_instructions(UpDown, Rest, All, Good, NewBad, Modules)
    end.

check_instruction(up, {add_module, Module}, _, Modules) ->
    %% A new module is added
    check_module(Module, Modules);
check_instruction(down, {add_module, Module}, _, Modules) ->
    %% An old module is re-added
    case (catch check_module(Module, Modules)) of
        {error, {unknown_module, Module, Modules}} -> ok;
        ok -> throw({error, {existing_readded_module, Module}})
    end;
check_instruction(_, {load_module, Module}, _, Modules) ->
    check_module(Module, Modules);
check_instruction(_, {load_module, Module, DepMods}, _, Modules) ->
    check_module(Module, Modules),
    check_depend(DepMods);
check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) ->
    check_module(Module, Modules),
    check_depend(DepMods),
    check_purge(Pre),
    check_purge(Post);
check_instruction(up, {delete_module, Module}, _, Modules) ->
    case (catch check_module(Module, Modules)) of
        {error, {unknown_module, Module, Modules}} ->
            ok;
        ok ->
            throw({error,{existing_module_deleted, Module}})
    end;
check_instruction(down, {delete_module, Module}, _, Modules) ->
    check_module(Module, Modules);
check_instruction(_, {update, Module}, _, Modules) ->
    check_module(Module, Modules);
check_instruction(_, {update, Module, supervisor}, _, Modules) ->
    check_module(Module, Modules);
check_instruction(_, {update, Module, DepMods}, _, Modules)
  when is_list(DepMods) ->
    check_module(Module, Modules);
check_instruction(_, {update, Module, Change}, _, Modules) ->
    check_module(Module, Modules),
    check_change(Change);
check_instruction(_, {update, Module, Change, DepMods}, _, Modules) ->
    check_module(Module, Modules),
    check_change(Change),
    check_depend(DepMods);
check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) ->
    check_module(Module, Modules),
    check_change(Change),
    check_purge(Pre),
    check_purge(Post),
    check_depend(DepMods);
check_instruction(_,
                  {update, Module, Timeout, Change, Pre, Post, DepMods},
                  _,
                  Modules) ->
    check_module(Module, Modules),
    check_timeout(Timeout),
    check_change(Change),
    check_purge(Pre),
    check_purge(Post),
    check_depend(DepMods);
check_instruction(_,
                  {update, Module, ModType, Timeout, Change, Pre, Post, DepMods},
                  _,
                  Modules) ->
    check_module(Module, Modules),
    check_mod_type(ModType),
    check_timeout(Timeout),
    check_change(Change),
    check_purge(Pre),
    check_purge(Post),
    check_depend(DepMods);
check_instruction(_, {restart_application, Application}, _, _) ->
    check_application(Application);
check_instruction(_, {remove_application, Application}, _, _) ->
    check_application(Application);
check_instruction(_, {add_application, Application}, _, _) ->
    check_application(Application);
check_instruction(_, {add_application, Application, Type}, _, _) ->
    check_application(Application),
    check_restart_type(Type);
check_instruction(_, Instr, _, _) ->
    throw({error, {low_level_or_invalid_instruction, Instr}}).

check_module(Module, Modules) ->
    case {is_atom(Module), lists:member(Module, Modules)} of
        {true, true}  -> ok;
        {true, false} -> throw({error, {unknown_module, Module}});
        {false, _}    -> throw({error, {bad_module, Module}})
    end.

check_application(App) ->
    case is_atom(App) of
        true  -> ok;
        false -> throw({error, {bad_application, App}})
    end.

check_depend(Dep) when is_list(Dep) -> ok;
check_depend(Dep)                   -> throw({error, {bad_depend, Dep}}).

check_restart_type(permanent) -> ok;
check_restart_type(transient) -> ok;
check_restart_type(temporary) -> ok;
check_restart_type(load)      -> ok;
check_restart_type(none)      -> ok;
check_restart_type(Type)      -> throw({error, {bad_restart_type, Type}}).

check_timeout(T) when is_integer(T), T > 0 -> ok;
check_timeout(default)                     -> ok;
check_timeout(infinity)                    -> ok;
check_timeout(T)                           -> throw({error, {bad_timeout, T}}).

check_mod_type(static)  -> ok;
check_mod_type(dynamic) -> ok;
check_mod_type(Type)    -> throw({error, {bad_mod_type, Type}}).

check_purge(soft_purge)   -> ok;
check_purge(brutal_purge) -> ok;
check_purge(Purge)        -> throw({error, {bad_purge, Purge}}).

check_change(soft)          -> ok;
check_change({advanced, _}) -> ok;
check_change(Change)        -> throw({error, {bad_change, Change}}).

%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1},
%% NotInL2 is the elements of L1 which don't occurr in L2,
%% NotInL1 is the elements of L2 which don't ocurr in L1.

common(L1, L2) ->
    common(L1, L2, [], []).

common([X|Rest1], [X|Rest2], A1, A2) ->
    common(Rest1, Rest2, A1, A2);
common([X|Rest1], [Y|Rest2], A1, A2) when X < Y ->
    common(Rest1, [Y|Rest2], [X|A1], A2);
common([X|Rest1], [Y|Rest2], A1, A2) ->
    common([X|Rest1], Rest2, A1, [Y|A2]);
common([], L, A1, A2) ->
    {A1, L++A2};
common(L, [], A1, A2) ->
    {L++A1, A2}.

check_apps([]) ->
    ok;
check_apps([App|Apps]) ->
    case is_app(App) of
	{ok, _AppFile} ->
	    ok;
	{error, _} ->
	    put(missing_apps, [App|get(missing_apps)])
    end,
    check_apps(Apps).

check_fields([], _AppFile) ->
    ok;
check_fields([L|Ls], AppFile) ->
    check_field(L, AppFile),
    check_fields(Ls, AppFile).

check_field(FieldName, AppFile) ->
    case lists:keymember(FieldName, 1, AppFile) of
	true ->
	    ok;
	false ->
	    put(missing_fields, [FieldName|get(missing_fields)]),
	    ok
    end.

check_dict(Dict, Reason) ->
    case get(Dict) of
	[] ->
	    1;                         % All ok.
	List ->
	    io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
	    0
    end.

check_dict_tolerant(Dict, Reason, Mode) ->
    case get(Dict) of
	[] ->
	    1;                         % All ok.
	List ->
	    io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
	    case Mode of
		pedantic ->
		    0;
		_ ->
		    1
	    end
    end.

get_ebin_modnames(AppName) ->
    Wc=filename:join([code:lib_dir(AppName),"ebin",
		      "*"++code:objfile_extension()]),
    TheFun=fun(X, Acc) ->
		   [list_to_atom(filename:rootname(
				   filename:basename(X)))|Acc] end,
    _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)).

%%
%% This function removes any erl_crash_dump* files found in the
%% test server directory. Done only once when the test server
%% is started.
%%
cleanup_crash_dumps() ->
    Dir = crash_dump_dir(),
    Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
    delete_files(Dumps).

crash_dump_dir() ->
    filename:dirname(code:which(?MODULE)).

tar_crash_dumps() ->
    Dir = crash_dump_dir(),
    case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of
	[] -> {error,no_crash_dumps};
	Dumps ->
	    TarFileName = filename:join(Dir,?crash_dump_tar),
	    {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]),
	    lists:foreach(
	      fun(File) -> 
		      ok = erl_tar:add(Tar,File,filename:basename(File),[])
	      end,
	      Dumps),
	    ok = erl_tar:close(Tar),
	    delete_files(Dumps),
	    {ok,TarFileName}
    end.


check_new_crash_dumps() ->
    Dir = crash_dump_dir(),
    Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
    case length(Dumps) of
	0 ->
	    ok;
	Num ->
	    test_server_ctrl:format(minor,
				    "Found ~w crash dumps:~n", [Num]),
	    append_files_to_logfile(Dumps),
	    delete_files(Dumps)
    end.

append_files_to_logfile([]) -> ok;
append_files_to_logfile([File|Files]) ->
    NodeName=from($., File),
    test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]),
    Fd=get(test_server_minor_fd),
    case file:read_file(File) of
	{ok, Bin} ->
	    case file:write(Fd, Bin) of
		ok ->
		    ok;
		{error,Error} ->
		    %% Write failed. The following io:format/3 will probably also
		    %% fail, but in that case it will throw an exception so that
		    %% we will be aware of the problem.
		    io:format(Fd, "Unable to write the crash dump "
			      "to this file: ~p~n", [file:format_error(Error)])
	    end;
	_Error ->
	    io:format(Fd, "Failed to read: ~ts\n", [File])
    end,
    append_files_to_logfile(Files).

delete_files([]) -> ok;
delete_files([File|Files]) ->
    io:format("Deleting file: ~ts~n", [File]),
    case file:delete(File) of
	{error, _} ->
	    case file:rename(File, File++".old") of
		{error, Error} ->
		    io:format("Could neither delete nor rename file "
			      "~ts: ~ts.~n", [File, Error]);
		_ ->
		    ok
	    end;
	_ ->
	    ok
    end,
    delete_files(Files).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% erase_dictionary(Vars) -> ok
%% Vars = [atom(),...]
%%
%% Takes a list of dictionary keys, KeyVals, erases
%% each key and returns ok.
erase_dictionary([{Var, _Val}|Vars]) ->
    erase(Var),
    erase_dictionary(Vars);
erase_dictionary([]) ->
    ok.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% fill_dictionary(KeyVals) -> void()
%% KeyVals = [{atom(),term()},...]
%%
%% Takes each Key-Value pair, and inserts it in the process dictionary.
fill_dictionary([{Var,Val}|Vars]) ->
    put(Var,Val),
    fill_dictionary(Vars);
fill_dictionary([]) ->
    [].



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_username() -> UserName
%%
%% Returns the current user
get_username() ->
    getenv_any(["USER","USERNAME"]).
    
getenv_any([Key|Rest]) ->
    case catch os:getenv(Key) of
	String when is_list(String) -> String;
	false -> getenv_any(Rest)
    end;
getenv_any([]) -> "".


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% get_os_family() -> OsFamily
%%
%% Returns the OS family
get_os_family() ->
    {OsFamily,_OsName} = os:type(),
    OsFamily.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% hostatom()/hostatom(Node) -> Host; atom()
%% hoststr() | hoststr(Node) -> Host; string()
%%
%% Returns the OS family
hostatom() ->
    hostatom(node()).
hostatom(Node) ->
    list_to_atom(hoststr(Node)).
hoststr() ->
    hoststr(node()).
hoststr(Node) when is_atom(Node) ->
    hoststr(atom_to_list(Node));
hoststr(Node) when is_list(Node) ->
    from($@, Node).
    
from(H, [H | T]) -> T;
from(H, [_ | T]) -> from(H, T);
from(_H, []) -> [].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn
%% 
%% Calls the given Func in Callback
framework_call(Func,Args) ->
    framework_call(Func,Args,ok).
framework_call(Func,Args,DefaultReturn) ->
    CB = os:getenv("TEST_SERVER_FRAMEWORK"),
    framework_call(CB,Func,Args,DefaultReturn).
framework_call(FW,_Func,_Args,DefaultReturn)  
  when FW =:= false; FW =:= "undefined" ->
    DefaultReturn;
framework_call(Callback,Func,Args,DefaultReturn) ->
    Mod = list_to_atom(Callback),
    case code:is_loaded(Mod) of
	false -> code:load_file(Mod);
	_ -> ok
    end,
    case erlang:function_exported(Mod,Func,length(Args)) of
	true ->
	    EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end,
	    SetTcState = case Func of
			     end_tc -> true;
			     init_tc -> true;
			     _ -> false
			 end,
	    case SetTcState of
		true ->
		    test_server:set_tc_state({framework,Mod,Func});
		false ->
		    ok
	    end,
	    try apply(Mod,Func,Args) of
		Result ->
		    Result
	    catch
		exit:Why ->
		    EH(Why);
		error:Why ->
		    EH({Why,erlang:get_stacktrace()});
		throw:Why ->
		    EH(Why)
	    end;
	false ->
	    DefaultReturn
    end.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% format_loc(Loc) -> string()
%% 
%% Formats the printout of the line of code read from 
%% process dictionary (test_server_loc). Adds link to 
%% correct line in source code.
format_loc([{Mod,Func,Line}]) ->
    [format_loc1({Mod,Func,Line})];
format_loc([{Mod,Func,Line}|Rest]) ->
    ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
format_loc([{Mod,LineOrFunc}]) ->
    format_loc({Mod,LineOrFunc});
format_loc({Mod,Func}) when is_atom(Func) -> 
    io_lib:format("{~w,~w}",[Mod,Func]);
format_loc(Loc) ->
    io_lib:format("~p",[Loc]).

format_loc1([{Mod,Func,Line}]) ->
    ["              ",format_loc1({Mod,Func,Line}),"]"];
format_loc1([{Mod,Func,Line}|Rest]) ->
    ["              ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
format_loc1({Mod,Func,Line}) ->
    ModStr = atom_to_list(Mod),
    case {lists:member(no_src, get(test_server_logopts)),
	  lists:reverse(ModStr)} of
	{false,[$E,$T,$I,$U,$S,$_|_]}  ->
	    io_lib:format("{~w,~w,<a href=\"~ts~ts#~w\">~w</a>}",
			  [Mod,Func,
			   test_server_ctrl:uri_encode(downcase(ModStr)),
			   ?src_listing_ext,Line,Line]);
	_ ->
	    io_lib:format("{~w,~w,~w}",[Mod,Func,Line])
    end.

downcase(S) -> downcase(S, []).
downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
    downcase(Rest, [Uc-$A+$a|Result]);
downcase([C|Rest], Result) ->
    downcase(Rest, [C|Result]);
downcase([], Result) ->
    lists:reverse(Result).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% util_start() -> ok
%%
%% Start local utility process
util_start() ->
    Starter = self(),
    case whereis(?MODULE) of
	undefined ->	
	    spawn_link(fun() ->
			       register(?MODULE, self()),
			       util_loop(#util_state{starter=Starter})
		       end);
	_Pid ->
	    ok
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% util_stop() -> ok
%%
%% Stop local utility process
util_stop() ->
    try (?MODULE ! {self(),stop}) of
	_ ->
	    receive {?MODULE,stopped} -> ok
	    after 5000 -> exit(whereis(?MODULE), kill)
	    end
    catch
	_:_ ->
	    ok
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% unique_name() -> string()
%%
unique_name() ->
    ?MODULE ! {self(),unique_name},
    receive {?MODULE,Name} -> Name
    after 5000 -> exit({?MODULE,no_util_process})
    end.
	    
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% util_loop(State) -> ok
%%
util_loop(State) ->		       
    receive
	{From,unique_name} ->
	    Nr = erlang:unique_integer([positive]),
	    Name = integer_to_list(Nr),
	    if Name == State#util_state.latest_name ->
		    timer:sleep(1),
		    self() ! {From,unique_name},
		    util_loop(State);
	       true ->
		    From ! {?MODULE,Name},
		    util_loop(State#util_state{latest_name = Name})
	    end;
	{From,stop} ->
	    catch unlink(State#util_state.starter),
	    From ! {?MODULE,stopped},
	    ok
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% call_trace(TraceSpecFile) -> ok
%%
%% Read terms on format {m,Mod} | {f,Mod,Func}
%% from TraceSpecFile and enable call trace for
%% specified functions.
call_trace(TraceSpec) ->
    case catch try_call_trace(TraceSpec) of
	{'EXIT',Reason} ->
	    erlang:display(Reason),
	    exit(Reason);
	Ok ->
	    Ok
    end.    

try_call_trace(TraceSpec) ->
    case file:consult(TraceSpec) of
	{ok,Terms} ->
	    dbg:tracer(),
	    %% dbg:p(self(), [p, m, sos, call]),
	    dbg:p(self(), [sos, call]),
	    lists:foreach(fun({m,M}) ->
				  case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of
				      {error,What} -> exit({error,{tracing_failed,What}});
				      _ -> ok
				  end;			  
			     ({f,M,F}) ->
				  case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of
				      {error,What} -> exit({error,{tracing_failed,What}});
				      _ -> ok
				  end;			  
			     (Huh) ->
				  exit({error,{unrecognized_trace_term,Huh}})
			  end, Terms),
	    ok;
	{_,Error} ->
	    exit({error,{tracing_failed,TraceSpec,Error}})
    end.