%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(test_server_node).
-compile(r12).
%%%
%%% The same compiled code for this module must be possible to load
%%% in R12B and later.
%%%
%% 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.
