diff options
Diffstat (limited to 'lib/test_server/src/test_server_node.erl')
| -rw-r--r-- | lib/test_server/src/test_server_node.erl | 1013 |
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. |