path: root/lib/stdlib/src/slave.erl

%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 1996-2013. 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(slave).

%% If the macro DEBUG is defined during compilation, 
%% debug printouts are done through erlang:display/1.
%% Activate this feature by starting the compiler 
%% with> erlc -DDEBUG ... 
%% or by> setenv ERL_COMPILER_FLAGS DEBUG 
%% before running make (in the OTP make system)
%% (the example is for tcsh)


-export([pseudo/1,
	 pseudo/2,
	 start/1, start/2, start/3,
	 start/5,
	 start_link/1, start_link/2, start_link/3,
	 stop/1,
	 relay/1]).

%% Internal exports 
-export([wait_for_slave/7, slave_start/1, wait_for_master_to_die/2]).

-import(error_logger, [error_msg/2]).


-ifdef(DEBUG).
-define(dbg(Tag,Data), erlang:display({Tag,Data})).
-else.
-define(dbg(Tag,Data), true).
-endif.


%% Start a list of pseudo servers on the local node
pseudo([Master | ServerList]) ->
    pseudo(Master , ServerList);
pseudo(_) ->
    error_msg("No master node given to slave:pseudo/1~n",[]).

-spec pseudo(Master, ServerList) -> ok when
      Master :: node(),
      ServerList :: [atom()].

pseudo(_, []) -> ok;
pseudo(Master, [S|Tail]) ->
    start_pseudo(S, whereis(S), Master),
    pseudo(Master, Tail).

start_pseudo(Name, undefined, Master) ->
    X = rpc:call(Master,erlang, whereis,[Name]),
    register(Name, spawn(slave, relay, [X]));

start_pseudo(_,_,_) -> ok.  %% It's already there


%% This relay can be used to relay all messages directed to a process.

-spec relay(Pid) -> no_return() when
      Pid :: pid().

relay({badrpc,Reason}) ->
    error_msg(" ** exiting relay server ~w :~w  **~n", [self(),Reason]),
    exit(Reason);
relay(undefined) ->
    error_msg(" ** exiting relay server ~w  **~n", [self()]),
    exit(undefined);
relay(Pid) when is_pid(Pid) ->
    relay1(Pid).

relay1(Pid) ->
    receive
        X ->
            Pid ! X
    end,
    relay1(Pid).

%% start/1,2,3 --
%% start_link/1,2,3 --
%%
%% The start/1,2,3 functions are used to start a slave Erlang node.
%% The node on which the start/N functions are used is called the
%% master in the description below.
%%
%% If hostname is the same for the master and the slave,
%% the Erlang node will simply be spawned.  The only requirment for
%% this to work is that the 'erl' program can be found in PATH.
%%
%% If the master and slave are on different hosts, start/N uses
%% the 'rsh' program to spawn an Erlang node on the other host.
%% Alternative, if the master was started as
%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead
%% of 'rsh' (this is useful for systems where the rsh program is named
%% 'remsh').
%%
%% For this to work, the following conditions must be fulfilled:
%%
%% 1. There must be an Rsh program on computer; if not an error
%%    is returned.
%%
%% 2. The hosts must be configured to allowed 'rsh' access without
%%    prompts for password.
%%
%% The slave node will have its filer and user server redirected
%% to the master.  When the master node dies, the slave node will
%% terminate.  For the start_link functions, the slave node will
%% terminate also if the process which called start_link terminates.
%%
%% Returns: {ok, Name@Host} |
%%	    {error, timeout} |
%%          {error, no_rsh} |
%%	    {error, {already_running, Name@Host}}

-spec start(Host) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start(Host) ->
    L = atom_to_list(node()),
    Name = upto($@, L),
    start(Host, Name, [], no_link).

-spec start(Host, Name) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Name :: atom(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start(Host, Name) ->
    start(Host, Name, []).

-spec start(Host, Name, Args) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Name :: atom(),
      Args :: string(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start(Host, Name, Args) ->
    start(Host, Name, Args, no_link).

-spec start_link(Host) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start_link(Host) ->
    L = atom_to_list(node()),
    Name = upto($@, L),
    start(Host, Name, [], self()).

-spec start_link(Host, Name) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Name :: atom(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start_link(Host, Name) ->
    start_link(Host, Name, []).

-spec start_link(Host, Name, Args) -> {ok, Node} | {error, Reason} when
      Host :: atom(),
      Name :: atom(),
      Args :: string(),
      Node :: node(),
      Reason :: timeout | no_rsh | {already_running, Node}.

start_link(Host, Name, Args) ->
    start(Host, Name, Args, self()).

start(Host0, Name, Args, LinkTo) ->
    Prog = lib:progname(),
    start(Host0, Name, Args, LinkTo, Prog).

start(Host0, Name, Args, LinkTo, Prog) ->
    Host =
	case net_kernel:longnames() of
	    true -> dns(Host0);
	    false -> strip_host_name(to_list(Host0));
	    ignored -> exit(not_alive)
	end,
    Node = list_to_atom(lists:concat([Name, "@", Host])),
    case net_adm:ping(Node) of
	pang ->
	    start_it(Host, Name, Node, Args, LinkTo, Prog);
	pong -> 
	    {error, {already_running, Node}}
    end.

%% Stops a running node.

-spec stop(Node) -> ok when
      Node :: node().

stop(Node) ->
%    io:format("stop(~p)~n", [Node]),
    rpc:call(Node, erlang, halt, []),
    ok.

%% Starts a new slave node.

start_it(Host, Name, Node, Args, LinkTo, Prog) ->
    spawn(?MODULE, wait_for_slave, [self(), Host, Name, Node, Args, LinkTo,
				    Prog]),
    receive
	{result, Result} -> Result
    end.

%% Waits for the slave to start.

wait_for_slave(Parent, Host, Name, Node, Args, LinkTo, Prog) ->
    Waiter = register_unique_name(0),
    case mk_cmd(Host, Name, Args, Waiter, Prog) of
	{ok, Cmd} ->
%%	    io:format("Command: ~ts~n", [Cmd]),
	    open_port({spawn, Cmd}, [stream]),
	    receive
		{SlavePid, slave_started} ->
		    unregister(Waiter),
		    slave_started(Parent, LinkTo, SlavePid)
	    after 32000 ->
		    %% If it seems that the node was partially started,
		    %% try to kill it.
		    Node = list_to_atom(lists:concat([Name, "@", Host])),
		    case net_adm:ping(Node) of
			pong ->
			    spawn(Node, erlang, halt, []),
			    ok;
			_ ->
			    ok
		    end,
		    Parent ! {result, {error, timeout}}
	    end;
	Other ->
	    Parent ! {result, Other}
    end.

slave_started(ReplyTo, no_link, Slave) when is_pid(Slave) ->
    ReplyTo ! {result, {ok, node(Slave)}};
slave_started(ReplyTo, Master, Slave) when is_pid(Master), is_pid(Slave) ->
    process_flag(trap_exit, true),
    link(Master),
    link(Slave),
    ReplyTo ! {result, {ok, node(Slave)}},
    one_way_link(Master, Slave).

%% This function simulates a one-way link, so that the slave node
%% will be killed if the master process terminates, but the master
%% process will not be killed if the slave node terminates.

one_way_link(Master, Slave) ->
    receive
	{'EXIT', Master, _Reason} ->
	    unlink(Slave),
	    Slave ! {nodedown, node()};
	{'EXIT', Slave, _Reason} ->
	    unlink(Master);
	_Other ->
	    one_way_link(Master, Slave)
    end.

register_unique_name(Number) ->
    Name = list_to_atom(lists:concat(["slave_waiter_", Number])),
    case catch register(Name, self()) of
	true ->
	    Name;
	{'EXIT', {badarg, _}} ->
	    register_unique_name(Number+1)
    end.

%% Makes up the command to start the nodes.
%% If the node should run on the local host, there is
%% no need to use rsh.

mk_cmd(Host, Name, Args, Waiter, Prog0) ->
    Prog = case os:type() of
	       {ose,_} -> mk_ose_prog(Prog0);
	       _ -> quote_progname(Prog0)
	   end,
    BasicCmd = lists:concat([Prog,
			     " -detached -noinput -master ", node(),
			     " ", long_or_short(), Name, "@", Host,
			     " -s slave slave_start ", node(),
			     " ", Waiter,
			     " ", Args]),
	   
    case after_char($@, atom_to_list(node())) of
	Host ->
	    {ok, BasicCmd};
	_ ->
	    case rsh() of
		{ok, Rsh} ->
		    {ok, lists:concat([Rsh, " ", Host, " ", BasicCmd])};
		Other ->
		    Other
	    end
    end.

%% On OSE we have to pass the beam arguments directory to the slave
%% process. To find out what arguments that should be passed on we
%% make an assumption. All arguments after the last "--" should be
%% skipped. So given these arguments:
%%     -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' -- -name test@localhost
%% we send
%%     -Muycs256 -A 1 -- -root /mst/ -progname beam.debug.smp -- -home /mst/ -- -kernel inetrc '"/mst/inetrc.conf"' --
%% to the slave with whatever other args that are added in mk_cmd.
mk_ose_prog(Prog) ->
    SkipTail = fun("--",[]) ->
		       ["--"];
		  (_,[]) ->
		       [];
		  (Arg,Args) ->
		       [Arg," "|Args]
	       end,
    [Prog,tl(lists:foldr(SkipTail,[],erlang:system_info(emu_args)))].

%% This is an attempt to distinguish between spaces in the program
%% path and spaces that separate arguments. The program is quoted to
%% allow spaces in the path.
%%
%% Arguments could exist either if the executable is excplicitly given
%% (through start/5) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
%% emulator and flags as the test node. The return from lib:progname()
%% could then typically be '/<full_path_to>/cerl -gcov').
quote_progname(Progname) ->
    do_quote_progname(string:tokens(to_list(Progname)," ")).

do_quote_progname([Prog]) ->
    "\""++Prog++"\"";
do_quote_progname([Prog,Arg|Args]) ->
    case os:find_executable(Prog) of
	false ->
	    do_quote_progname([Prog++" "++Arg | Args]);
	_ ->
	    %% this one has an executable - we assume the rest are arguments
	    "\""++Prog++"\""++
		lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args]))
    end.

%% Give the user an opportunity to run another program,
%% than the "rsh".  On HP-UX rsh is called remsh; thus HP users
%% must start erlang as erl -rsh remsh.
%%
%% Also checks that the given program exists.
%%
%% Returns: {ok, RshPath} | {error, Reason}

rsh() ->
    Rsh =
	case init:get_argument(rsh) of
	    {ok, [[Prog]]} -> Prog;
	    _ -> "rsh"
	end,
    case os:find_executable(Rsh) of
	false -> {error, no_rsh};
	Path -> {ok, Path}
    end.

long_or_short() -> 
    case net_kernel:longnames() of
	true -> " -name ";
	false -> " -sname "
    end.

%% This function will be invoked on the slave, using the -s option of erl.
%% It will wait for the master node to terminate.

slave_start([Master, Waiter]) ->
    ?dbg({?MODULE, slave_start}, [[Master, Waiter]]),
    spawn(?MODULE, wait_for_master_to_die, [Master, Waiter]).

wait_for_master_to_die(Master, Waiter) ->
    ?dbg({?MODULE, wait_for_master_to_die}, [Master, Waiter]),
    process_flag(trap_exit, true),
    monitor_node(Master, true),
    {Waiter, Master} ! {self(), slave_started},
    wloop(Master).

wloop(Master) ->
    receive
	{nodedown, Master} ->
	    ?dbg({?MODULE, wloop}, 
		 [[Master], {received, {nodedown, Master}}, halting_node] ),
	    halt();
	_Other ->
	    wloop(Master)
    end.

%% Just the short hostname, not the qualified, for convenience.

strip_host_name([]) -> [];
strip_host_name([$.|_]) -> [];
strip_host_name([H|T]) -> [H|strip_host_name(T)].

dns(H) -> {ok, Host} = net_adm:dns_hostname(H), Host.

to_list(X) when is_list(X) -> X;
to_list(X) when is_atom(X) -> atom_to_list(X).

upto(_, []) -> [];
upto(Char, [Char|_]) -> [];
upto(Char, [H|T]) -> [H|upto(Char, T)].

after_char(_, []) -> [];
after_char(Char, [Char|Rest]) -> Rest;
after_char(Char, [_|Rest]) -> after_char(Char, Rest).