1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(slave).
21
22%% If the macro DEBUG is defined during compilation,
23%% debug printouts are done through erlang:display/1.
24%% Activate this feature by starting the compiler
25%% with> erlc -DDEBUG ...
26%% or by> setenv ERL_COMPILER_FLAGS DEBUG
27%% before running make (in the OTP make system)
28%% (the example is for tcsh)
29
30
31-export([pseudo/1,
32	 pseudo/2,
33	 start/1, start/2, start/3,
34	 start/5,
35	 start_link/1, start_link/2, start_link/3,
36	 stop/1,
37	 relay/1]).
38
39%% Internal exports
40-export([wait_for_slave/7, slave_start/1, wait_for_master_to_die/2]).
41
42-import(error_logger, [error_msg/2]).
43
44
45-ifdef(DEBUG).
46-define(dbg(Tag,Data), erlang:display({Tag,Data})).
47-else.
48-define(dbg(Tag,Data), true).
49-endif.
50
51
52%% Start a list of pseudo servers on the local node
53pseudo([Master | ServerList]) ->
54    pseudo(Master , ServerList);
55pseudo(_) ->
56    error_msg("No master node given to slave:pseudo/1~n",[]).
57
58-spec pseudo(Master, ServerList) -> ok when
59      Master :: node(),
60      ServerList :: [atom()].
61
62pseudo(_, []) -> ok;
63pseudo(Master, [S|Tail]) ->
64    start_pseudo(S, whereis(S), Master),
65    pseudo(Master, Tail).
66
67start_pseudo(Name, undefined, Master) ->
68    X = rpc:call(Master,erlang, whereis,[Name]),
69    register(Name, spawn(slave, relay, [X]));
70
71start_pseudo(_,_,_) -> ok.  %% It's already there
72
73
74%% This relay can be used to relay all messages directed to a process.
75
76-spec relay(Pid) -> no_return() when
77      Pid :: pid().
78
79relay({badrpc,Reason}) ->
80    error_msg(" ** exiting relay server ~w :~tw  **~n", [self(),Reason]),
81    exit(Reason);
82relay(undefined) ->
83    error_msg(" ** exiting relay server ~w  **~n", [self()]),
84    exit(undefined);
85relay(Pid) when is_pid(Pid) ->
86    relay1(Pid).
87
88relay1(Pid) ->
89    receive
90        X ->
91            Pid ! X
92    end,
93    relay1(Pid).
94
95%% start/1,2,3 --
96%% start_link/1,2,3 --
97%%
98%% The start/1,2,3 functions are used to start a slave Erlang node.
99%% The node on which the start/N functions are used is called the
100%% master in the description below.
101%%
102%% If hostname is the same for the master and the slave,
103%% the Erlang node will simply be spawned.  The only requirment for
104%% this to work is that the 'erl' program can be found in PATH.
105%%
106%% If the master and slave are on different hosts, start/N uses
107%% the 'rsh' program to spawn an Erlang node on the other host.
108%% Alternative, if the master was started as
109%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead
110%% of 'rsh' (this is useful for systems where the rsh program is named
111%% 'remsh').
112%%
113%% For this to work, the following conditions must be fulfilled:
114%%
115%% 1. There must be an Rsh program on computer; if not an error
116%%    is returned.
117%%
118%% 2. The hosts must be configured to allowed 'rsh' access without
119%%    prompts for password.
120%%
121%% The slave node will have its filer and user server redirected
122%% to the master.  When the master node dies, the slave node will
123%% terminate.  For the start_link functions, the slave node will
124%% terminate also if the process which called start_link terminates.
125%%
126%% Returns: {ok, Name@Host} |
127%%	    {error, timeout} |
128%%          {error, no_rsh} |
129%%	    {error, {already_running, Name@Host}}
130
131-spec start(Host) -> {ok, Node} | {error, Reason} when
132      Host :: inet:hostname(),
133      Node :: node(),
134      Reason :: timeout | no_rsh | {already_running, Node}.
135
136start(Host) ->
137    L = atom_to_list(node()),
138    Name = upto($@, L),
139    start(Host, Name, [], no_link).
140
141-spec start(Host, Name) -> {ok, Node} | {error, Reason} when
142      Host :: inet:hostname(),
143      Name :: atom() | string(),
144      Node :: node(),
145      Reason :: timeout | no_rsh | {already_running, Node}.
146
147start(Host, Name) ->
148    start(Host, Name, []).
149
150-spec start(Host, Name, Args) -> {ok, Node} | {error, Reason} when
151      Host :: inet:hostname(),
152      Name :: atom() | string(),
153      Args :: string(),
154      Node :: node(),
155      Reason :: timeout | no_rsh | {already_running, Node}.
156
157start(Host, Name, Args) ->
158    start(Host, Name, Args, no_link).
159
160-spec start_link(Host) -> {ok, Node} | {error, Reason} when
161      Host :: inet:hostname(),
162      Node :: node(),
163      Reason :: timeout | no_rsh | {already_running, Node}.
164
165start_link(Host) ->
166    L = atom_to_list(node()),
167    Name = upto($@, L),
168    start(Host, Name, [], self()).
169
170-spec start_link(Host, Name) -> {ok, Node} | {error, Reason} when
171      Host :: inet:hostname(),
172      Name :: atom() | string(),
173      Node :: node(),
174      Reason :: timeout | no_rsh | {already_running, Node}.
175
176start_link(Host, Name) ->
177    start_link(Host, Name, []).
178
179-spec start_link(Host, Name, Args) -> {ok, Node} | {error, Reason} when
180      Host :: inet:hostname(),
181      Name :: atom() | string(),
182      Args :: string(),
183      Node :: node(),
184      Reason :: timeout | no_rsh | {already_running, Node}.
185
186start_link(Host, Name, Args) ->
187    start(Host, Name, Args, self()).
188
189start(Host0, Name, Args, LinkTo) ->
190    Prog = progname(),
191    start(Host0, Name, Args, LinkTo, Prog).
192
193start(Host0, Name, Args, LinkTo, Prog) ->
194    Host =
195	case net_kernel:longnames() of
196	    true -> dns(Host0);
197	    false -> strip_host_name(to_list(Host0));
198	    ignored -> exit(not_alive)
199	end,
200    Node = list_to_atom(lists:concat([Name, "@", Host])),
201    case net_adm:ping(Node) of
202	pang ->
203	    start_it(Host, Name, Node, Args, LinkTo, Prog);
204	pong ->
205	    {error, {already_running, Node}}
206    end.
207
208%% Stops a running node.
209
210-spec stop(Node) -> ok when
211      Node :: node().
212
213stop(Node) ->
214    rpc:call(Node, erlang, halt, []),
215    ok.
216
217%% Starts a new slave node.
218
219start_it(Host, Name, Node, Args, LinkTo, Prog) ->
220    spawn(?MODULE, wait_for_slave, [self(), Host, Name, Node, Args, LinkTo,
221				    Prog]),
222    receive
223	{result, Result} -> Result
224    end.
225
226%% Waits for the slave to start.
227
228wait_for_slave(Parent, Host, Name, Node, Args, LinkTo, Prog) ->
229    Waiter = register_unique_name(0),
230    case mk_cmd(Host, Name, Args, Waiter, Prog) of
231	{ok, Cmd} ->
232	    open_port({spawn, Cmd}, [stream]),
233	    receive
234		{SlavePid, slave_started} ->
235		    unregister(Waiter),
236		    slave_started(Parent, LinkTo, SlavePid)
237	    after 32000 ->
238		    %% If it seems that the node was partially started,
239		    %% try to kill it.
240		    Node = list_to_atom(lists:concat([Name, "@", Host])),
241		    case net_adm:ping(Node) of
242			pong ->
243			    spawn(Node, erlang, halt, []),
244			    ok;
245			_ ->
246			    ok
247		    end,
248		    Parent ! {result, {error, timeout}}
249	    end;
250	Other ->
251	    Parent ! {result, Other}
252    end.
253
254slave_started(ReplyTo, no_link, Slave) when is_pid(Slave) ->
255    ReplyTo ! {result, {ok, node(Slave)}};
256slave_started(ReplyTo, Master, Slave) when is_pid(Master), is_pid(Slave) ->
257    process_flag(trap_exit, true),
258    link(Master),
259    link(Slave),
260    ReplyTo ! {result, {ok, node(Slave)}},
261    one_way_link(Master, Slave).
262
263%% This function simulates a one-way link, so that the slave node
264%% will be killed if the master process terminates, but the master
265%% process will not be killed if the slave node terminates.
266
267one_way_link(Master, Slave) ->
268    receive
269	{'EXIT', Master, _Reason} ->
270	    unlink(Slave),
271	    Slave ! {nodedown, node()};
272	{'EXIT', Slave, _Reason} ->
273	    unlink(Master);
274	_Other ->
275	    one_way_link(Master, Slave)
276    end.
277
278register_unique_name(Number) ->
279    Name = list_to_atom(lists:concat(["slave_waiter_", Number])),
280    case catch register(Name, self()) of
281	true ->
282	    Name;
283	{'EXIT', {badarg, _}} ->
284	    register_unique_name(Number+1)
285    end.
286
287%% Makes up the command to start the nodes.
288%% If the node should run on the local host, there is
289%% no need to use rsh.
290
291mk_cmd(Host, Name, Args, Waiter, Prog0) ->
292    Prog = quote_progname(Prog0),
293    BasicCmd = lists:concat([Prog,
294			     " -detached -noinput -master ", node(),
295			     " ", long_or_short(), Name, "@", Host,
296			     " -s slave slave_start ", node(),
297			     " ", Waiter,
298			     " ", Args]),
299    case after_char($@, atom_to_list(node())) of
300	Host ->
301	    {ok, BasicCmd};
302	_ ->
303	    case rsh() of
304		{ok, Rsh} ->
305		    {ok, lists:concat([Rsh, " ", Host, " ", BasicCmd])};
306		Other ->
307		    Other
308	    end
309    end.
310
311%% Return the name of the script that starts (this) erlang
312progname() ->
313    case init:get_argument(progname) of
314	{ok, [[Prog]]} ->
315	    Prog;
316	_Other ->
317	    "no_prog_name"
318    end.
319
320%% This is an attempt to distinguish between spaces in the program
321%% path and spaces that separate arguments. The program is quoted to
322%% allow spaces in the path.
323%%
324%% Arguments could exist either if the executable is excplicitly given
325%% (through start/5) or if the -program switch to beam is used and
326%% includes arguments (typically done by cerl in OTP test environment
327%% in order to ensure that slave/peer nodes are started with the same
328%% emulator and flags as the test node. The result from progname()
329%% could then typically be '/<full_path_to>/cerl -gcov').
330quote_progname(Progname) ->
331    do_quote_progname(string:lexemes(to_list(Progname)," ")).
332
333do_quote_progname([Prog]) ->
334    "\""++Prog++"\"";
335do_quote_progname([Prog,Arg|Args]) ->
336    case os:find_executable(Prog) of
337	false ->
338	    do_quote_progname([Prog++" "++Arg | Args]);
339	_ ->
340	    %% this one has an executable - we assume the rest are arguments
341	    "\""++Prog++"\""++
342		lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args]))
343    end.
344
345%% Give the user an opportunity to run another program,
346%% than the "rsh".  On HP-UX rsh is called remsh; thus HP users
347%% must start erlang as erl -rsh remsh.
348%%
349%% Also checks that the given program exists.
350%%
351%% Returns: {ok, RshPath} | {error, Reason}
352
353rsh() ->
354    Rsh =
355	case init:get_argument(rsh) of
356	    {ok, [[Prog]]} -> Prog;
357	    _ -> "rsh"
358	end,
359    case os:find_executable(Rsh) of
360	false -> {error, no_rsh};
361	Path -> {ok, Path}
362    end.
363
364long_or_short() ->
365    case net_kernel:longnames() of
366	true -> " -name ";
367	false -> " -sname "
368    end.
369
370%% This function will be invoked on the slave, using the -s option of erl.
371%% It will wait for the master node to terminate.
372
373slave_start([Master, Waiter]) ->
374    ?dbg({?MODULE, slave_start}, [[Master, Waiter]]),
375    spawn(?MODULE, wait_for_master_to_die, [Master, Waiter]).
376
377wait_for_master_to_die(Master, Waiter) ->
378    ?dbg({?MODULE, wait_for_master_to_die}, [Master, Waiter]),
379    process_flag(trap_exit, true),
380    monitor_node(Master, true),
381    {Waiter, Master} ! {self(), slave_started},
382    wloop(Master).
383
384wloop(Master) ->
385    receive
386	{nodedown, Master} ->
387	    ?dbg({?MODULE, wloop},
388		 [[Master], {received, {nodedown, Master}}, halting_node] ),
389	    halt();
390	_Other ->
391	    wloop(Master)
392    end.
393
394%% Just the short hostname, not the qualified, for convenience.
395
396strip_host_name([]) -> [];
397strip_host_name([$.|_]) -> [];
398strip_host_name([H|T]) -> [H|strip_host_name(T)].
399
400dns(H) -> {ok, Host} = net_adm:dns_hostname(H), Host.
401
402to_list(X) when is_list(X) -> X;
403to_list(X) when is_atom(X) -> atom_to_list(X).
404
405upto(_, []) -> [];
406upto(Char, [Char|_]) -> [];
407upto(Char, [H|T]) -> [H|upto(Char, T)].
408
409after_char(_, []) -> [];
410after_char(Char, [Char|Rest]) -> Rest;
411after_char(Char, [_|Rest]) -> after_char(Char, Rest).
412