1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%%-------------------------------------------------------------------
22%%% Purpose: Test server support functions.
23%%%-------------------------------------------------------------------
24-module(test_server_sup).
25-export([timetrap/2, timetrap/3, timetrap/4,
26	 timetrap_cancel/1, capture_get/1, messages_get/1,
27	 timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0,
28	 cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
29	 get_username/0, get_os_family/0,
30	 hostatom/0, hostatom/1, hoststr/0, hoststr/1,
31	 framework_call/2,framework_call/3,framework_call/4,
32	 format_loc/1,
33	 util_start/0, util_stop/0, unique_name/0,
34	 call_trace/1,
35	 appup_test/1]).
36-include("test_server_internal.hrl").
37-define(crash_dump_tar,"crash_dumps.tar.gz").
38-define(src_listing_ext, ".src.html").
39-record(util_state, {starter, latest_name}).
40
41%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
42%% timetrap(Timeout,Scale,Pid) -> Handle
43%% Handle = term()
44%%
45%% Creates a time trap, that will kill the given process if the
46%% trap is not cancelled with timetrap_cancel/1, within Timeout
47%% milliseconds.
48%% Scale says if the time should be scaled up to compensate for
49%% delays during the test (e.g. if cover is running).
50
51timetrap(Timeout0, Pid) ->
52    timetrap(Timeout0, Timeout0, true, Pid).
53
54timetrap(Timeout0, Scale, Pid) ->
55    timetrap(Timeout0, Timeout0, Scale, Pid).
56
57timetrap(Timeout0, ReportTVal, Scale, Pid) ->
58    process_flag(priority, max),
59    ct_util:mark_process(),
60    Timeout = if not Scale -> Timeout0;
61		 true -> test_server:timetrap_scale_factor() * Timeout0
62	      end,
63    TruncTO = trunc(Timeout),
64    receive
65    after TruncTO ->
66	    kill_the_process(Pid, Timeout0, TruncTO, ReportTVal)
67    end.
68
69kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) ->
70    case is_process_alive(Pid) of
71	true ->
72	    TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
73			      true -> ReportTVal end,
74	    MFLs = test_server:get_loc(Pid),
75	    Mon = erlang:monitor(process, Pid),
76	    Trap = {timetrap_timeout,TimeToReport,MFLs},
77	    exit(Pid, Trap),
78	    receive
79		{'DOWN', Mon, process, Pid, _} ->
80		    ok
81	    after 10000 ->
82		    %% Pid is probably trapping exits, hit it harder...
83		    catch error_logger:warning_msg(
84			    "Testcase process ~w not "
85			    "responding to timetrap "
86			    "timeout:~n"
87			    "  ~tp.~n"
88			    "Killing testcase...~n",
89			    [Pid, Trap]),
90		    exit(Pid, kill)
91	    end;
92	false ->
93	    ok
94    end.
95
96
97%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
98%% timetrap_cancel(Handle) -> ok
99%% Handle = term()
100%%
101%% Cancels a time trap.
102timetrap_cancel(Handle) ->
103    unlink(Handle),
104    MonRef = erlang:monitor(process, Handle),
105    exit(Handle, kill),
106    receive {'DOWN',MonRef,_,_,_} -> ok
107    after
108	2000 ->
109	    erlang:demonitor(MonRef, [flush]),
110	    ok
111    end.
112
113capture_get(Msgs) ->
114    receive
115	{captured,Msg} ->
116	    capture_get([Msg|Msgs])
117    after 0 ->
118	    lists:reverse(Msgs)
119    end.
120
121messages_get(Msgs) ->
122    receive
123	Msg ->
124	    messages_get([Msg|Msgs])
125    after 0 ->
126	    lists:reverse(Msgs)
127    end.
128
129timecall(M, F, A) ->
130    {Elapsed, Val} = timer:tc(M, F, A),
131    {Elapsed / 1000000, Val}.
132
133
134call_crash(Time,Crash,M,F,A) ->
135    OldTrapExit = process_flag(trap_exit,true),
136    Pid = spawn_link(M,F,A),
137    Answer =
138	receive
139	    {'EXIT',Crash} ->
140		ok;
141	    {'EXIT',Pid,Crash} ->
142		ok;
143	    {'EXIT',_Reason} when Crash==any ->
144		ok;
145	    {'EXIT',Pid,_Reason} when Crash==any ->
146		ok;
147	    {'EXIT',Reason} ->
148		test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.",
149		      [Crash, Reason]),
150		exit({wrong_crash_reason,Reason});
151	    {'EXIT',Pid,Reason} ->
152		test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.",
153		      [Crash, Reason]),
154		exit({wrong_crash_reason,Reason});
155	    {'EXIT',OtherPid,Reason} when OldTrapExit == false ->
156		exit({'EXIT',OtherPid,Reason})
157	after do_trunc(Time) ->
158		exit(call_crash_timeout)
159	end,
160    process_flag(trap_exit,OldTrapExit),
161    Answer.
162
163do_trunc(infinity) -> infinity;
164do_trunc(T) -> trunc(T).
165
166
167%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
168%% app_test/2
169%%
170%% Checks one applications .app file for obvious errors.
171%% Checks..
172%% * .. required fields
173%% * .. that all modules specified actually exists
174%% * .. that all requires applications exists
175%% * .. that no module included in the application has export_all
176%% * .. that all modules in the ebin/ dir is included
177%%      (This only produce a warning, as all modules does not
178%%       have to be included (If the `pedantic' option isn't used))
179app_test(Application, Mode) ->
180    case is_app(Application) of
181	{ok, AppFile} ->
182	    do_app_tests(AppFile, Application, Mode);
183	Error ->
184	    ct:fail(Error)
185    end.
186
187is_app(Application) ->
188    case file:consult(filename:join([code:lib_dir(Application),"ebin",
189		   atom_to_list(Application)++".app"])) of
190	{ok, [{application, Application, AppFile}] } ->
191	    {ok, AppFile};
192	_ ->
193	    test_server:format(minor,
194			       "Application (.app) file not found, "
195			       "or it has very bad syntax.~n"),
196	    {error, not_an_application}
197    end.
198
199
200do_app_tests(AppFile, AppName, Mode) ->
201    DictList=
202	[
203	 {missing_fields, []},
204	 {missing_mods, []},
205	 {superfluous_mods_in_ebin, []},
206	 {export_all_mods, []},
207	 {missing_apps, []}
208	],
209    fill_dictionary(DictList),
210
211    %% An appfile must (?) have some fields..
212    check_fields([description, modules, registered, applications], AppFile),
213
214    %% Check for missing and extra modules.
215    {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile),
216    EBinList=lists:sort(get_ebin_modnames(AppName)),
217    {Missing, Extra} = common(lists:sort(Mods), EBinList),
218    put(superfluous_mods_in_ebin, Extra),
219    put(missing_mods, Missing),
220
221    %% Check that no modules in the application has export_all.
222    app_check_export_all(Mods),
223
224    %% Check that all specified applications exists.
225    {value, {applications, Apps}}=
226	lists:keysearch(applications, 1, AppFile),
227    check_apps(Apps),
228
229    A=check_dict(missing_fields, "Inconsistent app file, "
230	       "missing fields"),
231    B=check_dict(missing_mods, "Inconsistent app file, "
232	       "missing modules"),
233    C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, "
234	       "Modules not included in app file.", Mode),
235    D=check_dict(export_all_mods, "Inconsistent app file, "
236	       "Modules have `export_all'."),
237    E=check_dict(missing_apps, "Inconsistent app file, "
238	       "missing applications."),
239
240    erase_dictionary(DictList),
241    case A+B+C+D+E of
242	5 ->
243	    ok;
244	NotFive ->
245	    ct:fail(NotFive)
246    end.
247
248app_check_export_all([]) ->
249    ok;
250app_check_export_all([Mod|Mods]) ->
251    case catch apply(Mod, module_info, [compile]) of
252	{'EXIT', {undef,_}} ->
253	    app_check_export_all(Mods);
254	COpts ->
255	    case lists:keysearch(options, 1, COpts) of
256		false ->
257		    app_check_export_all(Mods);
258		{value, {options, List}} ->
259		    case lists:member(export_all, List) of
260			true ->
261			    put(export_all_mods, [Mod|get(export_all_mods)]),
262			    app_check_export_all(Mods);
263			false ->
264			    app_check_export_all(Mods)
265		    end
266	    end
267    end.
268
269%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
270%% appup_test/1
271%%
272%% Checks one applications .appup file for obvious errors.
273%% Checks..
274%% * .. syntax
275%% * .. that version in app file matches appup file version
276%% * .. validity of appup instructions
277%%
278%% For library application this function checks that the proper
279%% 'restart_application' upgrade and downgrade clauses exist.
280appup_test(Application) ->
281    case is_app(Application) of
282        {ok, AppFile} ->
283            case is_appup(Application, proplists:get_value(vsn, AppFile)) of
284                {ok, Up, Down} ->
285                    StartMod = proplists:get_value(mod, AppFile),
286                    Modules = proplists:get_value(modules, AppFile),
287                    do_appup_tests(StartMod, Application, Up, Down, Modules);
288                Error ->
289                    ct:fail(Error)
290            end;
291        Error ->
292            ct:fail(Error)
293    end.
294
295is_appup(Application, Version) ->
296    AppupFile = atom_to_list(Application) ++ ".appup",
297    AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]),
298    case file:consult(AppupPath) of
299        {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) ->
300            {ok, Up, Down};
301        _ ->
302            test_server:format(
303              minor,
304              "Application upgrade (.appup) file not found, "
305              "or it has very bad syntax.~n"),
306            {error, appup_not_readable}
307    end.
308
309do_appup_tests(undefined, Application, Up, Down, _Modules) ->
310    %% library application
311    case Up of
312        [{<<".*">>, [{restart_application, Application}]}] ->
313            case Down of
314                [{<<".*">>, [{restart_application, Application}]}] ->
315                    ok;
316                _ ->
317                    test_server:format(
318                      minor,
319                      "Library application needs restart_application "
320                      "downgrade instruction.~n"),
321                    {error, library_downgrade_instruction_malformed}
322            end;
323        _ ->
324            test_server:format(
325              minor,
326              "Library application needs restart_application "
327              "upgrade instruction.~n"),
328            {error, library_upgrade_instruction_malformed}
329    end;
330do_appup_tests(_, _Application, Up, Down, Modules) ->
331    %% normal application
332    case check_appup_clauses_plausible(Up, up, Modules) of
333        ok ->
334            case check_appup_clauses_plausible(Down, down, Modules) of
335                ok ->
336                    test_server:format(minor, "OK~n");
337                Error ->
338                    test_server:format(minor, "ERROR ~tp~n", [Error]),
339                    ct:fail(Error)
340            end;
341        Error ->
342            test_server:format(minor, "ERROR ~tp~n", [Error]),
343            ct:fail(Error)
344    end.
345
346check_appup_clauses_plausible([], _Direction, _Modules) ->
347    ok;
348check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules)
349  when is_binary(Re) ->
350    case re:compile(Re,[unicode]) of
351        {ok, _} ->
352            case check_appup_instructions(Instrs, Direction, Modules) of
353                ok ->
354                    check_appup_clauses_plausible(Rest, Direction, Modules);
355                Error ->
356                    Error
357            end;
358        {error, Error} ->
359            {error, {version_regex_malformed, Re, Error}}
360    end;
361check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules)
362  when is_list(V) ->
363    case check_appup_instructions(Instrs, Direction, Modules) of
364        ok ->
365            check_appup_clauses_plausible(Rest, Direction, Modules);
366        Error ->
367            Error
368    end;
369check_appup_clauses_plausible(Clause, _Direction, _Modules) ->
370    {error, {clause_malformed, Clause}}.
371
372check_appup_instructions(Instrs, Direction, Modules) ->
373    case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of
374        {_Good, []} ->
375            ok;
376        {_, Bad} ->
377            {error, {bad_instructions, Bad}}
378    end.
379
380check_instructions(_, [], _, Good, Bad, _) ->
381    {lists:reverse(Good), lists:reverse(Bad)};
382check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) ->
383    case catch check_instruction(UpDown, Instr, All, Modules) of
384        ok ->
385            check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules);
386        {error, Reason} ->
387            NewBad = [{Instr, Reason} | Bad],
388            check_instructions(UpDown, Rest, All, Good, NewBad, Modules)
389    end.
390
391check_instruction(up, {add_module, Module}, _, Modules) ->
392    %% A new module is added
393    check_module(Module, Modules);
394check_instruction(down, {add_module, Module}, _, Modules) ->
395    %% An old module is re-added
396    case (catch check_module(Module, Modules)) of
397        {error, {unknown_module, Module, Modules}} -> ok;
398        ok -> throw({error, {existing_readded_module, Module}})
399    end;
400check_instruction(_, {load_module, Module}, _, Modules) ->
401    check_module(Module, Modules);
402check_instruction(_, {load_module, Module, DepMods}, _, Modules) ->
403    check_module(Module, Modules),
404    check_depend(DepMods);
405check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) ->
406    check_module(Module, Modules),
407    check_depend(DepMods),
408    check_purge(Pre),
409    check_purge(Post);
410check_instruction(up, {delete_module, Module}, _, Modules) ->
411    case (catch check_module(Module, Modules)) of
412        {error, {unknown_module, Module, Modules}} ->
413            ok;
414        ok ->
415            throw({error,{existing_module_deleted, Module}})
416    end;
417check_instruction(down, {delete_module, Module}, _, Modules) ->
418    check_module(Module, Modules);
419check_instruction(_, {update, Module}, _, Modules) ->
420    check_module(Module, Modules);
421check_instruction(_, {update, Module, supervisor}, _, Modules) ->
422    check_module(Module, Modules);
423check_instruction(_, {update, Module, DepMods}, _, Modules)
424  when is_list(DepMods) ->
425    check_module(Module, Modules);
426check_instruction(_, {update, Module, Change}, _, Modules) ->
427    check_module(Module, Modules),
428    check_change(Change);
429check_instruction(_, {update, Module, Change, DepMods}, _, Modules) ->
430    check_module(Module, Modules),
431    check_change(Change),
432    check_depend(DepMods);
433check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) ->
434    check_module(Module, Modules),
435    check_change(Change),
436    check_purge(Pre),
437    check_purge(Post),
438    check_depend(DepMods);
439check_instruction(_,
440                  {update, Module, Timeout, Change, Pre, Post, DepMods},
441                  _,
442                  Modules) ->
443    check_module(Module, Modules),
444    check_timeout(Timeout),
445    check_change(Change),
446    check_purge(Pre),
447    check_purge(Post),
448    check_depend(DepMods);
449check_instruction(_,
450                  {update, Module, ModType, Timeout, Change, Pre, Post, DepMods},
451                  _,
452                  Modules) ->
453    check_module(Module, Modules),
454    check_mod_type(ModType),
455    check_timeout(Timeout),
456    check_change(Change),
457    check_purge(Pre),
458    check_purge(Post),
459    check_depend(DepMods);
460check_instruction(_, {restart_application, Application}, _, _) ->
461    check_application(Application);
462check_instruction(_, {remove_application, Application}, _, _) ->
463    check_application(Application);
464check_instruction(_, {add_application, Application}, _, _) ->
465    check_application(Application);
466check_instruction(_, {add_application, Application, Type}, _, _) ->
467    check_application(Application),
468    check_restart_type(Type);
469check_instruction(_, Instr, _, _) ->
470    throw({error, {low_level_or_invalid_instruction, Instr}}).
471
472check_module(Module, Modules) ->
473    case {is_atom(Module), lists:member(Module, Modules)} of
474        {true, true}  -> ok;
475        {true, false} -> throw({error, {unknown_module, Module}});
476        {false, _}    -> throw({error, {bad_module, Module}})
477    end.
478
479check_application(App) ->
480    case is_atom(App) of
481        true  -> ok;
482        false -> throw({error, {bad_application, App}})
483    end.
484
485check_depend(Dep) when is_list(Dep) -> ok;
486check_depend(Dep)                   -> throw({error, {bad_depend, Dep}}).
487
488check_restart_type(permanent) -> ok;
489check_restart_type(transient) -> ok;
490check_restart_type(temporary) -> ok;
491check_restart_type(load)      -> ok;
492check_restart_type(none)      -> ok;
493check_restart_type(Type)      -> throw({error, {bad_restart_type, Type}}).
494
495check_timeout(T) when is_integer(T), T > 0 -> ok;
496check_timeout(default)                     -> ok;
497check_timeout(infinity)                    -> ok;
498check_timeout(T)                           -> throw({error, {bad_timeout, T}}).
499
500check_mod_type(static)  -> ok;
501check_mod_type(dynamic) -> ok;
502check_mod_type(Type)    -> throw({error, {bad_mod_type, Type}}).
503
504check_purge(soft_purge)   -> ok;
505check_purge(brutal_purge) -> ok;
506check_purge(Purge)        -> throw({error, {bad_purge, Purge}}).
507
508check_change(soft)          -> ok;
509check_change({advanced, _}) -> ok;
510check_change(Change)        -> throw({error, {bad_change, Change}}).
511
512%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1},
513%% NotInL2 is the elements of L1 which don't occurr in L2,
514%% NotInL1 is the elements of L2 which don't ocurr in L1.
515
516common(L1, L2) ->
517    common(L1, L2, [], []).
518
519common([X|Rest1], [X|Rest2], A1, A2) ->
520    common(Rest1, Rest2, A1, A2);
521common([X|Rest1], [Y|Rest2], A1, A2) when X < Y ->
522    common(Rest1, [Y|Rest2], [X|A1], A2);
523common([X|Rest1], [Y|Rest2], A1, A2) ->
524    common([X|Rest1], Rest2, A1, [Y|A2]);
525common([], L, A1, A2) ->
526    {A1, L++A2};
527common(L, [], A1, A2) ->
528    {L++A1, A2}.
529
530check_apps([]) ->
531    ok;
532check_apps([App|Apps]) ->
533    case is_app(App) of
534	{ok, _AppFile} ->
535	    ok;
536	{error, _} ->
537	    put(missing_apps, [App|get(missing_apps)])
538    end,
539    check_apps(Apps).
540
541check_fields([], _AppFile) ->
542    ok;
543check_fields([L|Ls], AppFile) ->
544    check_field(L, AppFile),
545    check_fields(Ls, AppFile).
546
547check_field(FieldName, AppFile) ->
548    case lists:keymember(FieldName, 1, AppFile) of
549	true ->
550	    ok;
551	false ->
552	    put(missing_fields, [FieldName|get(missing_fields)]),
553	    ok
554    end.
555
556check_dict(Dict, Reason) ->
557    case get(Dict) of
558	[] ->
559	    1;                         % All ok.
560	List ->
561	    io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]),
562	    0
563    end.
564
565check_dict_tolerant(Dict, Reason, Mode) ->
566    case get(Dict) of
567	[] ->
568	    1;                         % All ok.
569	List ->
570	    io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]),
571	    case Mode of
572		pedantic ->
573		    0;
574		_ ->
575		    1
576	    end
577    end.
578
579get_ebin_modnames(AppName) ->
580    Wc=filename:join([code:lib_dir(AppName),"ebin",
581		      "*"++code:objfile_extension()]),
582    TheFun=fun(X, Acc) ->
583		   [list_to_atom(filename:rootname(
584				   filename:basename(X)))|Acc] end,
585    _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)).
586
587%%
588%% This function removes any erl_crash_dump* files found in the
589%% test server directory. Done only once when the test server
590%% is started.
591%%
592cleanup_crash_dumps() ->
593    Dir = crash_dump_dir(),
594    Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
595    delete_files(Dumps).
596
597crash_dump_dir() ->
598    %% If no framework is known, then we use current working directory
599    %% - in most cases that will be the same as the default log
600    %% directory.
601    {ok,Dir} = test_server_sup:framework_call(get_log_dir,[],file:get_cwd()),
602    Dir.
603
604tar_crash_dumps() ->
605    Dir = crash_dump_dir(),
606    case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of
607	[] -> {error,no_crash_dumps};
608	Dumps ->
609	    TarFileName = filename:join(Dir,?crash_dump_tar),
610	    {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]),
611	    lists:foreach(
612	      fun(File) ->
613		      ok = erl_tar:add(Tar,File,filename:basename(File),[])
614	      end,
615	      Dumps),
616	    ok = erl_tar:close(Tar),
617	    delete_files(Dumps),
618	    {ok,TarFileName}
619    end.
620
621
622check_new_crash_dumps() ->
623    Dir = crash_dump_dir(),
624    Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
625    case length(Dumps) of
626	0 ->
627	    ok;
628	Num ->
629	    test_server_ctrl:format(minor,
630				    "Found ~w crash dumps:~n", [Num]),
631	    append_files_to_logfile(Dumps),
632	    delete_files(Dumps)
633    end.
634
635append_files_to_logfile([]) -> ok;
636append_files_to_logfile([File|Files]) ->
637    NodeName=from($., File),
638    test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]),
639    Fd=get(test_server_minor_fd),
640    case file:read_file(File) of
641	{ok, Bin} ->
642	    case file:write(Fd, Bin) of
643		ok ->
644		    ok;
645		{error,Error} ->
646		    %% Write failed. The following io:format/3 will probably also
647		    %% fail, but in that case it will throw an exception so that
648		    %% we will be aware of the problem.
649		    io:format(Fd, "Unable to write the crash dump "
650			      "to this file: ~tp~n", [file:format_error(Error)])
651	    end;
652	_Error ->
653	    io:format(Fd, "Failed to read: ~ts\n", [File])
654    end,
655    append_files_to_logfile(Files).
656
657delete_files([]) -> ok;
658delete_files([File|Files]) ->
659    io:format("Deleting file: ~ts~n", [File]),
660    case file:delete(File) of
661	{error, _} ->
662	    case file:rename(File, File++".old") of
663		{error, Error} ->
664		    io:format("Could neither delete nor rename file "
665			      "~ts: ~ts.~n", [File, Error]);
666		_ ->
667		    ok
668	    end;
669	_ ->
670	    ok
671    end,
672    delete_files(Files).
673
674
675%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
676%% erase_dictionary(Vars) -> ok
677%% Vars = [atom(),...]
678%%
679%% Takes a list of dictionary keys, KeyVals, erases
680%% each key and returns ok.
681erase_dictionary([{Var, _Val}|Vars]) ->
682    erase(Var),
683    erase_dictionary(Vars);
684erase_dictionary([]) ->
685    ok.
686
687%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
688%% fill_dictionary(KeyVals) -> void()
689%% KeyVals = [{atom(),term()},...]
690%%
691%% Takes each Key-Value pair, and inserts it in the process dictionary.
692fill_dictionary([{Var,Val}|Vars]) ->
693    put(Var,Val),
694    fill_dictionary(Vars);
695fill_dictionary([]) ->
696    [].
697
698
699
700%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
701%% get_username() -> UserName
702%%
703%% Returns the current user
704get_username() ->
705    getenv_any(["USER","USERNAME"]).
706
707getenv_any([Key|Rest]) ->
708    case catch os:getenv(Key) of
709	String when is_list(String) -> String;
710	false -> getenv_any(Rest)
711    end;
712getenv_any([]) -> "".
713
714
715%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
716%% get_os_family() -> OsFamily
717%%
718%% Returns the OS family
719get_os_family() ->
720    {OsFamily,_OsName} = os:type(),
721    OsFamily.
722
723
724%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
725%% hostatom()/hostatom(Node) -> Host; atom()
726%% hoststr() | hoststr(Node) -> Host; string()
727%%
728%% Returns the OS family
729hostatom() ->
730    hostatom(node()).
731hostatom(Node) ->
732    list_to_atom(hoststr(Node)).
733hoststr() ->
734    hoststr(node()).
735hoststr(Node) when is_atom(Node) ->
736    hoststr(atom_to_list(Node));
737hoststr(Node) when is_list(Node) ->
738    from($@, Node).
739
740from(H, [H | T]) -> T;
741from(H, [_ | T]) -> from(H, T);
742from(_H, []) -> [].
743
744
745%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
746%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn
747%%
748%% Calls the given Func in Callback
749framework_call(Func,Args) ->
750    framework_call(Func,Args,ok).
751framework_call(Func,Args,DefaultReturn) ->
752    CB = os:getenv("TEST_SERVER_FRAMEWORK"),
753    framework_call(CB,Func,Args,DefaultReturn).
754framework_call(FW,_Func,_Args,DefaultReturn)
755  when FW =:= false; FW =:= "undefined" ->
756    DefaultReturn;
757framework_call(Callback,Func,Args,DefaultReturn) ->
758    Mod = list_to_atom(Callback),
759    _ = case code:is_loaded(Mod) of
760	false -> code:load_file(Mod);
761	_ -> ok
762    end,
763    case erlang:function_exported(Mod,Func,length(Args)) of
764	true ->
765	    EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end,
766	    SetTcState = case Func of
767			     end_tc -> true;
768			     init_tc -> true;
769			     _ -> false
770			 end,
771	    case SetTcState of
772		true ->
773		    test_server:set_tc_state({framework,{Mod,Func,Args}});
774		false ->
775		    ok
776	    end,
777            ct_util:mark_process(),
778	    try apply(Mod,Func,Args) of
779		Result ->
780		    Result
781	    catch
782		exit:Why ->
783		    EH(Why);
784		error:Why:Stacktrace ->
785		    EH({Why,Stacktrace});
786		throw:Why ->
787		    EH(Why)
788	    end;
789	false ->
790	    DefaultReturn
791    end.
792
793
794%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
795%% format_loc(Loc) -> string()
796%%
797%% Formats the printout of the line of code read from
798%% process dictionary (test_server_loc). Adds link to
799%% correct line in source code.
800format_loc([{Mod,Func,Line}]) ->
801    [format_loc1({Mod,Func,Line})];
802format_loc([{Mod,Func,Line}|Rest]) ->
803    ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
804format_loc([{Mod,LineOrFunc}]) ->
805    format_loc({Mod,LineOrFunc});
806format_loc({Mod,Func}) when is_atom(Func) ->
807    io_lib:format("{~w,~tw}",[Mod,Func]);
808format_loc(Loc) ->
809    io_lib:format("~tp",[Loc]).
810
811format_loc1([{Mod,Func,Line}]) ->
812    ["              ",format_loc1({Mod,Func,Line}),"]"];
813format_loc1([{Mod,Func,Line}|Rest]) ->
814    ["              ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
815format_loc1({Mod,Func,Line}) ->
816    ModStr = atom_to_list(Mod),
817    case {lists:member(no_src, get(test_server_logopts)),
818	  lists:reverse(ModStr)} of
819	{false,[$E,$T,$I,$U,$S,$_|_]}  ->
820	    Link = if is_integer(Line) ->
821			   integer_to_list(Line);
822		      Line == last_expr ->
823			   list_to_atom(atom_to_list(Func)++"-last_expr");
824		      is_atom(Line) ->
825			   atom_to_list(Line);
826		      true ->
827			   Line
828		   end,
829	    io_lib:format("{~w,~tw,<a href=\"~ts~ts#~ts\">~tw</a>}",
830			  [Mod,Func,
831			   test_server_ctrl:uri_encode(downcase(ModStr)),
832			   ?src_listing_ext,Link,Line]);
833	_ ->
834	    io_lib:format("{~w,~tw,~tw}",[Mod,Func,Line])
835    end.
836
837downcase(S) -> downcase(S, []).
838downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
839    downcase(Rest, [Uc-$A+$a|Result]);
840downcase([C|Rest], Result) ->
841    downcase(Rest, [C|Result]);
842downcase([], Result) ->
843    lists:reverse(Result).
844
845%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
846%% util_start() -> ok
847%%
848%% Start local utility process
849util_start() ->
850    Starter = self(),
851    case whereis(?MODULE) of
852	undefined ->
853	    spawn_link(fun() ->
854			       register(?MODULE, self()),
855                               put(app, common_test),
856			       util_loop(#util_state{starter=Starter})
857		       end),
858	    ok;
859	_Pid ->
860	    ok
861    end.
862
863%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
864%% util_stop() -> ok
865%%
866%% Stop local utility process
867util_stop() ->
868    try (?MODULE ! {self(),stop}) of
869	_ ->
870	    receive {?MODULE,stopped} -> ok
871	    after 5000 -> exit(whereis(?MODULE), kill)
872	    end
873    catch
874	_:_ ->
875	    ok
876    end.
877
878%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
879%% unique_name() -> string()
880%%
881unique_name() ->
882    ?MODULE ! {self(),unique_name},
883    receive {?MODULE,Name} -> Name
884    after 5000 -> exit({?MODULE,no_util_process})
885    end.
886
887%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
888%% util_loop(State) -> ok
889%%
890util_loop(State) ->
891    receive
892	{From,unique_name} ->
893	    Nr = erlang:unique_integer([positive]),
894	    Name = integer_to_list(Nr),
895	    if Name == State#util_state.latest_name ->
896		    timer:sleep(1),
897		    self() ! {From,unique_name},
898		    util_loop(State);
899	       true ->
900		    From ! {?MODULE,Name},
901		    util_loop(State#util_state{latest_name = Name})
902	    end;
903	{From,stop} ->
904	    catch unlink(State#util_state.starter),
905	    From ! {?MODULE,stopped},
906	    ok
907    end.
908
909%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
910%% call_trace(TraceSpecFile) -> ok
911%%
912%% Read terms on format {m,Mod} | {f,Mod,Func}
913%% from TraceSpecFile and enable call trace for
914%% specified functions.
915call_trace(TraceSpec) ->
916    case catch try_call_trace(TraceSpec) of
917	{'EXIT',Reason} ->
918	    erlang:display(Reason),
919	    exit(Reason);
920	Ok ->
921	    Ok
922    end.
923
924try_call_trace(TraceSpec) ->
925    case file:consult(TraceSpec) of
926	{ok,Terms} ->
927	    dbg:tracer(),
928	    %% dbg:p(self(), [p, m, sos, call]),
929	    dbg:p(self(), [sos, call]),
930	    lists:foreach(fun({m,M}) ->
931				  case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of
932				      {error,What} -> exit({error,{tracing_failed,What}});
933				      _ -> ok
934				  end;
935			     ({f,M,F}) ->
936				  case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of
937				      {error,What} -> exit({error,{tracing_failed,What}});
938				      _ -> ok
939				  end;
940			     (Huh) ->
941				  exit({error,{unrecognized_trace_term,Huh}})
942			  end, Terms),
943	    ok;
944	{_,Error} ->
945	    exit({error,{tracing_failed,TraceSpec,Error}})
946    end.
947
948