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(gen).
21-compile({inline,[get_node/1]}).
22
23%%%-----------------------------------------------------------------
24%%% This module implements the really generic stuff of the generic
25%%% standard behaviours (e.g. gen_server, gen_fsm).
26%%%
27%%% The standard behaviour should export init_it/6.
28%%%-----------------------------------------------------------------
29-export([start/5, start/6, debug_options/2, hibernate_after/1,
30	 name/1, unregister_name/1, get_proc_name/1, get_parent/0,
31	 call/3, call/4, reply/2,
32         send_request/3, wait_response/2,
33         receive_response/2, check_response/2,
34         stop/1, stop/3]).
35
36-export([init_it/6, init_it/7]).
37
38-export([format_status_header/2]).
39
40-define(default_timeout, 5000).
41
42%%-----------------------------------------------------------------
43
44-type linkage()    :: 'monitor' | 'link' | 'nolink'.
45-type emgr_name()  :: {'local', atom()}
46                    | {'global', term()}
47                    | {'via', Module :: module(), Name :: term()}.
48
49-type start_ret()  :: {'ok', pid()} | {'ok', {pid(), reference()}} | 'ignore' | {'error', term()}.
50
51-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
52                    | {'logfile', string()}.
53-type option()     :: {'timeout', timeout()}
54		    | {'debug', [debug_flag()]}
55		    | {'hibernate_after', timeout()}
56		    | {'spawn_opt', [proc_lib:spawn_option()]}.
57-type options()    :: [option()].
58
59-type server_ref() :: pid() | atom() | {atom(), node()}
60                    | {global, term()} | {via, module(), term()}.
61
62-type request_id() :: term().
63
64%%-----------------------------------------------------------------
65%% Starts a generic process.
66%% start(GenMod, LinkP, Mod, Args, Options)
67%% start(GenMod, LinkP, Name, Mod, Args, Options)
68%%    GenMod = atom(), callback module implementing the 'real' fsm
69%%    LinkP = link | nolink
70%%    Name = {local, atom()} | {global, term()} | {via, atom(), term()}
71%%    Args = term(), init arguments (to Mod:init/1)
72%%    Options = [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt, OptionList}]
73%%      Flag = trace | log | {logfile, File} | statistics | debug
74%%          (debug == log && statistics)
75%% Returns: {ok, Pid} | {ok, Pid, Reference} | ignore |{error, Reason} |
76%%          {error, {already_started, Pid}} |
77%%    The 'already_started' is returned only if Name is given
78%%-----------------------------------------------------------------
79
80-spec start(module(), linkage(), emgr_name(), module(), term(), options()) ->
81	start_ret().
82
83start(GenMod, LinkP, Name, Mod, Args, Options) ->
84    case where(Name) of
85	undefined ->
86	    do_spawn(GenMod, LinkP, Name, Mod, Args, Options);
87	Pid ->
88	    {error, {already_started, Pid}}
89    end.
90
91-spec start(module(), linkage(), module(), term(), options()) -> start_ret().
92
93start(GenMod, LinkP, Mod, Args, Options) ->
94    do_spawn(GenMod, LinkP, Mod, Args, Options).
95
96%%-----------------------------------------------------------------
97%% Spawn the process (and link) maybe at another node.
98%% If spawn without link, set parent to ourselves 'self'!!!
99%%-----------------------------------------------------------------
100do_spawn(GenMod, link, Mod, Args, Options) ->
101    Time = timeout(Options),
102    proc_lib:start_link(?MODULE, init_it,
103			[GenMod, self(), self(), Mod, Args, Options],
104			Time,
105			spawn_opts(Options));
106do_spawn(GenMod, monitor, Mod, Args, Options) ->
107    Time = timeout(Options),
108    Ret = proc_lib:start_monitor(?MODULE, init_it,
109                                 [GenMod, self(), self(), Mod, Args, Options],
110                                 Time,
111                                 spawn_opts(Options)),
112    monitor_return(Ret);
113do_spawn(GenMod, _, Mod, Args, Options) ->
114    Time = timeout(Options),
115    proc_lib:start(?MODULE, init_it,
116		   [GenMod, self(), 'self', Mod, Args, Options],
117		   Time,
118		   spawn_opts(Options)).
119
120do_spawn(GenMod, link, Name, Mod, Args, Options) ->
121    Time = timeout(Options),
122    proc_lib:start_link(?MODULE, init_it,
123			[GenMod, self(), self(), Name, Mod, Args, Options],
124			Time,
125			spawn_opts(Options));
126do_spawn(GenMod, monitor, Name, Mod, Args, Options) ->
127    Time = timeout(Options),
128    Ret = proc_lib:start_monitor(?MODULE, init_it,
129                                 [GenMod, self(), self(), Name, Mod, Args, Options],
130                                 Time,
131                                 spawn_opts(Options)),
132    monitor_return(Ret);
133do_spawn(GenMod, _, Name, Mod, Args, Options) ->
134    Time = timeout(Options),
135    proc_lib:start(?MODULE, init_it,
136		   [GenMod, self(), 'self', Name, Mod, Args, Options],
137		   Time,
138		   spawn_opts(Options)).
139
140
141%%
142%% Adjust monitor returns for OTP gen behaviours...
143%%
144%% If an OTP behaviour is introduced that 'init_ack's
145%% other results, this has code has to be moved out
146%% into all behaviours as well as adjusted...
147%%
148monitor_return({{ok, Pid}, Mon}) when is_pid(Pid), is_reference(Mon) ->
149    %% Successful start_monitor()...
150    {ok, {Pid, Mon}};
151monitor_return({Error, Mon}) when is_reference(Mon) ->
152    %% Failure; wait for spawned process to terminate
153    %% and release resources, then return the error...
154    receive
155        {'DOWN', Mon, process, _Pid, _Reason} ->
156            ok
157    end,
158    Error.
159
160%%-----------------------------------------------------------------
161%% Initiate the new process.
162%% Register the name using the Rfunc function
163%% Calls the Mod:init/Args function.
164%% Finally an acknowledge is sent to Parent and the main
165%% loop is entered.
166%%-----------------------------------------------------------------
167init_it(GenMod, Starter, Parent, Mod, Args, Options) ->
168    init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options).
169
170init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
171    case register_name(Name) of
172	true ->
173	    init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options);
174	{false, Pid} ->
175	    proc_lib:init_ack(Starter, {error, {already_started, Pid}})
176    end.
177
178init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
179    GenMod:init_it(Starter, Parent, Name, Mod, Args, Options).
180
181%%-----------------------------------------------------------------
182%% Makes a synchronous call to a generic process.
183%% Request is sent to the Pid, and the response must be
184%% {Tag, Reply}.
185%%-----------------------------------------------------------------
186
187%%% New call function which uses the new monitor BIF
188%%% call(ServerId, Label, Request)
189
190call(Process, Label, Request) ->
191    call(Process, Label, Request, ?default_timeout).
192
193%% Optimize a common case.
194call(Process, Label, Request, Timeout) when is_pid(Process),
195  Timeout =:= infinity orelse is_integer(Timeout) andalso Timeout >= 0 ->
196    do_call(Process, Label, Request, Timeout);
197call(Process, Label, Request, Timeout)
198  when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
199    Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
200    do_for_proc(Process, Fun).
201
202-dialyzer({no_improper_lists, do_call/4}).
203
204do_call(Process, Label, Request, infinity)
205  when (is_pid(Process)
206        andalso (node(Process) == node()))
207       orelse (element(2, Process) == node()
208               andalso is_atom(element(1, Process))
209               andalso (tuple_size(Process) =:= 2)) ->
210    Mref = erlang:monitor(process, Process),
211    %% Local without timeout; no need to use alias since we unconditionally
212    %% will wait for either a reply or a down message which corresponds to
213    %% the process being terminated (as opposed to 'noconnection')...
214    Process ! {Label, {self(), Mref}, Request},
215    receive
216        {Mref, Reply} ->
217            erlang:demonitor(Mref, [flush]),
218            {ok, Reply};
219        {'DOWN', Mref, _, _, Reason} ->
220            exit(Reason)
221    end;
222do_call(Process, Label, Request, Timeout) when is_atom(Process) =:= false ->
223    Mref = erlang:monitor(process, Process, [{alias,demonitor}]),
224
225    Tag = [alias | Mref],
226
227    %% OTP-24:
228    %% Using alias to prevent responses after 'noconnection' and timeouts.
229    %% We however still may call nodes responding via process identifier, so
230    %% we still use 'noconnect' on send in order to try to send on the
231    %% monitored connection, and not trigger a new auto-connect.
232    %%
233    erlang:send(Process, {Label, {self(), Tag}, Request}, [noconnect]),
234
235    receive
236        {[alias | Mref], Reply} ->
237            erlang:demonitor(Mref, [flush]),
238            {ok, Reply};
239        {'DOWN', Mref, _, _, noconnection} ->
240            Node = get_node(Process),
241            exit({nodedown, Node});
242        {'DOWN', Mref, _, _, Reason} ->
243            exit(Reason)
244    after Timeout ->
245            erlang:demonitor(Mref, [flush]),
246            receive
247                {[alias | Mref], Reply} ->
248                    {ok, Reply}
249            after 0 ->
250                    exit(timeout)
251            end
252    end.
253
254get_node(Process) ->
255    %% We trust the arguments to be correct, i.e
256    %% Process is either a local or remote pid,
257    %% or a {Name, Node} tuple (of atoms) and in this
258    %% case this node (node()) _is_ distributed and Node =/= node().
259    case Process of
260	{_S, N} when is_atom(N) ->
261	    N;
262	_ when is_pid(Process) ->
263	    node(Process)
264    end.
265
266-spec send_request(Name::server_ref(), Label::term(), Request::term()) -> request_id().
267send_request(Process, Label, Request) when is_pid(Process) ->
268    do_send_request(Process, Label, Request);
269send_request(Process, Label, Request) ->
270    Fun = fun(Pid) -> do_send_request(Pid, Label, Request) end,
271    try do_for_proc(Process, Fun)
272    catch exit:Reason ->
273            %% Make send_request async and fake a down message
274            Mref = erlang:make_ref(),
275            self() ! {'DOWN', Mref, process, Process, Reason},
276            Mref
277    end.
278
279-dialyzer({no_improper_lists, do_send_request/3}).
280
281do_send_request(Process, Label, Request) ->
282    Mref = erlang:monitor(process, Process, [{alias, demonitor}]),
283    erlang:send(Process, {Label, {self(), [alias|Mref]}, Request}, [noconnect]),
284    Mref.
285
286%%
287%% Wait for a reply to the client.
288%% Note: if timeout is returned monitors are kept.
289
290-spec wait_response(RequestId::request_id(), timeout()) ->
291        {reply, Reply::term()} | 'timeout' | {error, {term(), server_ref()}}.
292wait_response(Mref, Timeout) when is_reference(Mref) ->
293    receive
294        {[alias|Mref], Reply} ->
295            erlang:demonitor(Mref, [flush]),
296            {reply, Reply};
297        {'DOWN', Mref, _, Object, Reason} ->
298            {error, {Reason, Object}}
299    after Timeout ->
300            timeout
301    end.
302
303-spec receive_response(RequestId::request_id(), timeout()) ->
304        {reply, Reply::term()} | 'timeout' | {error, {term(), server_ref()}}.
305receive_response(Mref, Timeout) when is_reference(Mref) ->
306    receive
307        {[alias|Mref], Reply} ->
308            erlang:demonitor(Mref, [flush]),
309            {reply, Reply};
310        {'DOWN', Mref, _, Object, Reason} ->
311            {error, {Reason, Object}}
312    after Timeout ->
313            erlang:demonitor(Mref, [flush]),
314            receive
315                {[alias|Mref], Reply} ->
316                    {reply, Reply}
317            after 0 ->
318                    timeout
319            end
320    end.
321
322-spec check_response(RequestId::term(), Key::request_id()) ->
323        {reply, Reply::term()} | 'no_reply' | {error, {term(), server_ref()}}.
324check_response(Msg, Mref) when is_reference(Mref) ->
325    case Msg of
326        {[alias|Mref], Reply} ->
327            erlang:demonitor(Mref, [flush]),
328            {reply, Reply};
329        {'DOWN', Mref, _, Object, Reason} ->
330            {error, {Reason, Object}};
331        _ ->
332            no_reply
333    end.
334
335%%
336%% Send a reply to the client.
337%%
338reply({_To, [alias|Alias] = Tag}, Reply) when is_reference(Alias) ->
339    Alias ! {Tag, Reply}, ok;
340reply({_To, [[alias|Alias] | _] = Tag}, Reply) when is_reference(Alias) ->
341    Alias ! {Tag, Reply}, ok;
342reply({To, Tag}, Reply) ->
343    try To ! {Tag, Reply}, ok catch _:_ -> ok end.
344
345%%-----------------------------------------------------------------
346%% Syncronously stop a generic process
347%%-----------------------------------------------------------------
348stop(Process) ->
349    stop(Process, normal, infinity).
350
351stop(Process, Reason, Timeout)
352  when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
353    Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end,
354    do_for_proc(Process, Fun).
355
356%%-----------------------------------------------------------------
357%% Map different specifications of a process to either Pid or
358%% {Name,Node}. Execute the given Fun with the process as only
359%% argument.
360%% -----------------------------------------------------------------
361
362%% Local or remote by pid
363do_for_proc(Pid, Fun) when is_pid(Pid) ->
364    Fun(Pid);
365%% Local by name
366do_for_proc(Name, Fun) when is_atom(Name) ->
367    case whereis(Name) of
368	Pid when is_pid(Pid) ->
369	    Fun(Pid);
370	undefined ->
371	    exit(noproc)
372    end;
373%% Global by name
374do_for_proc(Process, Fun)
375  when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
376	orelse
377	  (tuple_size(Process) == 3 andalso element(1, Process) == via)) ->
378    case where(Process) of
379	Pid when is_pid(Pid) ->
380	    Node = node(Pid),
381	    try Fun(Pid)
382	    catch
383		exit:{nodedown, Node} ->
384		    %% A nodedown not yet detected by global,
385		    %% pretend that it was.
386		    exit(noproc)
387	    end;
388	undefined ->
389	    exit(noproc)
390    end;
391%% Local by name in disguise
392do_for_proc({Name, Node}, Fun) when Node =:= node() ->
393    do_for_proc(Name, Fun);
394%% Remote by name
395do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) ->
396    if
397	node() =:= nonode@nohost ->
398	    exit({nodedown, Node});
399	true ->
400	    Fun(Process)
401    end.
402
403
404%%%-----------------------------------------------------------------
405%%%  Misc. functions.
406%%%-----------------------------------------------------------------
407where({global, Name}) -> global:whereis_name(Name);
408where({via, Module, Name}) -> Module:whereis_name(Name);
409where({local, Name})  -> whereis(Name).
410
411register_name({local, Name} = LN) ->
412    try register(Name, self()) of
413	true -> true
414    catch
415	error:_ ->
416	    {false, where(LN)}
417    end;
418register_name({global, Name} = GN) ->
419    case global:register_name(Name, self()) of
420	yes -> true;
421	no -> {false, where(GN)}
422    end;
423register_name({via, Module, Name} = GN) ->
424    case Module:register_name(Name, self()) of
425	yes ->
426	    true;
427	no ->
428	    {false, where(GN)}
429    end.
430
431name({local,Name}) -> Name;
432name({global,Name}) -> Name;
433name({via,_, Name}) -> Name;
434name(Pid) when is_pid(Pid) -> Pid.
435
436unregister_name({local,Name}) ->
437    try unregister(Name) of
438	_ -> ok
439    catch
440	_:_ -> ok
441    end;
442unregister_name({global,Name}) ->
443    _ = global:unregister_name(Name),
444    ok;
445unregister_name({via, Mod, Name}) ->
446    _ = Mod:unregister_name(Name),
447    ok;
448unregister_name(Pid) when is_pid(Pid) ->
449    ok.
450
451get_proc_name(Pid) when is_pid(Pid) ->
452    Pid;
453get_proc_name({local, Name}) ->
454    case process_info(self(), registered_name) of
455	{registered_name, Name} ->
456	    Name;
457	{registered_name, _Name} ->
458	    exit(process_not_registered);
459	[] ->
460	    exit(process_not_registered)
461    end;
462get_proc_name({global, Name}) ->
463    case global:whereis_name(Name) of
464	undefined ->
465	    exit(process_not_registered_globally);
466	Pid when Pid =:= self() ->
467	    Name;
468	_Pid ->
469	    exit(process_not_registered_globally)
470    end;
471get_proc_name({via, Mod, Name}) ->
472    case Mod:whereis_name(Name) of
473	undefined ->
474	    exit({process_not_registered_via, Mod});
475	Pid when Pid =:= self() ->
476	    Name;
477	_Pid ->
478	    exit({process_not_registered_via, Mod})
479    end.
480
481get_parent() ->
482    case get('$ancestors') of
483	[Parent | _] when is_pid(Parent) ->
484	    Parent;
485	[Parent | _] when is_atom(Parent) ->
486	    name_to_pid(Parent);
487	_ ->
488	    exit(process_was_not_started_by_proc_lib)
489    end.
490
491name_to_pid(Name) ->
492    case whereis(Name) of
493	undefined ->
494	    case global:whereis_name(Name) of
495		undefined ->
496		    exit(could_not_find_registered_name);
497		Pid ->
498		    Pid
499	    end;
500	Pid ->
501	    Pid
502    end.
503
504
505timeout(Options) ->
506    case lists:keyfind(timeout, 1, Options) of
507	{_,Time} ->
508	    Time;
509	false ->
510	    infinity
511    end.
512
513spawn_opts(Options) ->
514    case lists:keyfind(spawn_opt, 1, Options) of
515	{_,Opts} ->
516	    Opts;
517	false ->
518	    []
519    end.
520
521hibernate_after(Options) ->
522	case lists:keyfind(hibernate_after, 1, Options) of
523		{_,HibernateAfterTimeout} ->
524			HibernateAfterTimeout;
525		false ->
526			infinity
527	end.
528
529debug_options(Name, Opts) ->
530    case lists:keyfind(debug, 1, Opts) of
531	{_,Options} ->
532	    try sys:debug_options(Options)
533	    catch _:_ ->
534		    error_logger:format(
535		      "~tp: ignoring erroneous debug options - ~tp~n",
536		      [Name,Options]),
537		    []
538	    end;
539	false ->
540	    []
541    end.
542
543format_status_header(TagLine, Pid) when is_pid(Pid) ->
544    lists:concat([TagLine, " ", pid_to_list(Pid)]);
545format_status_header(TagLine, RegName) when is_atom(RegName) ->
546    lists:concat([TagLine, " ", RegName]);
547format_status_header(TagLine, Name) ->
548    {TagLine, Name}.
549