1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2003-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%%% Common Test Framework Utilities.
22%%%
23%%% This is a support module for the Common Test Framework. It
24%%% implements the process ct_util_server which acts like a data
25%%% holder for suite, configuration and connection data.
26%%%
27-module(ct_util).
28
29-export([start/0, start/1, start/2, start/3,
30	 stop/1, update_last_run_index/0]).
31
32-export([register_connection/4, unregister_connection/1,
33	 does_connection_exist/3, get_key_from_name/1]).
34
35-export([get_connections/1, close_connections/0]).
36
37-export([save_suite_data/3, save_suite_data/2,
38	 save_suite_data_async/3, save_suite_data_async/2,
39	 read_suite_data/1,
40	 delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1,
41	 delete_testdata/0, delete_testdata/1, match_delete_testdata/1,
42	 set_testdata/1, get_testdata/1, get_testdata/2,
43	 set_testdata_async/1, update_testdata/2, update_testdata/3,
44	 set_verbosity/1, get_verbosity/1]).
45
46-export([override_silence_all_connections/0, override_silence_connections/1,
47	 get_overridden_silenced_connections/0,
48	 delete_overridden_silenced_connections/0,
49	 silence_all_connections/0, silence_connections/1,
50	 is_silenced/1, is_silenced/2, reset_silent_connections/0]).
51
52-export([get_mode/0, create_table/3, read_opts/0]).
53
54-export([set_cwd/1, reset_cwd/0, get_start_dir/0]).
55
56-export([parse_table/1]).
57
58-export([listenv/1]).
59
60-export([get_target_name/1, get_connection/2]).
61
62-export([is_test_dir/1, get_testdir/2]).
63
64-export([kill_attached/2, get_attached/1]).
65
66-export([warn_duplicates/1]).
67
68-export([mark_process/0, mark_process/1, is_marked/1, is_marked/2,
69         remaining_test_procs/0]).
70
71-export([get_profile_data/0, get_profile_data/1,
72	 get_profile_data/2, open_url/3]).
73
74-include("ct.hrl").
75-include("ct_event.hrl").
76-include("ct_util.hrl").
77
78-define(default_verbosity, [{default,?MAX_VERBOSITY},
79			    {'$unspecified',?MAX_VERBOSITY}]).
80
81-record(suite_data, {key,name,value}).
82
83%%%-----------------------------------------------------------------
84start() ->
85    start(normal, ".", ?default_verbosity).
86%%% -spec start(Mode) -> Pid | exit(Error)
87%%%       Mode = normal | interactive
88%%%       Pid = pid()
89%%%
90%%% Start start the ct_util_server process
91%%% (tool-internal use only).
92%%%
93%%% This function is called from ct_run.erl. It starts and initiates
94%%% the ct_util_server
95%%%
96%%% Returns the process identity of the
97%%% ct_util_server.
98%%%
99%%% See ct.
100start(LogDir) when is_list(LogDir) ->
101    start(normal, LogDir, ?default_verbosity);
102start(Mode) ->
103    start(Mode, ".", ?default_verbosity).
104
105start(LogDir, Verbosity) when is_list(LogDir) ->
106    start(normal, LogDir, Verbosity).
107
108start(Mode, LogDir, Verbosity) ->
109    case whereis(ct_util_server) of
110	undefined ->
111	    S = self(),
112	    Pid = spawn_link(fun() -> do_start(S, Mode, LogDir, Verbosity) end),
113	    receive
114		{Pid,started} -> Pid;
115		{Pid,Error} -> exit(Error);
116		{_Ref,{Pid,Error}} -> exit(Error)
117	    end;
118	Pid ->
119	    case get_mode() of
120		interactive when Mode==interactive ->
121		    Pid;
122		interactive ->
123		    {error,interactive_mode};
124		_OtherMode ->
125		    Pid
126	    end
127    end.
128
129do_start(Parent, Mode, LogDir, Verbosity) ->
130    process_flag(trap_exit,true),
131    register(ct_util_server,self()),
132    mark_process(),
133    create_table(?conn_table,#conn.handle),
134    create_table(?board_table,2),
135    create_table(?suite_table,#suite_data.key),
136
137    create_table(?verbosity_table,1),
138    _ = [ets:insert(?verbosity_table,{Cat,Lvl}) || {Cat,Lvl} <- Verbosity],
139
140    {ok,StartDir} = file:get_cwd(),
141    case file:set_cwd(LogDir) of
142	ok -> ok;
143	E -> exit(E)
144    end,
145    DoExit = fun(Reason) -> ok = file:set_cwd(StartDir), exit(Reason) end,
146    Opts = case read_opts() of
147	       {ok,Opts1} ->
148		   Opts1;
149	       Error ->
150		   Parent ! {self(),Error},
151		   DoExit(Error)
152	   end,
153
154    %% start an event manager (if not already started by master)
155    case ct_event:start_link() of
156	{error,{already_started,_}} ->
157	    ok;
158	_ ->
159            ct_event:add_handler()
160    end,
161
162    %% start ct_config server
163    try ct_config:start(Mode) of
164	_ -> ok
165    catch
166	_Class:CfgError ->
167	    DoExit(CfgError)
168    end,
169
170    %% add user event handlers
171    _ = case lists:keysearch(event_handler,1,Opts) of
172	{value,{_,Handlers}} ->
173	    Add = fun({H,Args}) ->
174			  case catch gen_event:add_handler(?CT_EVMGR_REF,H,Args) of
175			      ok -> ok;
176			      {'EXIT',Why} -> DoExit(Why);
177			      Other -> DoExit({event_handler,Other})
178			  end
179		  end,
180	    case catch lists:foreach(Add,Handlers) of
181		{'EXIT',Reason} ->
182		    Parent ! {self(),Reason};
183		_ ->
184		    ok
185	    end;
186	false ->
187	    ok
188    end,
189
190    case ct_default_gl:start_link(group_leader()) of
191        {ok, _} -> ok;
192        ignore -> ok
193    end,
194
195    {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity),
196
197    ct_event:notify(#event{name=test_start,
198			   node=node(),
199			   data={StartTime,
200				 lists:flatten(TestLogDir)}}),
201    %% Initialize ct_hooks
202    _ = try ct_hooks:init(Opts) of
203	ok ->
204	    Parent ! {self(),started};
205	{fail,CTHReason} ->
206	    ct_logs:tc_print('Suite Callback',CTHReason,[]),
207	    self() ! {{stop,{self(),{user_error,CTHReason}}},
208		      {Parent,make_ref()}}
209    catch
210	_:CTHReason:StackTrace ->
211	    ErrorInfo = if is_atom(CTHReason) ->
212				io_lib:format("{~tp,~tp}",
213					      [CTHReason, StackTrace]);
214			   true ->
215				CTHReason
216			end,
217	    ct_logs:tc_print('Suite Callback',ErrorInfo,[]),
218	    self() ! {{stop,{self(),{user_error,CTHReason}}},
219		      {Parent,make_ref()}}
220    end,
221    loop(Mode, [], StartDir).
222
223create_table(TableName,KeyPos) ->
224    create_table(TableName,set,KeyPos).
225create_table(TableName,Type,KeyPos) ->
226    catch ets:delete(TableName),
227    _ = ets:new(TableName,[Type,named_table,public,{keypos,KeyPos}]),
228    ok.
229
230read_opts() ->
231    case file:consult(ct_run:variables_file_name("./")) of
232	{ok,Opts} ->
233	    {ok,Opts};
234	{error,enoent} ->
235	    {error,not_installed};
236	Error ->
237	    {error,{bad_installation,Error}}
238    end.
239
240
241save_suite_data(Key, Value) ->
242    call({save_suite_data, {Key, undefined, Value}}).
243
244save_suite_data(Key, Name, Value) ->
245    call({save_suite_data, {Key, Name, Value}}).
246
247save_suite_data_async(Key, Value) ->
248    save_suite_data_async(Key, undefined, Value).
249
250save_suite_data_async(Key, Name, Value) ->
251    cast({save_suite_data, {Key, Name, Value}}).
252
253read_suite_data(Key) ->
254    call({read_suite_data, Key}).
255
256delete_suite_data() ->
257    call({delete_suite_data, all}).
258
259delete_suite_data(Key) ->
260    call({delete_suite_data, Key}).
261
262match_delete_suite_data(KeyPat) ->
263    call({match_delete_suite_data, KeyPat}).
264
265delete_testdata() ->
266    call(delete_testdata).
267
268delete_testdata(Key) ->
269    call({delete_testdata, Key}).
270
271match_delete_testdata(KeyPat) ->
272    call({match_delete_testdata, KeyPat}).
273
274update_testdata(Key, Fun) ->
275    update_testdata(Key, Fun, []).
276
277update_testdata(Key, Fun, Opts) ->
278    call({update_testdata, Key, Fun, Opts}).
279
280set_testdata(TestData) ->
281    call({set_testdata, TestData}).
282
283set_testdata_async(TestData) ->
284    cast({set_testdata, TestData}).
285
286get_testdata(Key) ->
287    call({get_testdata, Key}).
288
289get_testdata(Key, Timeout) ->
290    call({get_testdata, Key}, Timeout).
291
292set_cwd(Dir) ->
293    call({set_cwd,Dir}).
294
295reset_cwd() ->
296    call(reset_cwd).
297
298get_start_dir() ->
299    call(get_start_dir).
300
301%% handle verbosity outside ct_util_server (let the client read
302%% the verbosity table) to avoid possible deadlock situations
303set_verbosity(Elem = {_Category,_Level}) ->
304    try ets:insert(?verbosity_table, Elem) of
305	_ ->
306	    ok
307    catch
308	_:Reason ->
309	    {error,Reason}
310    end.
311
312get_verbosity(Category) ->
313    try ets:lookup(?verbosity_table, Category) of
314	[{Category,Level}] ->
315	    Level;
316	_ ->
317	    undefined
318    catch
319	_:Reason ->
320	    {error,Reason}
321    end.
322
323loop(Mode,TestData,StartDir) ->
324    receive
325	{update_last_run_index,From} ->
326	    ct_logs:make_last_run_index(),
327	    return(From,ok),
328	    loop(Mode,TestData,StartDir);
329	{{save_suite_data,{Key,Name,Value}},From} ->
330	    ets:insert(?suite_table, #suite_data{key=Key,
331						 name=Name,
332						 value=Value}),
333	    return(From,ok),
334	    loop(Mode,TestData,StartDir);
335	{{read_suite_data,Key},From} ->
336	    case ets:lookup(?suite_table, Key) of
337		[#suite_data{key=Key,name=undefined,value=Value}] ->
338		    return(From,Value);
339		[#suite_data{key=Key,name=Name,value=Value}] ->
340		    return(From,{Name,Value});
341		_ ->
342		    return(From,undefined)
343	    end,
344	    loop(Mode,TestData,StartDir);
345	{{delete_suite_data,Key},From} ->
346	    if Key == all ->
347		    ets:delete_all_objects(?suite_table);
348	       true ->
349		    ets:delete(?suite_table, Key)
350	    end,
351	    return(From,ok),
352	    loop(Mode,TestData,StartDir);
353	{{match_delete_suite_data,KeyPat},From} ->
354	    ets:match_delete(?suite_table, #suite_data{key=KeyPat,
355						       name='_',
356						       value='_'}),
357	    return(From,ok),
358	    loop(Mode,TestData,StartDir);
359	{delete_testdata,From} ->
360	    return(From,ok),
361	    loop(From,[],StartDir);
362	{{delete_testdata,Key},From} ->
363	    TestData1 = lists:keydelete(Key,1,TestData),
364	    return(From,ok),
365	    loop(From,TestData1,StartDir);
366	{{match_delete_testdata,{Key1,Key2}},From} ->
367	    %% handles keys with 2 elements
368	    TestData1 =
369		lists:filter(fun({Key,_}) when not is_tuple(Key) ->
370				     true;
371				({Key,_}) when tuple_size(Key) =/= 2 ->
372				     true;
373				({{_,KeyB},_}) when Key1 == '_' ->
374				     KeyB =/= Key2;
375				({{KeyA,_},_}) when Key2 == '_' ->
376				     KeyA =/= Key1;
377				(_) when Key1 == '_' ; Key2 == '_' ->
378				     false;
379				(_) ->
380				     true
381			     end, TestData),
382	    return(From,ok),
383	    loop(From,TestData1,StartDir);
384	{{set_testdata,New = {Key,_Val}},From} ->
385	    TestData1 = lists:keydelete(Key,1,TestData),
386	    return(From,ok),
387	    loop(Mode,[New|TestData1],StartDir);
388	{{get_testdata, all}, From} ->
389	    return(From, TestData),
390	    loop(From, TestData, StartDir);
391	{{get_testdata,Key},From} ->
392	    case lists:keysearch(Key,1,TestData) of
393		{value,{Key,Val}} ->
394		    return(From,Val);
395		_ ->
396		    return(From,undefined)
397	    end,
398	    loop(From,TestData,StartDir);
399	{{update_testdata,Key,Fun,Opts},From} ->
400	    TestData1 =
401		case lists:keysearch(Key,1,TestData) of
402		    {value,{Key,Val}} ->
403			try Fun(Val) of
404			    '$delete' ->
405				return(From,deleted),
406				lists:keydelete(Key,1,TestData);
407			    NewVal ->
408				return(From,NewVal),
409				[{Key,NewVal}|lists:keydelete(Key,1,TestData)]
410			catch
411			    _:Error ->
412				return(From,{error,Error}),
413				TestData
414			end;
415		    _ ->
416			case lists:member(create,Opts) of
417			    true ->
418				InitVal = Fun(undefined),
419				return(From,InitVal),
420				[{Key,InitVal}|TestData];
421			    false ->
422				return(From,undefined),
423				TestData
424			end
425		end,
426	    loop(From,TestData1,StartDir);
427	{{set_cwd,Dir},From} ->
428	    return(From,file:set_cwd(Dir)),
429	    loop(From,TestData,StartDir);
430	{reset_cwd,From} ->
431	    return(From,file:set_cwd(StartDir)),
432	    loop(From,TestData,StartDir);
433	{get_start_dir,From} ->
434	    return(From,StartDir),
435	    loop(From,TestData,StartDir);
436	{{stop,Info},From} ->
437	    test_server_io:reset_state(),
438	    {MiscIoName,MiscIoDivider,MiscIoFooter} =
439		proplists:get_value(misc_io_log,TestData),
440	    {ok,MiscIoFd} = file:open(MiscIoName,
441				      [append,{encoding,utf8}]),
442	    io:put_chars(MiscIoFd, MiscIoDivider),
443	    test_server_io:set_fd(unexpected_io, MiscIoFd),
444
445	    Time = calendar:local_time(),
446	    ct_event:sync_notify(#event{name=test_done,
447					node=node(),
448					data=Time}),
449	    Callbacks =
450		try ets:lookup_element(?suite_table,
451				       ct_hooks,
452				       #suite_data.value) of
453		    CTHMods -> CTHMods
454		catch
455		    %% this is because ct_util failed in init
456		    error:badarg -> []
457		end,
458	    ct_hooks:terminate(Callbacks),
459
460	    close_connections(ets:tab2list(?conn_table)),
461	    ets:delete(?conn_table),
462	    ets:delete(?board_table),
463	    ets:delete(?suite_table),
464	    ets:delete(?verbosity_table),
465
466	    io:put_chars(MiscIoFd, "\n</pre>\n"++MiscIoFooter),
467	    test_server_io:stop([unexpected_io]),
468	    test_server_io:finish(),
469
470	    ct_logs:close(Info, StartDir),
471	    ct_event:stop(),
472	    ct_config:stop(),
473	    ct_default_gl:stop(),
474	    ok = file:set_cwd(StartDir),
475	    return(From, Info);
476	{Ref, _Msg} when is_reference(Ref) ->
477	    %% This clause is used when doing cast operations.
478	    loop(Mode,TestData,StartDir);
479	{get_mode,From} ->
480	    return(From,Mode),
481	    loop(Mode,TestData,StartDir);
482	{'EXIT',_Pid,normal} ->
483	    loop(Mode,TestData,StartDir);
484	{'EXIT',Pid,Reason} ->
485	    case ets:lookup(?conn_table,Pid) of
486		[#conn{address=A,callback=CB}] ->
487		    ErrorStr = io_lib:format("~tp", [Reason]),
488		    ErrorHtml = ct_logs:escape_chars(ErrorStr),
489		    %% A connection crashed - remove the connection but don't die
490		    ct_logs:tc_log_async(ct_error_notify,
491					 ?MAX_IMPORTANCE,
492					 "CT Error Notification",
493					 "Connection process died: "
494					 "Pid: ~w, Address: ~tp, "
495					 "Callback: ~w\n"
496					 "Reason: ~ts\n\n",
497					 [Pid,A,CB,ErrorHtml]),
498		    catch CB:close(Pid),
499		    %% in case CB:close failed to do this:
500		    unregister_connection(Pid),
501		    loop(Mode,TestData,StartDir);
502		_ ->
503		    %% Let process crash in case of error, this shouldn't happen!
504		    io:format("\n\nct_util_server got EXIT "
505			      "from ~w: ~tp\n\n", [Pid,Reason]),
506		    ok = file:set_cwd(StartDir),
507		    exit(Reason)
508	    end
509    end.
510
511close_connections([#conn{handle=Handle,callback=CB}|Conns]) ->
512    CB:close(Handle),
513    close_connections(Conns);
514close_connections([]) ->
515    ok.
516
517get_key_from_name(Name)->
518    ct_config:get_key_from_name(Name).
519
520%%%-----------------------------------------------------------------
521%%% -spec register_connection(TargetName,Address,Callback,Handle) ->
522%%%                                              ok | {error,Reason}
523%%%      TargetName = ct:target_name()
524%%%      Address = term()
525%%%      Callback = atom()
526%%%      Handle = term
527%%%
528%%% Register a new connection (tool-internal use only).
529%%%
530%%% This function can be called when a new connection is
531%%% established. The connection data is stored in the connection
532%%% table, and ct_util will close all registered connections when the
533%%% test is finished by calling Callback:close/1.
534register_connection(TargetName,Address,Callback,Handle) ->
535    %% If TargetName is a registered alias for a config
536    %% variable, use it as reference for the connection,
537    %% otherwise use the Handle value.
538    TargetRef =
539	case ct_config:get_key_from_name(TargetName) of
540	    {ok,_Key} ->
541		TargetName;
542	    _ ->
543		%% no config name associated with connection,
544		%% use handle for identification instead
545		Handle
546	end,
547    ets:insert(?conn_table,#conn{handle=Handle,
548				 targetref=TargetRef,
549				 address=Address,
550				 callback=Callback}),
551    ok.
552
553%%%-----------------------------------------------------------------
554%%% -spec unregister_connection(Handle) -> ok
555%%%      Handle = term
556%%%
557%%% Unregister a connection (tool-internal use only).
558%%%
559%%% This function should be called when a registered connection is
560%%% closed. It removes the connection data from the connection
561%%% table.
562unregister_connection(Handle) ->
563    ets:delete(?conn_table,Handle),
564    ok.
565
566
567%%%-----------------------------------------------------------------
568%%% -spec does_connection_exist(TargetName,Address,Callback) ->
569%%%                                              {ok,Handle} | false
570%%%      TargetName = ct:target_name()
571%%%      Address = address
572%%%      Callback = atom()
573%%%      Handle = term()
574%%%
575%%% Check if a connection already exists.
576does_connection_exist(TargetName,Address,Callback) ->
577    case ct_config:get_key_from_name(TargetName) of
578	{ok,_Key} ->
579	    case ets:select(?conn_table,[{#conn{handle='$1',
580						targetref=TargetName,
581						address=Address,
582						callback=Callback},
583					  [],
584					  ['$1']}]) of
585		[Handle] ->
586		    {ok,Handle};
587		[] ->
588		    false
589	    end;
590	_ ->
591	    false
592    end.
593
594%%%-----------------------------------------------------------------
595%%% -spec get_connection(TargetName,Callback) ->
596%%%                                {ok,Connection} | {error,Reason}
597%%%      TargetName = ct:target_name()
598%%%      Callback = atom()
599%%%      Connection = {Handle,Address}
600%%%      Handle = term()
601%%%      Address = term()
602%%%
603%%% Return the connection for Callback on the
604%%% given target (TargetName).
605get_connection(TargetName,Callback) ->
606    %% check that TargetName is a registered alias
607    case ct_config:get_key_from_name(TargetName) of
608	{ok,_Key} ->
609	    case ets:select(?conn_table,[{#conn{handle='$1',
610						address='$2',
611						targetref=TargetName,
612						callback=Callback},
613					  [],
614					  [{{'$1','$2'}}]}]) of
615		[Result] ->
616		    {ok,Result};
617		[] ->
618		    {error,no_registered_connection}
619	    end;
620	Error ->
621	    Error
622    end.
623
624%%%-----------------------------------------------------------------
625%%% -spec get_connections(ConnPid) ->
626%%%                                {ok,Connections} | {error,Reason}
627%%%      Connections = [Connection]
628%%%      Connection = {TargetName,Handle,Callback,Address}
629%%%      TargetName = ct:target_name() | undefined
630%%%      Handle = term()
631%%%      Callback = atom()
632%%%      Address = term()
633%%%
634%%% Get data for all connections associated with a particular
635%%% connection pid (see Callback:init/3).
636get_connections(ConnPid) ->
637    Conns = ets:tab2list(?conn_table),
638    lists:flatmap(fun(#conn{targetref=TargetName,
639			    handle=Handle,
640			    callback=Callback,
641			    address=Address}) ->
642			  case ct_gen_conn:get_conn_pid(Handle) of
643			      ConnPid when is_atom(TargetName) ->
644				  [{TargetName,Handle,
645				    Callback,Address}];
646			      ConnPid ->
647				  [{undefined,Handle,
648				   Callback,Address}];
649			      _ ->
650				  []
651			  end
652		  end, Conns).
653
654%%%-----------------------------------------------------------------
655%%% Equivalent to ct:get_target_name/1
656get_target_name(Handle) ->
657    case ets:select(?conn_table,[{#conn{handle=Handle,targetref='$1',_='_'},
658				  [],
659				  ['$1']}]) of
660	[TargetName] when is_atom(TargetName) ->
661	    {ok,TargetName};
662	_ ->
663	    {error,{unknown_connection,Handle}}
664    end.
665
666%%%-----------------------------------------------------------------
667%%% -spec close_connections() -> ok
668%%%
669%%% Close all open connections.
670close_connections() ->
671    close_connections(ets:tab2list(?conn_table)),
672    ok.
673
674%%%-----------------------------------------------------------------
675override_silence_all_connections() ->
676    Protocols = [telnet,ftp,rpc,snmp,ssh],
677    override_silence_connections(Protocols),
678    Protocols.
679
680override_silence_connections(Conns) when is_list(Conns) ->
681    Conns1 = lists:map(fun({C,B}) -> {C,B};
682			  (C)     -> {C,true}
683		       end, Conns),
684    set_testdata({override_silent_connections,Conns1}).
685
686get_overridden_silenced_connections() ->
687    case get_testdata(override_silent_connections) of
688	{error,_} ->
689	    undefined;
690	Conns ->      % list() or undefined
691	    Conns
692    end.
693
694delete_overridden_silenced_connections() ->
695    delete_testdata(override_silent_connections).
696
697silence_all_connections() ->
698    Protocols = [telnet,ftp,rpc,snmp],
699    silence_connections(Protocols),
700    Protocols.
701
702silence_connections(Conn) when is_tuple(Conn) ->
703    silence_connections([Conn]);
704silence_connections(Conn) when is_atom(Conn) ->
705    silence_connections([{Conn,true}]);
706silence_connections(Conns) when is_list(Conns) ->
707    Conns1 = lists:map(fun({C,B}) -> {C,B};
708			  (C)     -> {C,true}
709		       end, Conns),
710    set_testdata({silent_connections,Conns1}).
711
712is_silenced(Conn) ->
713    is_silenced(Conn, infinity).
714
715is_silenced(Conn, Timeout) ->
716    case get_testdata(silent_connections, Timeout) of
717	Conns when is_list(Conns) ->
718	    case lists:keysearch(Conn,1,Conns) of
719		{value,{Conn,true}} ->
720		    true;
721		_ ->
722		    false
723	    end;
724	Error = {error,_} ->
725	    Error;
726	_ ->
727	    false
728    end.
729
730reset_silent_connections() ->
731    delete_testdata(silent_connections).
732
733
734%%%-----------------------------------------------------------------
735%%% -spec stop(Info) -> ok
736%%%
737%%% Stop the ct_util_server and close all existing connections
738%%% (tool-internal use only).
739%%%
740%%% See ct.
741stop(Info) ->
742    case whereis(ct_util_server) of
743	undefined ->
744	    ok;
745	CtUtilPid ->
746	    Ref = monitor(process, CtUtilPid),
747	    call({stop,Info}),
748	    receive
749		{'DOWN',Ref,_,_,_} -> ok
750	    end
751    end.
752
753%%%-----------------------------------------------------------------
754%%% -spec update_last_run_index() -> ok
755%%%
756%%% Update ct_run.<timestamp>/index.html
757%%% (tool-internal use only).
758update_last_run_index() ->
759    call(update_last_run_index).
760
761
762%%%-----------------------------------------------------------------
763%%% -spec get_mode() -> Mode
764%%%   Mode = normal | interactive
765%%%
766%%% Return the current mode of the ct_util_server
767%%% (tool-internal use only).
768get_mode() ->
769    call(get_mode).
770
771%%%-----------------------------------------------------------------
772%%% Equivalent to ct:listenv/1
773listenv(Telnet) ->
774    case ct_telnet:send(Telnet,"listenv") of
775	ok ->
776	    {ok,Data,_} = ct_telnet:expect(Telnet,
777					   ["(^.+)=(.*$)"],
778					   [{timeout,seconds(3)},
779					    repeat]),
780	    {ok,[{Name,Val} || [_,Name,Val] <- Data]};
781	{error,Reason} ->
782	    {error,{could_not_send_command,Telnet,"listenv",Reason}}
783    end.
784
785%%%-----------------------------------------------------------------
786%%% Equivalent to ct:parse_table/1
787parse_table(Data) ->
788    {Heading, Rest} = get_headings(Data),
789    Lines = parse_row(Rest,[],size(Heading)),
790    {Heading,Lines}.
791
792get_headings(["|" ++ Headings | Rest]) ->
793    {remove_space(string:lexemes(Headings, "|"),[]), Rest};
794get_headings([_ | Rest]) ->
795    get_headings(Rest);
796get_headings([]) ->
797    {{},[]}.
798
799parse_row(["|" ++ _ = Row | T], Rows, NumCols) when NumCols > 1 ->
800    case string:lexemes(Row, "|") of
801	Values when length(Values) =:= NumCols ->
802	    parse_row(T,[remove_space(Values,[])|Rows], NumCols);
803	Values when length(Values) < NumCols ->
804	    parse_row([Row ++"\n"++ hd(T) | tl(T)], Rows, NumCols)
805    end;
806parse_row(["|" ++ X = Row | T], Rows, 1 = NumCols) ->
807    case string:find(X, [$|]) of
808	nomatch ->
809	    parse_row([Row ++"\n"++hd(T) | tl(T)], Rows, NumCols);
810	_Else ->
811	    parse_row(T, [remove_space(string:lexemes(Row,"|"),[])|Rows],
812		      NumCols)
813    end;
814parse_row([_Skip | T], Rows, NumCols) ->
815    parse_row(T, Rows, NumCols);
816parse_row([], Rows, _NumCols) ->
817    lists:reverse(Rows).
818
819remove_space([Str|Rest],Acc) ->
820    remove_space(Rest,[string:trim(string:trim(Str,both,[$\s]),both,[$'])|Acc]);
821remove_space([],Acc) ->
822    list_to_tuple(lists:reverse(Acc)).
823
824
825%%%-----------------------------------------------------------------
826is_test_dir(Dir) ->
827    lists:last(string:lexemes(filename:basename(Dir), "_")) == "test".
828
829%%%-----------------------------------------------------------------
830get_testdir(Dir, all) ->
831    Abs = abs_name(Dir),
832    case is_test_dir(Abs) of
833	true ->
834	    Abs;
835	false ->
836	    AbsTest = filename:join(Abs, "test"),
837	    case filelib:is_dir(AbsTest) of
838		true -> AbsTest;
839		false -> Abs
840	    end
841    end;
842
843get_testdir(Dir, [Suite | _]) when is_atom(Suite) ->
844    get_testdir(Dir, atom_to_list(Suite));
845
846get_testdir(Dir, [Suite | _]) when is_list(Suite) ->
847    get_testdir(Dir, Suite);
848
849get_testdir(Dir, Suite) when is_atom(Suite) ->
850    get_testdir(Dir, atom_to_list(Suite));
851
852get_testdir(Dir, Suite) when is_list(Suite) ->
853    Abs = abs_name(Dir),
854    case is_test_dir(Abs) of
855	true ->
856	    Abs;
857	false ->
858	    AbsTest = filename:join(Abs, "test"),
859	    Mod = case filename:extension(Suite) of
860		      ".erl" -> Suite;
861		      _ -> Suite ++ ".erl"
862		  end,
863	    case filelib:is_file(filename:join(AbsTest, Mod)) of
864		true -> AbsTest;
865		false -> Abs
866	    end
867    end;
868
869get_testdir(Dir, _) ->
870    get_testdir(Dir, all).
871
872%%%-----------------------------------------------------------------
873get_attached(TCPid) ->
874    case dbg_iserver:safe_call({get_attpid,TCPid}) of
875	{ok,AttPid} when is_pid(AttPid) ->
876	    AttPid;
877	_ ->
878	    undefined
879    end.
880
881%%%-----------------------------------------------------------------
882kill_attached(undefined,_AttPid) ->
883    ok;
884kill_attached(_TCPid,undefined) ->
885    ok;
886kill_attached(TCPid,AttPid) ->
887    case process_info(TCPid) of
888	undefined ->
889	    exit(AttPid,kill);
890	_ ->
891	    ok
892    end.
893
894
895%%%-----------------------------------------------------------------
896warn_duplicates(Suites) ->
897    Warn =
898	fun(Mod) ->
899		case catch apply(Mod,sequences,[]) of
900		    {'EXIT',_} ->
901			ok;
902		    [] ->
903			ok;
904		    _ ->
905			io:format(?def_gl,
906				  "~nWARNING! Deprecated function: ~w:sequences/0.~n"
907				  "         Use group with sequence property instead.~n",[Mod])
908		end
909	end,
910    lists:foreach(Warn, Suites),
911    ok.
912
913%%%-----------------------------------------------------------------
914mark_process() ->
915    mark_process(system).
916
917mark_process(Type) ->
918    put(ct_process_type, Type).
919
920is_marked(Pid) ->
921    is_marked(Pid, system).
922
923is_marked(Pid, Type) ->
924    case process_info(Pid, dictionary) of
925        {dictionary,List} ->
926            Type == proplists:get_value(ct_process_type, List);
927        undefined ->
928            false
929    end.
930
931remaining_test_procs() ->
932    Procs = processes(),
933    {SharedGL,OtherGLs,Procs2} =
934        lists:foldl(
935          fun(Pid, ProcTypes = {Shared,Other,Procs1}) ->
936                  case is_marked(Pid, group_leader) of
937                      true ->
938                          if not is_pid(Shared) ->
939                                  case test_server_io:get_gl(true) of
940                                      Pid ->
941                                          {Pid,Other,
942                                           lists:delete(Pid,Procs1)};
943                                      _ ->
944                                          {Shared,[Pid|Other],Procs1}
945                                  end;
946                             true ->          % SharedGL already found
947                                  {Shared,[Pid|Other],Procs1}
948                          end;
949                      false ->
950                          case is_marked(Pid) of
951                              true ->
952                                  {Shared,Other,lists:delete(Pid,Procs1)};
953                              false ->
954                                  ProcTypes
955                          end
956                  end
957          end, {undefined,[],Procs}, Procs),
958
959    AllGLs = [SharedGL | OtherGLs],
960    TestProcs =
961        lists:flatmap(fun(Pid) ->
962                              case process_info(Pid, group_leader) of
963                                  {group_leader,GL} ->
964                                      case lists:member(GL, AllGLs) of
965                                          true  -> [{Pid,GL}];
966                                          false -> []
967                                      end;
968                                  undefined ->
969                                      []
970                              end
971                      end, Procs2),
972    {TestProcs, SharedGL, OtherGLs}.
973
974%%%-----------------------------------------------------------------
975get_profile_data() ->
976    get_profile_data(all).
977
978get_profile_data(KeyOrStartDir) ->
979    if is_atom(KeyOrStartDir) ->
980	    get_profile_data(KeyOrStartDir, get_start_dir());
981       is_list(KeyOrStartDir) ->
982	    get_profile_data(all, KeyOrStartDir)
983    end.
984
985get_profile_data(Key, StartDir) ->
986    Profile = case application:get_env(common_test, profile) of
987		  {ok,undefined} -> default;
988		  {ok,Prof}      -> Prof;
989		  _              -> default
990	      end,
991    get_profile_data(Profile, Key, StartDir).
992
993get_profile_data(Profile, Key, StartDir) ->
994    File = case Profile of
995	       default ->
996		   ?ct_profile_file;
997	       _ when is_list(Profile) ->
998		   ?ct_profile_file ++ "." ++ Profile;
999	       _ when is_atom(Profile) ->
1000		   ?ct_profile_file ++ "." ++ atom_to_list(Profile)
1001	   end,
1002    FullNameWD = filename:join(StartDir, File),
1003    {WhichFile,Result} =
1004	case file:consult(FullNameWD) of
1005	    {error,enoent} ->
1006		case init:get_argument(home) of
1007		    {ok,[[HomeDir]]} ->
1008			FullNameHome = filename:join(HomeDir, File),
1009			{FullNameHome,file:consult(FullNameHome)};
1010		    _ ->
1011			{File,{error,enoent}}
1012		end;
1013	    Consulted ->
1014		{FullNameWD,Consulted}
1015	end,
1016    case Result of
1017	{error,enoent} when Profile /= default ->
1018	    io:format(?def_gl, "~nERROR! Missing profile file ~tp~n", [File]),
1019	    undefined;
1020	{error,enoent} when Profile == default ->
1021	    undefined;
1022	{error,Reason} ->
1023	    io:format(?def_gl,"~nERROR! Error in profile file ~tp: ~tp~n",
1024		      [WhichFile,Reason]),
1025	    undefined;
1026	{ok,Data} ->
1027	    Data1 = case Data of
1028			[List] when is_list(List) ->
1029			    List;
1030			_ when is_list(Data) ->
1031			    Data;
1032			_ ->
1033			    io:format(?def_gl,
1034				      "~nERROR! Invalid profile data in ~tp~n",
1035				      [WhichFile]),
1036			    []
1037		    end,
1038	    if Key == all ->
1039		    Data1;
1040	       true ->
1041		    proplists:get_value(Key, Data)
1042	    end
1043    end.
1044
1045%%%-----------------------------------------------------------------
1046%%% Internal functions
1047call(Msg) ->
1048    call(Msg, infinity).
1049
1050call(Msg, Timeout) ->
1051    case {self(),whereis(ct_util_server)} of
1052	{_,undefined} ->
1053	    {error,ct_util_server_not_running};
1054	{Pid,Pid} ->
1055	    %% the caller is ct_util_server, which must
1056	    %% be a mistake
1057	    {error,bad_invocation};
1058	{Self,Pid} ->
1059	    MRef = erlang:monitor(process, Pid),
1060	    Ref = make_ref(),
1061	    ct_util_server ! {Msg,{Self,Ref}},
1062	    receive
1063		{Ref, Result} ->
1064		    erlang:demonitor(MRef, [flush]),
1065		    Result;
1066		{'DOWN',MRef,process,_,Reason}  ->
1067		    {error,{ct_util_server_down,Reason}}
1068	    after
1069		Timeout -> {error,timeout}
1070	    end
1071    end.
1072
1073return({To,Ref},Result) ->
1074    To ! {Ref, Result},
1075    ok.
1076
1077cast(Msg) ->
1078    ct_util_server ! {Msg, {ct_util_server, make_ref()}},
1079    ok.
1080
1081seconds(T) ->
1082    test_server:seconds(T).
1083
1084abs_name("/") ->
1085    "/";
1086abs_name(Dir0) ->
1087    Abs = filename:absname(Dir0),
1088    Dir = case lists:reverse(Abs) of
1089	      [$/|Rest] -> lists:reverse(Rest);
1090	      _ -> Abs
1091	  end,
1092    abs_name1(Dir,[]).
1093
1094abs_name1([Drv,$:,$/],Acc) ->
1095    Split = [[Drv,$:,$/]|Acc],
1096    abs_name2(Split,[]);
1097abs_name1("/",Acc) ->
1098    Split = ["/"|Acc],
1099    abs_name2(Split,[]);
1100abs_name1(Dir,Acc) ->
1101    abs_name1(filename:dirname(Dir),[filename:basename(Dir)|Acc]).
1102
1103abs_name2([".."|T],[_|Acc]) ->
1104    abs_name2(T,Acc);
1105abs_name2(["."|T],Acc) ->
1106    abs_name2(T,Acc);
1107abs_name2([H|T],Acc) ->
1108    abs_name2(T,[H|Acc]);
1109abs_name2([],Acc) ->
1110    filename:join(lists:reverse(Acc)).
1111
1112open_url(iexplore, Args, URL) ->
1113    {ok,R} = win32reg:open([read]),
1114    ok = win32reg:change_key(R,"applications\\iexplore.exe\\shell\\open\\command"),
1115    _ = case win32reg:values(R) of
1116	{ok, Paths} ->
1117	    Path = proplists:get_value(default, Paths),
1118	    [Cmd | _] = string:lexemes(Path, "%"),
1119	    Cmd1 = Cmd ++ " " ++ Args ++ " " ++ URL,
1120	    io:format(?def_gl, "~nOpening ~ts with command:~n  ~ts~n", [URL,Cmd1]),
1121	    open_port({spawn,Cmd1}, []);
1122	_ ->
1123	    io:format(?def_gl, "~nNo path to iexplore.exe~n",[])
1124    end,
1125    win32reg:close(R),
1126    ok;
1127
1128open_url(Prog, Args, URL) ->
1129    ProgStr = if is_atom(Prog) -> atom_to_list(Prog);
1130		 is_list(Prog) -> Prog
1131	      end,
1132    Cmd = ProgStr ++ " " ++ Args ++ " " ++ URL,
1133    io:format(?def_gl, "~nOpening ~ts with command:~n  ~ts~n", [URL,Cmd]),
1134    open_port({spawn,Cmd},[]),
1135    ok.
1136