Add plugin support for alternative name lookup

OTP behaviour instances (gen_server, gen_fsm, gen_event) can currently
register themselves either locally or globally, and the behaviour
libraries (including gen.erl) support both addressing methods, as well
as the normal Pid and {Name, Node}.

However, there are alternative registry implementations - e.g. gproc -
and one can well imagine other ways of locating a behaviour instance,
e.g. on a node connected only via a TCP tunnel, rather than via
Distributed Erlang. In all these cases, one needs to write extra code
to identify the behaviour instance, even though the instance itself
need not be aware of how it is located.

This patch introduces a new way of locating a behaviour instance:
{via, Module, Name}.

Module is expected to export a subset of the functions in global.erl,
namely:

register_name(Name, Pid) -> yes | no
whereis_name(Name)  -> pid() | undefined
unregister_name(Name) -> ok
send(Name, Msg) -> Pid

Semantics are expected to be the same as for global.erl

This can be used in all places where {global, Name} is accepted.

faulty export in gen_fsm_SUITE.erl

await process death in dummy_via:reset()

fix error in gen_[server|fsm]:enter_loop()

fix documentation

4 files changed, 69 insertions, 11 deletions

diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 5d803091b6..42555aedd7 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -36,7 +36,7 @@
 %%-----------------------------------------------------------------
 
 -type linkage()    :: 'link' | 'nolink'.
--type emgr_name()  :: {'local', atom()} | {'global', term()}.
+-type emgr_name()  :: {'local', atom()} | {'global', term()} | {via, atom(), term()}.
 
 -type start_ret()  :: {'ok', pid()} | 'ignore' | {'error', term()}.
 
@@ -53,7 +53,7 @@
 %% start(GenMod, LinkP, Name, Mod, Args, Options)
 %%    GenMod = atom(), callback module implementing the 'real' fsm
 %%    LinkP = link | nolink
-%%    Name = {local, atom()} | {global, term()}
+%%    Name = {local, atom()} | {global, term()} | {via, atom(), term()}
 %%    Args = term(), init arguments (to Mod:init/1)
 %%    Options = [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt, OptionList}]
 %%      Flag = trace | log | {logfile, File} | statistics | debug
@@ -158,9 +158,12 @@ call(Name, Label, Request, Timeout)
 	    exit(noproc)
     end;
 %% Global by name
-call({global, _Name}=Process, Label, Request, Timeout)
-  when Timeout =:= infinity;
-       is_integer(Timeout), Timeout >= 0 ->
+call(Process, Label, Request, Timeout)
+  when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
+	orelse
+	  (tuple_size(Process) == 3 andalso element(1, Process) == via))
+       andalso
+       (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) ->
     case where(Process) of
 	Pid when is_pid(Pid) ->
 	    Node = node(Pid),
@@ -274,6 +277,7 @@ reply({To, Tag}, Reply) ->
 %%%  Misc. functions.
 %%%-----------------------------------------------------------------
 where({global, Name}) -> global:whereis_name(Name);
+where({via, Module, Name}) -> Module:whereis_name(Name);
 where({local, Name})  -> whereis(Name).
 
 name_register({local, Name} = LN) ->
@@ -287,8 +291,16 @@ name_register({global, Name} = GN) ->
     case global:register_name(Name, self()) of
 	yes -> true;
 	no -> {false, where(GN)}
+    end;
+name_register({via, Module, Name} = GN) ->
+    case Module:register_name(Name, self()) of
+	yes ->
+	    true;
+	no ->
+	    {false, where(GN)}
     end.
 
+
 timeout(Options) ->
     case opt(timeout, Options) of
 	{ok, Time} ->
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 9879b76391..343eb7d4e4 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -106,8 +106,10 @@
 -type add_handler_ret()  :: ok | term() | {'EXIT',term()}.
 -type del_handler_ret()  :: ok | term() | {'EXIT',term()}.
 
--type emgr_name() :: {'local', atom()} | {'global', atom()}.
--type emgr_ref()  :: atom() | {atom(), atom()} |  {'global', atom()} | pid().
+-type emgr_name() :: {'local', atom()} | {'global', atom()}
+		   | {'via', atom(), term()}.
+-type emgr_ref()  :: atom() | {atom(), atom()} |  {'global', atom()}
+		   | {'via', atom(), term()} | pid().
 -type start_ret() :: {'ok', pid()} | {'error', term()}.
 
 %%---------------------------------------------------------------------------
@@ -142,6 +144,7 @@ init_it(Starter, Parent, Name0, _, _, Options) ->
 
 name({local,Name}) -> Name;
 name({global,Name}) -> Name;
+name({via,_, Name}) -> Name;
 name(Pid) when is_pid(Pid) -> Pid.
 
 -spec add_handler(emgr_ref(), handler(), term()) -> term().
@@ -208,6 +211,9 @@ call1(M, Handler, Query, Timeout) ->
 send({global, Name}, Cmd) ->
     catch global:send(Name, Cmd),
     ok;
+send({via, Mod, Name}, Cmd) ->
+    catch Mod:send(Name, Cmd),
+    ok;
 send(M, Cmd) ->
     M ! Cmd,
     ok.
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 57734a075c..8d43846c92 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -165,7 +165,7 @@
 %%% start(Name, Mod, Args, Options)
 %%% start_link(Mod, Args, Options)
 %%% start_link(Name, Mod, Args, Options) where:
-%%%    Name ::= {local, atom()} | {global, atom()}
+%%%    Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
 %%%    Mod  ::= atom(), callback module implementing the 'real' fsm
 %%%    Args ::= term(), init arguments (to Mod:init/1)
 %%%    Options ::= [{debug, [Flag]}]
@@ -191,6 +191,9 @@ start_link(Name, Mod, Args, Options) ->
 send_event({global, Name}, Event) ->
     catch global:send(Name, {'$gen_event', Event}),
     ok;
+send_event({via, Mod, Name}, Event) ->
+    catch Mod:send(Name, {'$gen_event', Event}),
+    ok;
 send_event(Name, Event) ->
     Name ! {'$gen_event', Event},
     ok.
@@ -214,6 +217,9 @@ sync_send_event(Name, Event, Timeout) ->
 send_all_state_event({global, Name}, Event) ->
     catch global:send(Name, {'$gen_all_state_event', Event}),
     ok;
+send_all_state_event({via, Mod, Name}, Event) ->
+    catch Mod:send(Name, {'$gen_all_state_event', Event}),
+    ok;
 send_all_state_event(Name, Event) ->
     Name ! {'$gen_all_state_event', Event},
     ok.
@@ -273,7 +279,10 @@ cancel_timer(Ref) ->
 enter_loop(Mod, Options, StateName, StateData) ->
     enter_loop(Mod, Options, StateName, StateData, self(), infinity).
 
-enter_loop(Mod, Options, StateName, StateData, ServerName = {_,_}) ->
+enter_loop(Mod, Options, StateName, StateData, {Scope,_} = ServerName)
+  when Scope == local; Scope == global ->
+    enter_loop(Mod, Options, StateName, StateData, ServerName,infinity);
+enter_loop(Mod, Options, StateName, StateData, {via,_,_} = ServerName) ->
     enter_loop(Mod, Options, StateName, StateData, ServerName,infinity);
 enter_loop(Mod, Options, StateName, StateData, Timeout) ->
     enter_loop(Mod, Options, StateName, StateData, self(), Timeout).
@@ -303,6 +312,15 @@ get_proc_name({global, Name}) ->
 	    Name;
 	_Pid ->
 	    exit(process_not_registered_globally)
+    end;
+get_proc_name({via, Mod, Name}) ->
+    case Mod:whereis_name(Name) of
+	undefined ->
+	    exit({process_not_registered_via, Mod});
+	Pid when Pid =:= self() ->
+	    Name;
+	_Pid ->
+	    exit({process_not_registered_via, Mod})
     end.
 
 get_parent() ->
@@ -367,12 +385,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) ->
 
 name({local,Name}) -> Name;
 name({global,Name}) -> Name;
+name({via,_, Name}) -> Name;
 name(Pid) when is_pid(Pid) -> Pid.
 
 unregister_name({local,Name}) ->
     _ = (catch unregister(Name));
 unregister_name({global,Name}) ->
     _ = global:unregister_name(Name);
+unregister_name({via, Mod, Name}) ->
+    _ = Mod:unregister_name(Name);
 unregister_name(Pid) when is_pid(Pid) ->
     Pid.
 
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 6f075bbe5a..244795df9f 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -142,7 +142,7 @@
 %%% start(Name, Mod, Args, Options)
 %%% start_link(Mod, Args, Options)
 %%% start_link(Name, Mod, Args, Options) where:
-%%%    Name ::= {local, atom()} | {global, atom()}
+%%%    Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
 %%%    Mod  ::= atom(), callback module implementing the 'real' server
 %%%    Args ::= term(), init arguments (to Mod:init/1)
 %%%    Options ::= [{timeout, Timeout} | {debug, [Flag]}]
@@ -194,6 +194,9 @@ call(Name, Request, Timeout) ->
 cast({global,Name}, Request) ->
     catch global:send(Name, cast_msg(Request)),
     ok;
+cast({via, Mod, Name}, Request) ->
+    catch Mod:send(Name, cast_msg(Request)),
+    ok;
 cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> 
     do_cast(Dest, Request);
 cast(Dest, Request) when is_atom(Dest) ->
@@ -266,7 +269,11 @@ multi_call(Nodes, Name, Req, Timeout)
 enter_loop(Mod, Options, State) ->
     enter_loop(Mod, Options, State, self(), infinity).
 
-enter_loop(Mod, Options, State, ServerName = {_, _}) ->
+enter_loop(Mod, Options, State, ServerName = {Scope, _})
+  when Scope == local; Scope == local ->
+    enter_loop(Mod, Options, State, ServerName, infinity);
+
+enter_loop(Mod, Options, State, ServerName = {via, _, _}) ->
     enter_loop(Mod, Options, State, ServerName, infinity);
 
 enter_loop(Mod, Options, State, Timeout) ->
@@ -327,12 +334,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) ->
 
 name({local,Name}) -> Name;
 name({global,Name}) -> Name;
+name({via,_, Name}) -> Name;
 name(Pid) when is_pid(Pid) -> Pid.
 
 unregister_name({local,Name}) ->
     _ = (catch unregister(Name));
 unregister_name({global,Name}) ->
     _ = global:unregister_name(Name);
+unregister_name({via, Mod, Name}) ->
+    _ = Mod:unregister_name(Name);
 unregister_name(Pid) when is_pid(Pid) ->
     Pid.
     
@@ -827,6 +837,15 @@ get_proc_name({global, Name}) ->
 	    Name;
 	_Pid ->
 	    exit(process_not_registered_globally)
+    end;
+get_proc_name({via, Mod, Name}) ->
+    case Mod:whereis_name(Name) of
+	undefined ->
+	    exit({process_not_registered_via, Mod});
+	Pid when Pid =:= self() ->
+	    Name;
+	_Pid ->
+	    exit({process_not_registered_via, Mod})
     end.
 
 get_parent() ->