%% %% %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). %%% %%% 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.