aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src/test_server_node.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server/src/test_server_node.erl')
-rw-r--r--lib/test_server/src/test_server_node.erl1013
1 files changed, 1013 insertions, 0 deletions
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
new file mode 100644
index 0000000000..ddc89d50d4
--- /dev/null
+++ b/lib/test_server/src/test_server_node.erl
@@ -0,0 +1,1013 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(test_server_node).
+-compile(r11).
+
+%%%
+%%% The same compiled code for this module must be possible to load
+%%% in R11B, R12B and later. To make that possible no bit syntax
+%%% must be used.
+%%%
+
+
+%% Test Controller interface
+-export([is_release_available/1]).
+-export([start_remote_main_target/1,stop/1]).
+-export([start_tracer_node/2,trace_nodes/2,stop_tracer_node/1]).
+-export([start_node/5, stop_node/2]).
+-export([kill_nodes/1, nodedown/2]).
+%% Internal export
+-export([node_started/1,trc/1,handle_debug/4]).
+
+-include("test_server_internal.hrl").
+-record(slave_info, {name,socket,client}).
+-define(VXWORKS_ACCEPT_TIMEOUT,?ACCEPT_TIMEOUT).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% %%%
+%%% All code in this module executes on the test_server_ctrl process %%%
+%%% except for node_started/1 and trc/1 which execute on a new node. %%%
+%%% %%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+is_release_available(Rel) when is_atom(Rel) ->
+ is_release_available(atom_to_list(Rel));
+is_release_available(Rel) ->
+ case os:type() of
+ {unix,_} ->
+ Erl = find_release(Rel),
+ case Erl of
+ none -> false;
+ _ -> filelib:is_regular(Erl)
+ end;
+ _ ->
+ false
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Start main target node on remote host
+%%% The target node must not know the controller node via erlang distribution.
+start_remote_main_target(Parameters) ->
+ #par{type=TargetType,
+ target=TargetHost,
+ naming=Naming,
+ master=MasterNode,
+ cookie=MasterCookie,
+ slave_targets=SlaveTargets} = Parameters,
+
+ lists:foreach(fun(T) -> maybe_reboot_target({TargetType,T}) end,
+ [list_to_atom(TargetHost)|SlaveTargets]),
+
+ % Must give the targets a chance to reboot...
+ case TargetType of
+ vxworks ->
+ receive after 15000 -> ok end;
+ _ ->
+ ok
+ end,
+
+ Cmd0 = get_main_target_start_command(TargetType,TargetHost,Naming,
+ MasterNode,MasterCookie),
+ Cmd =
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ false -> Cmd0;
+ FW -> Cmd0 ++ " -env TEST_SERVER_FRAMEWORK " ++ FW
+ end,
+
+ {ok,LSock} = gen_tcp:listen(?MAIN_PORT,[binary,{reuseaddr,true},{packet,2}]),
+ case start_target(TargetType,TargetHost,Cmd) of
+ {ok,TargetClient,AcceptTimeout} ->
+ case gen_tcp:accept(LSock,AcceptTimeout) of
+ {ok,Sock} ->
+ gen_tcp:close(LSock),
+ receive
+ {tcp,Sock,Bin} when is_binary(Bin) ->
+ case unpack(Bin) of
+ error ->
+ gen_tcp:close(Sock),
+ close_target_client(TargetClient),
+ {error,bad_message};
+ {ok,{target_info,TI}} ->
+ put(test_server_free_targets,SlaveTargets),
+ {ok, TI#target_info{where=Sock,
+ host=TargetHost,
+ naming=Naming,
+ master=MasterNode,
+ target_client=TargetClient,
+ slave_targets=SlaveTargets}}
+ end;
+ {tcp_closed,Sock} ->
+ gen_tcp:close(Sock),
+ close_target_client(TargetClient),
+ {error,could_not_contact_target}
+ after AcceptTimeout ->
+ gen_tcp:close(Sock),
+ close_target_client(TargetClient),
+ {error,timeout}
+ end;
+ Error ->
+ %%! maybe something like kill_target(...)???
+ gen_tcp:close(LSock),
+ close_target_client(TargetClient),
+ {error,{could_not_contact_target,Error}}
+ end;
+ Error ->
+ gen_tcp:close(LSock),
+ {error,{could_not_start_target,Error}}
+ end.
+
+stop(TI) ->
+ kill_nodes(TI),
+ case TI#target_info.where of
+ local -> % there is no remote target to stop
+ ok;
+ Sock -> % stop remote target
+ gen_tcp:close(Sock),
+ close_target_client(TI#target_info.target_client)
+ end.
+
+nodedown(Sock, TI) ->
+ Match = #slave_info{name='$1',socket=Sock,client='$2',_='_'},
+ case ets:match(slave_tab,Match) of
+ [[Node,Client]] -> % Slave node died
+ gen_tcp:close(Sock),
+ ets:delete(slave_tab,Node),
+ close_target_client(Client),
+ HostAtom = test_server_sup:hostatom(Node),
+ case lists:member(HostAtom,TI#target_info.slave_targets) of
+ true ->
+ put(test_server_free_targets,
+ get(test_server_free_targets) ++ [HostAtom]);
+ false -> ok
+ end,
+ slave_died;
+ [] ->
+ case TI#target_info.where of
+ Sock ->
+ %% test_server_ctrl will do the cleanup
+ target_died;
+ _ ->
+ ignore
+ end
+ end.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Start trace node
+%%%
+start_tracer_node(TraceFile,TI) ->
+ Match = #slave_info{name='$1',_='_'},
+ SlaveNodes = lists:map(fun([N]) -> [" ",N] end,
+ ets:match(slave_tab,Match)),
+ TargetNode = case TI#target_info.where of
+ local -> node();
+ _ -> "test_server@" ++ TI#target_info.host
+ end,
+ Cookie = TI#target_info.cookie,
+ {ok,LSock} = gen_tcp:listen(0,[binary,{reuseaddr,true},{packet,2}]),
+ {ok,TracePort} = inet:port(LSock),
+ Prog = pick_erl_program(default),
+ Cmd = lists:concat([Prog, " -sname tracer -hidden -setcookie ", Cookie,
+ " -s ", ?MODULE, " trc ", TraceFile, " ",
+ TracePort, " ", TI#target_info.os_family]),
+ spawn(fun() -> print_data(open_port({spawn,Cmd},[stream])) end),
+%! open_port({spawn,Cmd},[stream]),
+ case gen_tcp:accept(LSock,?ACCEPT_TIMEOUT) of
+ {ok,Sock} ->
+ gen_tcp:close(LSock),
+ receive
+ {tcp,Sock,Result} when is_binary(Result) ->
+ case unpack(Result) of
+ error ->
+ gen_tcp:close(Sock),
+ {error,timeout};
+ {ok,started} ->
+ trace_nodes(Sock,[TargetNode | SlaveNodes]),
+ {ok,Sock};
+ {ok,Error} -> Error
+ end;
+ {tcp_closed,Sock} ->
+ gen_tcp:close(Sock),
+ {error,could_not_start_tracernode}
+ after ?ACCEPT_TIMEOUT ->
+ gen_tcp:close(Sock),
+ {error,timeout}
+ end;
+ Error ->
+ gen_tcp:close(LSock),
+ {error,{could_not_start_tracernode,Error}}
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Start a tracer on each of these nodes and set flags and patterns
+%%%
+trace_nodes(Sock,Nodes) ->
+ Bin = term_to_binary({add_nodes,Nodes}),
+ ok = gen_tcp:send(Sock, [1|Bin]),
+ receive_ack(Sock).
+
+
+receive_ack(Sock) ->
+ receive
+ {tcp,Sock,Bin} when is_binary(Bin) ->
+ case unpack(Bin) of
+ error -> receive_ack(Sock);
+ {ok,_} -> ok
+ end;
+ _ ->
+ receive_ack(Sock)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Stop trace node
+%%%
+stop_tracer_node(Sock) ->
+ Bin = term_to_binary(id(stop)),
+ ok = gen_tcp:send(Sock, [1|Bin]),
+ receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end,
+ ok.
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% trc([TraceFile,Nodes]) -> ok
+%%
+%% Start tracing on the given nodes
+%%
+%% This function executes on the new node
+%%
+trc([TraceFile, PortAtom, Type]) ->
+ {Result,Patterns} =
+ case file:consult(TraceFile) of
+ {ok,TI} ->
+ Pat = parse_trace_info(lists:flatten(TI)),
+ {started,Pat};
+ Error ->
+ {Error,[]}
+ end,
+ Port = list_to_integer(atom_to_list(PortAtom)),
+ case catch gen_tcp:connect("localhost", Port, [binary,
+ {reuseaddr,true},
+ {packet,2}]) of
+ {ok,Sock} ->
+ BinResult = term_to_binary(Result),
+ ok = gen_tcp:send(Sock,[1|BinResult]),
+ trc_loop(Sock,Patterns,Type);
+ _else ->
+ ok
+ end,
+ erlang:halt().
+trc_loop(Sock,Patterns,Type) ->
+ receive
+ {tcp,Sock,Bin} ->
+ case unpack(Bin) of
+ error ->
+ ttb:stop(),
+ gen_tcp:close(Sock);
+ {ok,{add_nodes,Nodes}} ->
+ add_nodes(Nodes,Patterns,Type),
+ Bin = term_to_binary(id(ok)),
+ ok = gen_tcp:send(Sock, [1|Bin]),
+ trc_loop(Sock,Patterns,Type);
+ {ok,stop} ->
+ ttb:stop(),
+ gen_tcp:close(Sock)
+ end;
+ {tcp_closed,Sock} ->
+ ttb:stop(),
+ gen_tcp:close(Sock)
+ end.
+add_nodes(Nodes,Patterns,_Type) ->
+ ttb:tracer(Nodes,[{file,{local, test_server}},
+ {handler, {{?MODULE,handle_debug},initial}}]),
+ ttb:p(all,[call,timestamp]),
+ lists:foreach(fun({TP,M,F,A,Pat}) -> ttb:TP(M,F,A,Pat);
+ ({CTP,M,F,A}) -> ttb:CTP(M,F,A)
+ end,
+ Patterns).
+
+parse_trace_info([{TP,M,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
+ [{TP,M,'_','_',Pat}|parse_trace_info(Pats)];
+parse_trace_info([{TP,M,F,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
+ [{TP,M,F,'_',Pat}|parse_trace_info(Pats)];
+parse_trace_info([{TP,M,F,A,Pat}|Pats]) when TP=:=tp; TP=:=tpl ->
+ [{TP,M,F,A,Pat}|parse_trace_info(Pats)];
+parse_trace_info([CTP|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
+ [{CTP,'_','_','_'}|parse_trace_info(Pats)];
+parse_trace_info([{CTP,M}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
+ [{CTP,M,'_','_'}|parse_trace_info(Pats)];
+parse_trace_info([{CTP,M,F}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
+ [{CTP,M,F,'_'}|parse_trace_info(Pats)];
+parse_trace_info([{CTP,M,F,A}|Pats]) when CTP=:=ctp; CTP=:=ctpl; CTP=:=ctpg ->
+ [{CTP,M,F,A}|parse_trace_info(Pats)];
+parse_trace_info([]) ->
+ [];
+parse_trace_info([_other|Pats]) -> % ignore
+ parse_trace_info(Pats).
+
+handle_debug(Out,Trace,TI,initial) ->
+ handle_debug(Out,Trace,TI,0);
+handle_debug(_Out,end_of_trace,_TI,N) ->
+ N;
+handle_debug(Out,Trace,_TI,N) ->
+ print_trc(Out,Trace,N),
+ N+1.
+
+print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) ->
+ io:format(Out,
+ "~w: ~s~n"
+ "Process : ~w~n"
+ "Call : ~w:~w/~w~n"
+ "Arguments : ~p~n"
+ "Caller : ~w~n~n",
+ [N,ts(Ts),P,M,F,length(A),A,C]);
+print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) ->
+ io:format(Out,
+ "~w: ~s~n"
+ "Process : ~w~n"
+ "Call : ~w:~w/~w~n"
+ "Arguments : ~p~n~n",
+ [N,ts(Ts),P,M,F,length(A),A]);
+print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) ->
+ io:format(Out,
+ "~w: ~s~n"
+ "Process : ~w~n"
+ "Return from : ~w:~w/~w~n"
+ "Return value : ~p~n~n",
+ [N,ts(Ts),P,M,F,A,R]);
+print_trc(Out,{drop,X},N) ->
+ io:format(Out,
+ "~w: Tracer dropped ~w messages - too busy~n~n",
+ [N,X]);
+print_trc(Out,Trace,N) ->
+ Ts = element(size(Trace),Trace),
+ io:format(Out,
+ "~w: ~s~n"
+ "Trace : ~p~n~n",
+ [N,ts(Ts),Trace]).
+ts({_, _, Micro} = Now) ->
+ {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now),
+ io_lib:format("~4.4.0w-~2.2.0w-~2.2.0w ~2.2.0w:~2.2.0w:~2.2.0w,~6.6.0w",
+ [Y,M,D,H,Min,S,Micro]).
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Start slave/peer nodes (initiated by test_server:start_node/5)
+%%%
+start_node(SlaveName, slave, Options, From, TI) when is_list(SlaveName) ->
+ start_node_slave(list_to_atom(SlaveName), Options, From, TI);
+start_node(SlaveName, slave, Options, From, TI) ->
+ start_node_slave(SlaveName, Options, From, TI);
+start_node(SlaveName, peer, Options, From, TI) when is_atom(SlaveName) ->
+ start_node_peer(atom_to_list(SlaveName), Options, From, TI);
+start_node(SlaveName, peer, Options, From, TI) ->
+ start_node_peer(SlaveName, Options, From, TI);
+start_node(_SlaveName, _Type, _Options, _From, _TI) ->
+ not_implemented_yet.
+
+%%
+%% Peer nodes are always started on the same host as test_server_ctrl
+%% Socket communication is used in case target and controller is
+%% not the same node (target must not know the controller node
+%% via erlang distribution)
+%%
+start_node_peer(SlaveName, OptList, From, TI) ->
+ SuppliedArgs = start_node_get_option_value(args, OptList, []),
+ Cleanup = start_node_get_option_value(cleanup, OptList, true),
+ HostStr = test_server_sup:hoststr(),
+ {ok,LSock} = gen_tcp:listen(0,[binary,
+ {reuseaddr,true},
+ {packet,2}]),
+ {ok,WaitPort} = inet:port(LSock),
+ NodeStarted = lists:concat([" -s ", ?MODULE, " node_started ",
+ HostStr, " ", WaitPort]),
+
+ % Support for erl_crash_dump files..
+ CrashFile = filename:join([TI#target_info.test_server_dir,
+ "erl_crash_dump."++cast_to_list(SlaveName)]),
+ CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]),
+ FailOnError = start_node_get_option_value(fail_on_error, OptList, true),
+ Pa = TI#target_info.test_server_dir,
+ Prog0 = start_node_get_option_value(erl, OptList, default),
+ Prog = pick_erl_program(Prog0),
+ Args =
+ case string:str(SuppliedArgs,"-setcookie") of
+ 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs;
+ _ -> SuppliedArgs
+ end,
+ Cmd = lists:concat([Prog,
+ " -detached ",
+ TI#target_info.naming, " ", SlaveName,
+ " -pa ", Pa,
+ NodeStarted,
+ CrashArgs,
+ " ", Args]),
+ Opts = case start_node_get_option_value(env, OptList, []) of
+ [] -> [];
+ Env -> [{env, Env}]
+ end,
+ %% peer is always started on localhost
+ %%
+ %% Bad environment can cause open port to fail. If this happens,
+ %% we ignore it and let the testcase handle the situation...
+ catch open_port({spawn, Cmd}, [stream|Opts]),
+
+ case start_node_get_option_value(wait, OptList, true) of
+ true ->
+ Ret = wait_for_node_started(LSock,60000,undefined,Cleanup,TI,self()),
+ case {Ret,FailOnError} of
+ {{{ok, Node}, Warning},_} ->
+ gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning});
+ {_,false} ->
+ gen_server:reply(From,{Ret, HostStr, Cmd});
+ {_,true} ->
+ gen_server:reply(From,{fail,{Ret, HostStr, Cmd}})
+ end;
+ false ->
+ Nodename = list_to_atom(SlaveName ++ "@" ++ HostStr),
+ I = "=== Not waiting for node",
+ gen_server:reply(From,{{ok, Nodename}, HostStr, Cmd, I, []}),
+ Self = self(),
+ spawn_link(
+ fun() ->
+ wait_for_node_started(LSock,60000,undefined,
+ Cleanup,TI,Self),
+ receive after infinity -> ok end
+ end),
+ ok
+ end.
+
+%%
+%% Slave nodes are started on a remote host if
+%% - the option remote is given when calling test_server:start_node/3
+%% or
+%% - the target type is vxworks, since only one erlang node
+%% can be started on each vxworks host.
+%%
+start_node_slave(SlaveName, OptList, From, TI) ->
+ SuppliedArgs = start_node_get_option_value(args, OptList, []),
+ Cleanup = start_node_get_option_value(cleanup, OptList, true),
+
+ CrashFile = filename:join([TI#target_info.test_server_dir,
+ "erl_crash_dump."++cast_to_list(SlaveName)]),
+ CrashArgs = lists:concat([" -env ERL_CRASH_DUMP ",CrashFile," "]),
+ Pa = TI#target_info.test_server_dir,
+ Args = lists:concat([" -pa ", Pa, " ", SuppliedArgs, CrashArgs]),
+
+ Prog0 = start_node_get_option_value(erl, OptList, default),
+ Prog = pick_erl_program(Prog0),
+ Ret =
+ case start_which_node(OptList) of
+ {error,Reason} -> {{error,Reason},undefined,undefined};
+ Host0 -> do_start_node_slave(Host0,SlaveName,Args,Prog,Cleanup,TI)
+ end,
+ gen_server:reply(From,Ret).
+
+
+do_start_node_slave(Host0, SlaveName, Args, Prog, Cleanup, TI) ->
+ case TI#target_info.where of
+ local ->
+ Host =
+ case Host0 of
+ local -> test_server_sup:hoststr();
+ _ -> cast_to_list(Host0)
+ end,
+ Cmd = Prog ++ " " ++ Args,
+ %% Can use slave.erl here because I'm both controller and target
+ %% so I will ping the new node anyway
+ case slave:start(Host, SlaveName, Args, no_link, Prog) of
+ {ok,Nodename} ->
+ case Cleanup of
+ true -> ets:insert(slave_tab,#slave_info{name=Nodename});
+ false -> ok
+ end,
+ {{ok,Nodename}, Host, Cmd, [], []};
+ Ret ->
+ {Ret, Host, Cmd}
+ end;
+
+ _Sock ->
+ %% Cannot use slave.erl here because I'm only controller, and will
+ %% not ping the new node. Only target shall contact the new node!!
+ no_contact_start_slave(Host0,SlaveName,Args,Prog,Cleanup,TI)
+ end.
+
+
+
+no_contact_start_slave(Host, Name, Args0, Prog, Cleanup,TI) ->
+ Args1 = case string:str(Args0,"-setcookie") of
+ 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ Args0;
+ _ -> Args0
+ end,
+ Args = TI#target_info.naming ++ " " ++ cast_to_list(Name) ++ " " ++ Args1,
+ case Host of
+ local ->
+ case get(test_server_free_targets) of
+ [] ->
+ io:format("Starting slave ~p on HOST~n", [Name]),
+ TargetType = test_server_sup:get_os_family(),
+ Cmd0 = get_slave_node_start_command(TargetType,
+ Prog,
+ TI#target_info.master),
+ Cmd = Cmd0 ++ " " ++ Args,
+ do_no_contact_start_slave(TargetType,
+ test_server_sup:hoststr(),
+ Cmd, Cleanup,TI, false);
+ [H|T] ->
+ TargetType = TI#target_info.os_family,
+ Cmd0 = get_slave_node_start_command(TargetType,
+ Prog,
+ TI#target_info.master),
+ Cmd = Cmd0 ++ " " ++ Args,
+ case do_no_contact_start_slave(TargetType,H,Cmd,Cleanup,
+ TI,true) of
+ {error,remove} ->
+ io:format("Cannot start node on ~p, "
+ "removing from slave "
+ "target list.", [H]),
+ put(test_server_free_targets,T),
+ no_contact_start_slave(Host,Name,Args,Prog,
+ Cleanup,TI);
+ {error,keep} ->
+ %% H is added to the END OF THE LIST
+ %% in order to avoid the same target to
+ %% be selected each time
+ put(test_server_free_targets,T++[H]),
+ no_contact_start_slave(Host,Name,Args,Prog,
+ Cleanup,TI);
+ R ->
+ put(test_server_free_targets,T),
+ R
+ end
+ end;
+ _ ->
+ TargetType = TI#target_info.os_family,
+ Cmd0 = get_slave_node_start_command(TargetType,
+ Prog,
+ TI#target_info.master),
+ Cmd = Cmd0 ++ " " ++ Args,
+ do_no_contact_start_slave(TargetType, Host, Cmd, Cleanup, TI, false)
+ end.
+
+do_no_contact_start_slave(TargetType,Host0,Cmd0,Cleanup,TI,Retry) ->
+ %% Must use TargetType instead of TI#target_info.os_familiy here
+ %% because if there were no free_targets we will be starting the
+ %% slave node on host which might have a different os_familiy
+ Host = cast_to_list(Host0),
+ {ok,LSock} = gen_tcp:listen(0,[binary,
+ {reuseaddr,true},
+ {packet,2}]),
+ {ok,WaitPort} = inet:port(LSock),
+ Cmd = lists:concat([Cmd0, " -s ", ?MODULE, " node_started ",
+ test_server_sup:hoststr(), " ", WaitPort]),
+
+ case start_target(TargetType,Host,Cmd) of
+ {ok,Client,AcceptTimeout} ->
+ case wait_for_node_started(LSock,AcceptTimeout,
+ Client,Cleanup,TI,self()) of
+ {error,_}=WaitError ->
+ if Retry ->
+ case maybe_reboot_target(Client) of
+ {error,_} -> {error,remove};
+ ok -> {error,keep}
+ end;
+ true ->
+ {WaitError,Host,Cmd}
+ end;
+ {Ok,Warning} ->
+ {Ok,Host,Cmd,[],Warning}
+ end;
+ StartError ->
+ gen_tcp:close(LSock),
+ if Retry -> {error,remove};
+ true -> {{error,{could_not_start_target,StartError}},Host,Cmd}
+ end
+ end.
+
+
+wait_for_node_started(LSock,Timeout,Client,Cleanup,TI,CtrlPid) ->
+ case gen_tcp:accept(LSock,Timeout) of
+ {ok,Sock} ->
+ gen_tcp:close(LSock),
+ receive
+ {tcp,Sock,Started0} when is_binary(Started0) ->
+ case unpack(Started0) of
+ error ->
+ gen_tcp:close(Sock),
+ {error, connection_closed};
+ {ok,Started} ->
+ Version = TI#target_info.otp_release,
+ VsnStr = TI#target_info.system_version,
+ {ok,Nodename, W} =
+ handle_start_node_return(Version,
+ VsnStr,
+ Started),
+ case Cleanup of
+ true ->
+ ets:insert(slave_tab,#slave_info{name=Nodename,
+ socket=Sock,
+ client=Client});
+ false -> ok
+ end,
+ gen_tcp:controlling_process(Sock,CtrlPid),
+ test_server_ctrl:node_started(Nodename),
+ {{ok,Nodename},W}
+ end;
+ {tcp_closed,Sock} ->
+ gen_tcp:close(Sock),
+ {error, connection_closed}
+ after Timeout ->
+ gen_tcp:close(Sock),
+ {error, timeout}
+ end;
+ {error,Reason} ->
+ gen_tcp:close(LSock),
+ {error, {no_connection,Reason}}
+ end.
+
+
+
+handle_start_node_return(Version,VsnStr,{started, Node, Version, VsnStr}) ->
+ {ok, Node, []};
+handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) ->
+ Str = io_lib:format("WARNING: Started node "
+ "reports different system "
+ "version than current node! "
+ "Current node version: ~p, ~p "
+ "Started node version: ~p, ~p",
+ [Version, VsnStr,
+ OVersion, OVsnStr]),
+ Str1 = lists:flatten(Str),
+ {ok, Node, Str1}.
+
+
+%%
+%% This function executes on the new node
+%%
+node_started([Host,PortAtom]) ->
+ %% Must spawn a new process because the boot process should not
+ %% hang forever!!
+ spawn(fun() -> node_started(Host,PortAtom) end).
+
+%% This process hangs forever, just waiting for the socket to be
+%% closed and terminating the node
+node_started(Host,PortAtom) ->
+ {_, Version} = init:script_id(),
+ VsnStr = erlang:system_info(system_version),
+ Port = list_to_integer(atom_to_list(PortAtom)),
+ case catch gen_tcp:connect(Host,Port, [binary,
+ {reuseaddr,true},
+ {packet,2}]) of
+
+ {ok,Sock} ->
+ Started = term_to_binary({started, node(), Version, VsnStr}),
+ ok = gen_tcp:send(Sock, [1|Started]),
+ receive _Anyting ->
+ gen_tcp:close(Sock),
+ erlang:halt()
+ end;
+ _else ->
+ erlang:halt()
+ end.
+
+
+
+
+
+% start_which_node(Optlist) -> hostname
+start_which_node(Optlist) ->
+ case start_node_get_option_value(remote, Optlist) of
+ undefined ->
+ local;
+ true ->
+ case find_remote_host() of
+ {error, Other} ->
+ {error, Other};
+ RHost ->
+ RHost
+ end
+ end.
+
+find_remote_host() ->
+ HostList=test_server_ctrl:get_hosts(),
+ case lists:delete(test_server_sup:hoststr(), HostList) of
+ [] ->
+ {error, no_remote_hosts};
+ [RHost|_Rest] ->
+ RHost
+ end.
+
+start_node_get_option_value(Key, List) ->
+ start_node_get_option_value(Key, List, undefined).
+
+start_node_get_option_value(Key, List, Default) ->
+ case lists:keysearch(Key, 1, List) of
+ {value, {Key, Value}} ->
+ Value;
+ false ->
+ Default
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% stop_node(Name) -> ok | {error,Reason}
+%%
+%% Clean up - test_server will stop this node
+stop_node(Name, TI) ->
+ case ets:lookup(slave_tab,Name) of
+ [#slave_info{client=Client}] ->
+ ets:delete(slave_tab,Name),
+ HostAtom = test_server_sup:hostatom(Name),
+ case lists:member(HostAtom,TI#target_info.slave_targets) of
+ true ->
+ put(test_server_free_targets,
+ get(test_server_free_targets) ++ [HostAtom]);
+ false -> ok
+ end,
+ close_target_client(Client),
+ ok;
+ [] ->
+ {error, not_a_slavenode}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% kill_nodes(TI) -> ok
+%%
+%% Brutally kill all slavenodes that were not stopped by test_server
+kill_nodes(TI) ->
+ case ets:match_object(slave_tab,'_') of
+ [] -> [];
+ List ->
+ lists:map(fun(SI) -> kill_node(SI,TI) end, List)
+ end.
+
+kill_node(SI,TI) ->
+ Name = SI#slave_info.name,
+ ets:delete(slave_tab,Name),
+ HostAtom = test_server_sup:hostatom(Name),
+ case lists:member(HostAtom,TI#target_info.slave_targets) of
+ true ->
+ put(test_server_free_targets,
+ get(test_server_free_targets) ++ [HostAtom]);
+ false -> ok
+ end,
+ case SI#slave_info.socket of
+ undefined ->
+ catch rpc:call(Name,erlang,halt,[]);
+ Sock ->
+ gen_tcp:close(Sock)
+ end,
+ close_target_client(SI#slave_info.client),
+ Name.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Platform specific code
+
+start_target(vxworks,TargetHost,Cmd) ->
+ case vxworks_client:open(TargetHost) of
+ {ok,P} ->
+ case vxworks_client:send_data(P,Cmd,"start_erl called") of
+ {ok,_} ->
+ {ok,{vxworks,P},?VXWORKS_ACCEPT_TIMEOUT};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end;
+
+start_target(unix,TargetHost,Cmd0) ->
+ Cmd =
+ case test_server_sup:hoststr() of
+ TargetHost -> Cmd0;
+ _ -> lists:concat(["rsh ",TargetHost, " ", Cmd0])
+ end,
+ open_port({spawn, Cmd}, [stream]),
+ {ok,undefined,?ACCEPT_TIMEOUT}.
+
+maybe_reboot_target({vxworks,P}) when is_pid(P) ->
+ %% Reboot the vxworks card.
+ %% Client is also closed after this, even if reboot fails
+ vxworks_client:send_data_wait_for_close(P,"q");
+maybe_reboot_target({vxworks,T}) when is_atom(T) ->
+ %% Reboot the vxworks card.
+ %% Client is also closed after this, even if reboot fails
+ vxworks_client:reboot(T);
+maybe_reboot_target(_) ->
+ {error, cannot_reboot_target}.
+
+close_target_client({vxworks,P}) ->
+ vxworks_client:close(P);
+close_target_client(undefined) ->
+ ok.
+
+
+
+%%
+%% Command for starting main target
+%%
+get_main_target_start_command(vxworks,_TargetHost,Naming,
+ _MasterNode,_MasterCookie) ->
+ "e" ++ Naming ++ " test_server -boot start_sasl"
+ " -sasl errlog_type error"
+ " -s test_server start " ++ test_server_sup:hoststr();
+get_main_target_start_command(unix,_TargetHost,Naming,
+ _MasterNode,_MasterCookie) ->
+ Prog = pick_erl_program(default),
+ Prog ++ " " ++ Naming ++ " test_server" ++
+ " -boot start_sasl -sasl errlog_type error"
+ " -s test_server start " ++ test_server_sup:hoststr().
+
+%%
+%% Command for starting slave nodes
+%%
+get_slave_node_start_command(vxworks, _Prog, _MasterNode) ->
+ "e";
+ %"e-noinput -master " ++ MasterNode;
+get_slave_node_start_command(unix, Prog, MasterNode) ->
+ cast_to_list(Prog) ++ " -detached -master " ++ MasterNode.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% cast_to_list(X) -> string()
+%%% X = list() | atom() | void()
+%%% Returns a string representation of whatever was input
+
+cast_to_list(X) when is_list(X) -> X;
+cast_to_list(X) when is_atom(X) -> atom_to_list(X);
+cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
+
+
+%%% L contains elements of the forms
+%%% {prog, String}
+%%% {release, Rel} where Rel = String | latest | previous
+%%% this
+%%%
+pick_erl_program(default) ->
+ cast_to_list(lib:progname());
+pick_erl_program(L) ->
+ P = random_element(L),
+ case P of
+ {prog, S} ->
+ S;
+ {release, S} ->
+ find_release(S);
+ this ->
+ lib:progname()
+ end.
+
+random_element(L) ->
+ {A,B,C} = now(),
+ E = lists:sum([A,B,C]) rem length(L),
+ lists:nth(E+1, L).
+
+find_release(latest) ->
+ "/usr/local/otp/releases/latest/bin/erl";
+find_release(previous) ->
+ "kaka";
+find_release(Rel) ->
+ find_release(os:type(), Rel).
+
+find_release({unix,sunos}, Rel) ->
+ case os:cmd("uname -p") of
+ "sparc" ++ _ ->
+ "/usr/local/otp/releases/otp_beam_solaris8_" ++ Rel ++ "/bin/erl";
+ _ ->
+ none
+ end;
+find_release({unix,linux}, Rel) ->
+ Candidates = find_rel_linux(Rel),
+ case lists:dropwhile(fun(N) ->
+ not filelib:is_regular(N)
+ end, Candidates) of
+ [] -> none;
+ [Erl|_] -> Erl
+ end;
+find_release(_, _) -> none.
+
+find_rel_linux(Rel) ->
+ case suse_release() of
+ none -> [];
+ SuseRel -> find_rel_suse(Rel, SuseRel)
+ end.
+
+find_rel_suse(Rel, SuseRel) ->
+ Root = "/usr/local/otp/releases/otp_beam_linux_sles",
+ case SuseRel of
+ "11" ->
+ %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order.
+ find_rel_suse_1(Rel, Root++"11") ++
+ find_rel_suse_1(Rel, Root++"10") ++
+ find_rel_suse_1(Rel, Root++"9");
+ "10" ->
+ %% Try both SuSE 10 and SuSe 9 in that order.
+ find_rel_suse_1(Rel, Root++"10") ++
+ find_rel_suse_1(Rel, Root++"9");
+ "9" ->
+ find_rel_suse_1(Rel, Root++"9");
+ _ ->
+ []
+ end.
+
+find_rel_suse_1(Rel, RootWc) ->
+ case erlang:system_info(wordsize) of
+ 4 ->
+ find_rel_suse_2(Rel, RootWc++"_i386");
+ 8 ->
+ find_rel_suse_2(Rel, RootWc++"_x64") ++
+ find_rel_suse_2(Rel, RootWc++"_i386")
+ end.
+
+find_rel_suse_2(Rel, RootWc) ->
+ Wc = RootWc ++ "_" ++ Rel,
+ case filelib:wildcard(Wc) of
+ [] ->
+ [];
+ [R|_] ->
+ [filename:join([R,"bin","erl"])]
+ end.
+
+%% suse_release() -> VersionString | none.
+%% Return the major SuSE version number for this platform or
+%% 'none' if this is not a SuSE platform.
+suse_release() ->
+ case file:open("/etc/SuSE-release", [read]) of
+ {ok,Fd} ->
+ try
+ suse_release(Fd)
+ after
+ file:close(Fd)
+ end;
+ {error,_} -> none
+ end.
+
+suse_release(Fd) ->
+ case io:get_line(Fd, '') of
+ eof -> none;
+ Line when is_list(Line) ->
+ case re:run(Line, "^VERSION\\s*=\\s*(\\d+)\s*",
+ [{capture,all_but_first,list}]) of
+ nomatch ->
+ suse_release(Fd);
+ {match,[Version]} ->
+ Version
+ end
+ end.
+
+unpack(Bin) ->
+ {One,Term} = split_binary(Bin, 1),
+ case binary_to_list(One) of
+ [1] ->
+ case catch {ok,binary_to_term(Term)} of
+ {'EXIT',_} -> error;
+ {ok,_}=Res -> Res
+ end;
+ _ -> error
+ end.
+
+id(I) -> I.
+
+print_data(Port) ->
+ receive
+ {Port, {data, Bytes}} ->
+ io:put_chars(Bytes),
+ print_data(Port);
+ {Port, eof} ->
+ Port ! {self(), close},
+ receive
+ {Port, closed} ->
+ true
+ end,
+ receive
+ {'EXIT', Port, _} ->
+ ok
+ after 1 -> % force context switch
+ ok
+ end
+ end.