diff --git a/.gitignore b/.gitignore index a9665cf..f694943 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,5 @@ eqc/*.beam */*~ */#*# erl_crash.dump -gproc_dist*@* \ No newline at end of file +gproc_dist*@* +rebar.lock diff --git a/Emakefile b/Emakefile new file mode 100644 index 0000000..68c7b67 --- /dev/null +++ b/Emakefile @@ -0,0 +1 @@ +{"src/*", [debug_info, {i, "include/"}, {outdir, "ebin/"}]}. diff --git a/LICENSE b/LICENSE index e454a52..aca9c04 100644 --- a/LICENSE +++ b/LICENSE @@ -176,3 +176,28 @@ END OF TERMS AND CONDITIONS + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright 2025 Ulf Wiger + + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/ebin/gproc.app b/ebin/gproc.app new file mode 100644 index 0000000..c4ff271 --- /dev/null +++ b/ebin/gproc.app @@ -0,0 +1,12 @@ +{application,gproc, + [{description,"Extended process registry for Erlang"}, + {registered,[]}, + {included_applications,[]}, + {applications,[stdlib,kernel]}, + {vsn,"1.1.0"}, + {modules,[gproc_eqc_tests,gproc,gproc_app,gproc_bcast, + gproc_dist,gproc_info,gproc_init,gproc_lib, + gproc_monitor,gproc_pool,gproc_ps,gproc_pt,gproc_sup, + gproc_dist_tests,gproc_pt_tests,gproc_remote_tests, + gproc_test_lib,gproc_tests]}, + {mod,{gproc_app,[]}}]}. diff --git a/patches/gen_leader/gen_leader.erl b/patches/gen_leader/gen_leader.erl deleted file mode 100644 index ce7907b..0000000 --- a/patches/gen_leader/gen_leader.erl +++ /dev/null @@ -1,1076 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% @author Ulf Wiger -%% @author Thomas Arts -%% -%% @doc Leader election behaviour. -%%

This application implements a leader election behaviour modeled after -%% gen_server. This behaviour intends to make it reasonably -%% straightforward to implement a fully distributed server with -%% master-slave semantics.

-%%

The gen_leader behaviour supports nearly everything that gen_server -%% does (some functions, such as multicall() and the internal timeout, -%% have been removed), and adds a few callbacks and API functions to -%% support leader election etc.

-%%

Also included is an example program, a global dictionary, based -%% on the modules gen_leader and dict. The callback implementing the -%% global dictionary is called 'test_cb', for no particularly logical -%% reason.

-%% @end -%% -%% @type election() = tuple(). Opaque state of the gen_leader behaviour. -%% @type node() = atom(). A node name. -%% @type name() = atom(). A locally registered name. -%% @type serverRef() = Name | {name(),node()} | {global,Name} | pid(). -%% See gen_server. -%% @type callerRef() = {pid(), reference()}. See gen_server. -%% --module(gen_leader). - - --export([start/4, start/6, - start_link/4, start_link/6, - leader_call/2, leader_call/3, leader_cast/2, - call/2, call/3, cast/2, - reply/2]). - -%% Query functions --export([alive/1, - down/1, - candidates/1, - workers/1]). - --export([ - system_continue/3, - system_terminate/4, - system_code_change/4, - format_status/2 - ]). - --export([behaviour_info/1]). - -%% Internal exports --export([init_it/6, print_event/3 - %%, safe_send/2 - ]). - --import(error_logger , [format/2]). --import(lists, [foldl/3, - foreach/2, - member/2, - keydelete/3, - keysearch/3, - keymember/3]). - - --record(election,{leader = none, - mode = global, - name, - leadernode = none, - candidate_nodes = [], - worker_nodes = [], - alive = [], - iteration, - down = [], - monitored = [], - buffered = [] - }). - --record(server, {parent, - mod, - state, - debug}). - -%%% --------------------------------------------------- -%%% Interface functions. -%%% --------------------------------------------------- - -%% @hidden -behaviour_info(callbacks) -> - [{init,1}, - {elected,2}, - {surrendered,3}, - {handle_leader_call,4}, - {handle_leader_cast,3}, - {handle_local_only, 4}, - {from_leader,3}, - {handle_call,3}, - {handle_cast,2}, - {handle_DOWN,3}, - {handle_info,2}, - {terminate,2}, - {code_change,4}]; -behaviour_info(_Other) -> - undefined. - -start(Name, Mod, Arg, Options) when is_atom(Name) -> - gen:start(?MODULE, nolink, {local,Name}, - Mod, {local_only, Arg}, Options). - -%% @spec start(Name::node(), CandidateNodes::[node()], -%% Workers::[node()], Mod::atom(), Arg, Options::list()) -> -%% {ok,pid()} -%% -%% @doc Starts a gen_leader process without linking to the parent. -%% -start(Name, [_|_] = CandidateNodes, Workers, Mod, Arg, Options) - when is_atom(Name) -> - gen:start(?MODULE, nolink, {local,Name}, - Mod, {CandidateNodes, Workers, Arg}, Options). - -%% @spec start_link(Name::atom(), CandidateNodes::[atom()], -%% Workers::[atom()], Mod::atom(), Arg, Options::list()) -> -%% {ok, pid()} -%% -%% @doc Starts a gen_leader process. -%% -%% -%% -%% -%% -%% -%% -%% -%%
NameThe locally registered name of the process
CandidateNodesThe names of nodes capable of assuming -%% a leadership role
WorkersThe names of nodes that will be part of the "cluster", -%% but cannot ever assume a leadership role.
ModThe name of the callback module
ArgArgument passed on to Mod:init/1
OptionsSame as gen_server's Options
-%% -%%

The list of candidates needs to be known from the start. Workers -%% can be added at runtime.

-%% @end -start_link(Name, [_|_] = CandidateNodes, Workers, - Mod, Arg, Options) when is_atom(Name) -> - gen:start(?MODULE, link, {local,Name}, Mod, - {CandidateNodes, Workers, Arg}, Options). - -start_link(Name, Mod, Arg, Options) when is_atom(Name) -> - gen:start(?MODULE, link, {local,Name}, Mod, - {local_only, Arg}, Options). - -%% Query functions to be used from the callback module - -%% @spec alive(E::election()) -> [node()] -%% -%% @doc Returns a list of live nodes (candidates and workers). -%% -alive(#election{alive = Alive}) -> - Alive. - -%% @spec down(E::election()) -> [node()] -%% -%% @doc Returns a list of candidates currently not running. -%% -down(#election{down = Down}) -> - Down. - -%% @spec candidates(E::election()) -> [node()] -%% -%% @doc Returns a list of known candidates. -%% -candidates(#election{candidate_nodes = Cands}) -> - Cands. - -%% @spec workers(E::election()) -> [node()] -%% -%% @doc Returns a list of known workers. -%% -workers(#election{worker_nodes = Workers}) -> - Workers. - -%% @spec call(Name::serverRef(), Request) -> term() -%% -%% @doc Equivalent to gen_server:call/2, but with a slightly -%% different exit reason if something goes wrong. This function calls -%% the gen_leader process exactly as if it were a gen_server -%% (which, for practical purposes, it is.) -%% @end -call(Name, Request) -> - case catch gen:call(Name, '$gen_call', Request) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, local_call, [Name, Request]}}) - end. - -%% @spec call(Name::serverRef(), Request, Timeout::integer()) -> -%% Reply -%% -%% Reply = term() -%% -%% @doc Equivalent to gen_server:call/3, but with a slightly -%% different exit reason if something goes wrong. This function calls -%% the gen_leader process exactly as if it were a gen_server -%% (which, for practical purposes, it is.) -%% @end -call(Name, Request, Timeout) -> - case catch gen:call(Name, '$gen_call', Request, Timeout) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, local_call, [Name, Request, Timeout]}}) - end. - -%% @spec leader_call(Name::name(), Request::term()) -%% -> Reply -%% -%% Reply = term() -%% -%% @doc Makes a call (similar to gen_server:call/2) to the -%% leader. The call is forwarded via the local gen_leader instance, if -%% that one isn't actually the leader. The client will exit if the -%% leader dies while the request is outstanding. -%%

This function uses gen:call/3, and is subject to the -%% same default timeout as e.g. gen_server:call/2.

-%% @end -%% -leader_call(Name, Request) -> - case catch gen:call(Name, '$leader_call', Request) of - {ok,{leader,reply,Res}} -> - Res; - {ok,{error, leader_died}} -> - exit({leader_died, {?MODULE, leader_call, [Name, Request]}}); - {'EXIT',Reason} -> - exit({Reason, {?MODULE, leader_call, [Name, Request]}}) - end. - -%% @spec leader_call(Name::name(), Request::term(), Timeout::integer()) -%% -> Reply -%% -%% Reply = term() -%% -%% @doc Makes a call (similar to gen_server:call/3) to the -%% leader. The call is forwarded via the local gen_leader instance, if -%% that one isn't actually the leader. The client will exit if the -%% leader dies while the request is outstanding. -%% @end -%% -leader_call(Name, Request, Timeout) -> - case catch gen:call(Name, '$leader_call', Request, Timeout) of - {ok,{leader,reply,Res}} -> - Res; - {ok,{error, leader_died}} -> - exit({leader_died, {?MODULE, leader_call, [Name, Request]}}); - {'EXIT',Reason} -> - exit({Reason, {?MODULE, leader_call, [Name, Request, Timeout]}}) - end. - - - -%% @equiv gen_server:cast/2 -cast(Name, Request) -> - catch do_cast('$gen_cast', Name, Request), - ok. - -%% @spec leader_cast(Name::name(), Msg::term()) -> ok -%% @doc Similar to gen_server:cast/2 but will be forwarded to -%% the leader via the local gen_leader instance. -leader_cast(Name, Request) -> - catch do_cast('$leader_cast', Name, Request), - ok. - - -do_cast(Tag, Name, Request) when atom(Name) -> - Name ! {Tag, Request}; -do_cast(Tag, Pid, Request) when pid(Pid) -> - Pid ! {Tag, Request}. - - -%% @spec reply(From::callerRef(), Reply::term()) -> Void -%% @equiv gen_server:reply/2 -reply({To, Tag}, Reply) -> - catch To ! {Tag, Reply}. - - -%%% --------------------------------------------------- -%%% Initiate the new process. -%%% Register the name using the Rfunc function -%%% Calls the Mod:init/Args function. -%%% Finally an acknowledge is sent to Parent and the main -%%% loop is entered. -%%% --------------------------------------------------- -%%% @hidden -init_it(Starter, self, Name, Mod, {CandidateNodes, Workers, Arg}, Options) -> - if CandidateNodes == [] -> - erlang:error(no_candidates); - true -> - init_it(Starter, self(), Name, Mod, - {CandidateNodes, Workers, Arg}, Options) - end; -init_it(Starter,Parent,Name,Mod,{local_only, _}=Arg,Options) -> - Debug = debug_options(Name, Options), - reg_behaviour(), - case catch Mod:init(Arg) of - {stop, Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - ignore -> - proc_lib:init_ack(Starter, ignore), - exit(normal); - {'EXIT', Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - {ok, State} -> - proc_lib:init_ack(Starter, {ok, self()}), - Server = #server{parent = Parent, - mod = Mod, - state = State, - debug = Debug}, - loop(Server, local_only, #election{name = Name, mode = local}); - Other -> - Error = {bad_return_value, Other}, - proc_lib:init_ack(Starter, {error, Error}), - exit(Error) - end; -init_it(Starter,Parent,Name,Mod,{CandidateNodes,Workers,Arg},Options) -> - Debug = debug_options(Name, Options), - reg_behaviour(), - AmCandidate = member(node(), CandidateNodes), - Election = init_election(CandidateNodes, Workers, #election{name = Name}), - case {catch Mod:init(Arg), AmCandidate} of - {{stop, Reason},_} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - {ignore,_} -> - proc_lib:init_ack(Starter, ignore), - exit(normal); - {{'EXIT', Reason},_} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - {{ok, State}, true} -> -%%% NewE = broadcast(capture,Workers++(CandidateNodes -- [node()]), -%%% Election), - proc_lib:init_ack(Starter, {ok, self()}), - begin_election(#server{parent = Parent, - mod = Mod, - state = State, - debug = Debug}, candidate, Election); - {{ok, State}, false} -> -%%% NewE = broadcast(add_worker, CandidateNodes, Election), - proc_lib:init_ack(Starter, {ok, self()}), - begin_election(#server{parent = Parent, - mod = Mod, - state = State, - debug = Debug}, waiting_worker, Election); - Else -> - Error = {bad_return_value, Else}, - proc_lib:init_ack(Starter, {error, Error}), - exit(Error) - end. - -reg_behaviour() -> - catch gproc:reg({p,l,behaviour}, ?MODULE). - -init_election(CandidateNodes, Workers, E) -> -%%% dbg:tracer(), -%%% dbg:tpl(?MODULE,lexcompare,[]), -%%% dbg:p(self(),[m,c]), - AmCandidate = member(node(), CandidateNodes), - case AmCandidate of - true -> - E#election{mode = global, - candidate_nodes = CandidateNodes, - worker_nodes = Workers, - iteration = {[], - position( - node(),CandidateNodes)}}; - false -> - E#election{mode = global, - candidate_nodes = CandidateNodes, - worker_nodes = Workers} - end. - -begin_election(#server{mod = Mod, state = State} = Server, candidate, - #election{candidate_nodes = Cands, - worker_nodes = Workers} = E) -> - case Cands of - [N] when N == node() -> - {ok, Synch, NewState} = Mod:elected(State, E), - NewE = broadcast({elect,Synch}, E), - loop(Server#server{state = NewState}, elected, NewE); - _ -> - NewE = broadcast(capture,Workers++(Cands -- [node()]), E), - safe_loop(Server, candidate, NewE) - end; -begin_election(Server, waiting_worker, #election{candidate_nodes = Cands}=E) -> - NewE = broadcast(add_worker, Cands, E), - safe_loop(Server, waiting_worker, NewE). - - -%%% --------------------------------------------------- -%%% The MAIN loop. -%%% --------------------------------------------------- - - -safe_loop(#server{mod = Mod, state = State} = Server, Role, - #election{name = Name} = E) -> - receive - {system, From, Req} -> - #server{parent = Parent, debug = Debug} = Server, - sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [safe, Server, Role, E]); - {'EXIT', _Parent, Reason} = Msg -> - terminate(Reason, Msg, Server, Role, E); - {leader,capture,Iteration,_Node,Candidate} -> - case Role of - candidate -> - NewE = - nodeup(node(Candidate),E), - case lexcompare(NewE#election.iteration,Iteration) of - less -> - Candidate ! - {leader,accept, - NewE#election.iteration,self()}, - safe_loop(Server, captured, - NewE#election{leader = Candidate}); - greater -> - %% I'll get either an accept or DOWN - %% from Candidate later - safe_loop(Server, Role, NewE); - equal -> - safe_loop(Server, Role, NewE) - end; - captured -> - NewE = nodeup(node(Candidate), E), - safe_loop(Server, Role, NewE); - waiting_worker -> - NewE = - nodeup(node(Candidate),E), - safe_loop(Server, Role, NewE) - end; - {leader,add_worker,Worker} -> - NewE = nodeup(node(Worker), E), - safe_loop(Server, Role, NewE); - {leader,accept,Iteration,Candidate} -> - case Role of - candidate -> - NewE = - nodeup(node(Candidate),E), - {Captured,_} = Iteration, - NewIteration = % inherit all procs that have been - % accepted by Candidate - foldl(fun(C,Iter) -> - add_captured(Iter,C) - end,NewE#election.iteration, - [node(Candidate)|Captured]), - check_majority(NewE#election{ - iteration = NewIteration}, Server); - captured -> - %% forward this to the leader - E#election.leader ! {leader,accept,Iteration,Candidate}, - NewE = nodeup(node(Candidate), E), - safe_loop(Server, Role, NewE) - end; - {leader,elect,Synch,Candidate} -> - NewE = - case Role of - waiting_worker -> - nodeup(node(Candidate), - E#election{ - leader = Candidate, - leadernode = node(Candidate)}); - _ -> - nodeup(node(Candidate), - E#election{ - leader = Candidate, - leadernode = node(Candidate), - iteration = {[], - position( - node(), - E#election.candidate_nodes)} - }) - end, - {ok,NewState} = Mod:surrendered(State,Synch,NewE), - NewRole = case Role of - waiting_worker -> - worker; - _ -> - surrendered - end, - loop(Server#server{state = NewState}, NewRole, NewE); - {leader, local_only, Node, Candidate} -> - case lists:keysearch(node(Candidate), 2, E#election.monitored) of - {value, {Ref, N}} -> - NewE = down(Ref, {E#election.name,N},local_only,E), - io:format("local_only received from ~p~n" - "E0 = ~p~n" - "E1 = ~p~n", [Node, E, NewE]), - safe_after_down(Server, Role, NewE); - false -> - safe_loop(Server, Role, E) - end; - {'DOWN',Ref,process,{Name,_}=Who,Why} -> - NewE = - down(Ref,Who,Why,E), - safe_after_down(Server, Role, NewE) - end. - -safe_after_down(Server, Role, E) -> - case {Role,E#election.leader} of - {candidate,_} -> - check_majority(E, Server); - {captured,none} -> - check_majority(broadcast(capture,E), Server); - {waiting_worker,_} -> - safe_loop(Server, Role, E) - end. - - -loop(#server{parent = Parent, - mod = Mod, - state = State, - debug = Debug} = Server, Role, - #election{mode = Mode, name = Name} = E) -> - Msg = receive - - Input -> - Input - end, - case Msg of - {system, From, Req} -> - sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [normal, Server, Role, E]); - {'EXIT', Parent, Reason} -> - terminate(Reason, Msg, Server, Role, E); - {leader, local_only, _, _Candidate} -> - loop(Server, Role, E); - LeaderMsg when element(1,LeaderMsg) == leader, Mode == local -> - Candidate = element(size(LeaderMsg), LeaderMsg), - Candidate ! {leader, local_only, node(), self()}, - loop(Server, Role, E); - {leader,capture,_Iteration,_Node,Candidate} -> - NewE = nodeup(node(Candidate),E), - case Role of - R when R == surrendered; R == worker -> - loop(Server, Role, NewE); - elected -> - {ok,Synch,NewState} = Mod:elected(State,NewE), - Candidate ! {leader, elect, Synch, self()}, - loop(Server#server{state = NewState}, Role, NewE) - end; - {leader,accept,_Iteration,Candidate} -> - NewE = nodeup(node(Candidate),E), - case Role of - surrendered -> - loop(Server, Role, NewE); - elected -> - {ok,Synch,NewState} = Mod:elected(State,NewE), - Candidate ! {leader, elect, Synch, self()}, - loop(Server#server{state = NewState}, Role, NewE) - end; - {leader,elect,Synch,Candidate} -> - NewE = - case Role of - worker -> - nodeup(node(Candidate), - E#election{ - leader = Candidate, - leadernode = node(Candidate)}); - surrendered -> - nodeup(node(Candidate), - E#election{ - leader = Candidate, - leadernode = node(Candidate), - iteration = {[], - position( - node(), - E#election.candidate_nodes)} - }) - end, - {ok, NewState} = Mod:surrendered(State, Synch, NewE), - loop(Server#server{state = NewState}, Role, NewE); - {'DOWN',Ref,process,{Name,Node} = Who,Why} -> - #election{alive = PreviouslyAlive} = E, - NewE = - down(Ref,Who,Why,E), - case NewE#election.leader of - none -> - foreach(fun({_,From}) -> - reply(From,{error,leader_died}) - end, E#election.buffered), - NewE1 = NewE#election{buffered = []}, - case Role of - surrendered -> - check_majority( - broadcast(capture,NewE1), Server); - worker -> - safe_loop(Server, waiting_worker, NewE1) - end; - L when L == self() -> - case member(Node, PreviouslyAlive) of - true -> - case Mod:handle_DOWN(Node, State, E) of - {ok, NewState} -> - loop(Server#server{state = NewState}, - Role, NewE); - {ok, Broadcast, NewState} -> - NewE1 = broadcast( - {from_leader,Broadcast}, NewE), - loop(Server#server{state = NewState}, - Role, NewE1) - end; - false -> - loop(Server, Role, NewE) - end; - _ -> - loop(Server, Role, NewE) - end; - _Msg when Debug == [] -> - handle_msg(Msg, Server, Role, E); - _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - E#election.name, {in, Msg}), - handle_msg(Msg, Server#server{debug = Debug1}, Role, E) - end. - -%%----------------------------------------------------------------- -%% Callback functions for system messages handling. -%%----------------------------------------------------------------- - -%% @hidden -system_continue(_Parent, Debug, [safe, Server, Role, E]) -> - safe_loop(Server#server{debug = Debug}, Role, E); -system_continue(_Parent, Debug, [normal, Server, Role, E]) -> - loop(Server#server{debug = Debug}, Role, E). - -%% @hidden -system_terminate(Reason, _Parent, Debug, [_Mode, Server, Role, E]) -> - terminate(Reason, [], Server#server{debug = Debug}, Role, E). - -%% @hidden -system_code_change([Mode, Server, Role, E], _Module, OldVsn, Extra) -> - #server{mod = Mod, state = State} = Server, - case catch Mod:code_change(OldVsn, State, E, Extra) of - {ok, NewState} -> - NewServer = Server#server{state = NewState}, - {ok, [Mode, NewServer, Role, E]}; - {ok, NewState, NewE} -> - NewServer = Server#server{state = NewState}, - {ok, [Mode, NewServer, Role, NewE]}; - Else -> Else - end. - -%%----------------------------------------------------------------- -%% Format debug messages. Print them as the call-back module sees -%% them, not as the real erlang messages. Use trace for that. -%%----------------------------------------------------------------- -%% @hidden -print_event(Dev, {in, Msg}, Name) -> - case Msg of - {'$gen_call', {From, _Tag}, Call} -> - io:format(Dev, "*DBG* ~p got local call ~p from ~w~n", - [Name, Call, From]); - {'$leader_call', {From, _Tag}, Call} -> - io:format(Dev, "*DBG* ~p got global call ~p from ~w~n", - [Name, Call, From]); - {'$gen_cast', Cast} -> - io:format(Dev, "*DBG* ~p got local cast ~p~n", - [Name, Cast]); - {'$leader_cast', Cast} -> - io:format(Dev, "*DBG* ~p got global cast ~p~n", - [Name, Cast]); - _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) - end; -print_event(Dev, {out, Msg, To, State}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", - [Name, Msg, To, State]); -print_event(Dev, {noreply, State}, Name) -> - io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); -print_event(Dev, Event, Name) -> - io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). - - -handle_msg({'$leader_call', From, Request} = Msg, - #server{mod = Mod, state = State} = Server, elected = Role, E) -> - case catch Mod:handle_leader_call(Request, From, State, E) of - {reply, Reply, NState} -> - NewServer = reply(From, {leader,reply,Reply}, - Server#server{state = NState}, Role, E), - loop(NewServer, Role, E); - {reply, Reply, Broadcast, NState} -> - NewE = broadcast({from_leader,Broadcast}, E), - NewServer = reply(From, {leader,reply,Reply}, - Server#server{state = NState}, Role, - NewE), - loop(NewServer, Role, NewE); - {noreply, NState} = Reply -> - NewServer = handle_debug(Server#server{state = NState}, - Role, E, Reply), - loop(NewServer, Role, E); - {stop, Reason, Reply, NState} -> - {'EXIT', R} = - (catch terminate(Reason, Msg, - Server#server{state = NState}, - Role, E)), - reply(From, Reply), - exit(R); - Other -> - handle_common_reply(Other, Msg, Server, Role, E) - end; -handle_msg({'$leader_call', From, Request} = Msg, - #server{mod = Mod, state = State} = Server, Role, - #election{mode = local} = E) -> - Reply = (catch Mod:handle_leader_call(Request,From,State,E)), - handle_call_reply(Reply, Msg, Server, Role, E); -%%% handle_common_reply(Reply, Msg, Server, Role, E); -handle_msg({'$leader_cast', Cast} = Msg, - #server{mod = Mod, state = State} = Server, Role, - #election{mode = local} = E) -> - Reply = (catch Mod:handle_leader_cast(Cast,State,E)), - handle_common_reply(Reply, Msg, Server, Role, E); -handle_msg({'$leader_cast', Cast} = Msg, - #server{mod = Mod, state = State} = Server, elected = Role, E) -> - Reply = (catch Mod:handle_leader_cast(Cast, State, E)), - handle_common_reply(Reply, Msg, Server, Role, E); -handle_msg({from_leader, Cmd} = Msg, - #server{mod = Mod, state = State} = Server, Role, E) -> - handle_common_reply(catch Mod:from_leader(Cmd, State, E), - Msg, Server, Role, E); -handle_msg({'$leader_call', From, Request}, Server, Role, - #election{buffered = Buffered, leader = Leader} = E) -> - Ref = make_ref(), - Leader ! {'$leader_call', {self(),Ref}, Request}, - NewBuffered = [{Ref,From}|Buffered], - loop(Server, Role, E#election{buffered = NewBuffered}); -handle_msg({Ref, {leader,reply,Reply}}, Server, Role, - #election{buffered = Buffered} = E) -> - {value, {_,From}} = keysearch(Ref,1,Buffered), - NewServer = reply(From, {leader,reply,Reply}, Server, Role, - E#election{buffered = keydelete(Ref,1,Buffered)}), - loop(NewServer, Role, E); -handle_msg({'$gen_call', From, Request} = Msg, - #server{mod = Mod, state = State} = Server, Role, E) -> - Reply = (catch Mod:handle_call(Request, From, State)), - handle_call_reply(Reply, Msg, Server, Role, E); -handle_msg({'$gen_cast',Msg} = Cast, - #server{mod = Mod, state = State} = Server, Role, E) -> - handle_common_reply(catch Mod:handle_cast(Msg, State), - Cast, Server, Role, E); -handle_msg(Msg, - #server{mod = Mod, state = State} = Server, Role, E) -> - handle_common_reply(catch Mod:handle_info(Msg, State), - Msg, Server, Role, E). - - -handle_call_reply(CB_reply, {_, From, _Request} = Msg, Server, Role, E) -> - case CB_reply of - {reply, Reply, NState} -> - NewServer = reply(From, Reply, - Server#server{state = NState}, Role, E), - loop(NewServer, Role, E); - {noreply, NState} = Reply -> - NewServer = handle_debug(Server#server{state = NState}, - Role, E, Reply), - loop(NewServer, Role, E); - {activate, Cands, Workers, Reply, NState} - when E#election.mode == local -> - NewRole = case member(node(), Cands) of - true -> candidate; - false -> waiting_worker - end, - reply(From, Reply), - NServer = Server#server{state = NState}, - NewE = init_election(Cands, Workers, E), - io:format("activating: NewE = ~p~n", [NewE]), - begin_election(NServer, NewRole, NewE); - {stop, Reason, Reply, NState} -> - {'EXIT', R} = - (catch terminate(Reason, Msg, Server#server{state = NState}, - Role, E)), - reply(From, Reply), - exit(R); - Other -> - handle_common_reply(Other, Msg, Server, Role, E) - end. - - -handle_common_reply(Reply, Msg, Server, Role, E) -> - case Reply of - {ok, NState} -> - NewServer = handle_debug(Server#server{state = NState}, - Role, E, Reply), - loop(NewServer, Role, E); - {ok, Broadcast, NState} -> - NewE = broadcast({from_leader,Broadcast}, E), - NewServer = handle_debug(Server#server{state = NState}, - Role, E, Reply), - loop(NewServer, Role, NewE); - {stop, Reason, NState} -> - terminate(Reason, Msg, Server#server{state = NState}, Role, E); - {'EXIT', Reason} -> - terminate(Reason, Msg, Server, Role, E); - _ -> - terminate({bad_return_value, Reply}, Msg, Server, Role, E) - end. - - -reply({To, Tag}, Reply, #server{state = State} = Server, Role, E) -> - reply({To, Tag}, Reply), - handle_debug(Server, Role, E, {out, Reply, To, State}). - - -handle_debug(#server{debug = []} = Server, _Role, _E, _Event) -> - Server; -handle_debug(#server{debug = Debug} = Server, _Role, E, Event) -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - E#election.name, Event), - Server#server{debug = Debug1}. - -%%% --------------------------------------------------- -%%% Terminate the server. -%%% --------------------------------------------------- - -terminate(Reason, Msg, #server{mod = Mod, - state = State, - debug = Debug}, _Role, - #election{name = Name}) -> - case catch Mod:terminate(Reason, State) of - {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), - exit(R); - _ -> - case Reason of - normal -> - exit(normal); - shutdown -> - exit(shutdown); - _ -> - error_info(Reason, Name, Msg, State, Debug), - exit(Reason) - end - end. - -%% Maybe we shouldn't do this? We have the crash report... -error_info(Reason, Name, Msg, State, Debug) -> - format("** Generic leader ~p terminating \n" - "** Last message in was ~p~n" - "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n", - [Name, Msg, State, Reason]), - sys:print_log(Debug), - ok. - -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) - end. - -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -%%----------------------------------------------------------------- -%% Status information -%%----------------------------------------------------------------- -%% @hidden -format_status(Opt, StatusData) -> - [PDict, SysState, Parent, Debug, [_Mode, Server, _Role, E]] = StatusData, - Header = lists:concat(["Status for generic server ", E#election.name]), - Log = sys:get_debug(log, Debug, []), - #server{mod = Mod, state = State} = Server, - Specific = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch apply(Mod, format_status, [Opt, [PDict, State]]) of - {'EXIT', _} -> [{data, [{"State", State}]}]; - Else -> Else - end; - _ -> - [{data, [{"State", State}]}] - end, - [{header, Header}, - {data, [{"Status", SysState}, - {"Parent", Parent}, - {"Logged events", Log}]} | - Specific]. - - - - -broadcast(Msg, #election{monitored = Monitored} = E) -> - %% When broadcasting the first time, we broadcast to all candidate nodes, - %% using broadcast/3. This function is used for subsequent broadcasts, - %% and we make sure only to broadcast to already known nodes. - %% It's the responsibility of new nodes to make themselves known through - %% a wider broadcast. - ToNodes = [N || {_,N} <- Monitored], - broadcast(Msg, ToNodes, E). - -broadcast(capture, ToNodes, #election{monitored = Monitored} = E) -> - ToMonitor = [N || N <- ToNodes, - not(keymember(N,2,Monitored))], - NewE = - foldl(fun(Node,Ex) -> - Ref = erlang:monitor( - process,{Ex#election.name,Node}), - Ex#election{monitored = [{Ref,Node}| - Ex#election.monitored]} - end,E,ToMonitor), - foreach( - fun(Node) -> - {NewE#election.name,Node} ! - {leader,capture,NewE#election.iteration,node(),self()} - end,ToNodes), - NewE; -broadcast({elect,Synch},ToNodes,E) -> - foreach( - fun(Node) -> - {E#election.name,Node} ! {leader,elect,Synch,self()} - end,ToNodes), - E; -broadcast({from_leader, Msg}, ToNodes, E) -> - foreach( - fun(Node) -> - {E#election.name,Node} ! {from_leader, Msg} - end,ToNodes), - E; -broadcast(add_worker, ToNodes, E) -> - foreach( - fun(Node) -> - {E#election.name,Node} ! {leader, add_worker, self()} - end,ToNodes), - E. - - - -check_majority(E, Server) -> - {Captured,_} = E#election.iteration, - AcceptMeAsLeader = length(Captured) + 1, % including myself - NrCandidates = length(E#election.candidate_nodes), - NrDown = E#election.down, - if AcceptMeAsLeader > NrCandidates/2 -> - NewE = E#election{leader = self(), leadernode = node()}, - {ok,Synch,NewState} = - (Server#server.mod):elected(Server#server.state, NewE), - NewE1 = broadcast({elect,Synch}, NewE), - loop(Server#server{state = NewState}, elected, NewE1); - AcceptMeAsLeader+length(NrDown) == NrCandidates -> - NewE = E#election{leader = self(), leadernode = node()}, - {ok,Synch,NewState} = - (Server#server.mod):elected(Server#server.state, NewE), - NewE1 = broadcast({elect,Synch}, NewE), - loop(Server#server{state = NewState}, elected, NewE1); - true -> - safe_loop(Server, candidate, E) - end. - - -down(Ref,_Who,Why,E) -> - case lists:keysearch(Ref,1,E#election.monitored) of - {value, {_,Node}} -> - NewMonitored = if Why == local_only -> E#election.monitored; - true -> - E#election.monitored -- [{Ref,Node}] - end, - {Captured,Pos} = E#election.iteration, - case Node == E#election.leadernode of - true -> - E#election{leader = none, - leadernode = none, - iteration = {Captured -- [Node], - Pos}, % TAKE CARE ! - down = [Node|E#election.down], - alive = E#election.alive -- [Node], - monitored = NewMonitored}; - false -> - Down = case member(Node,E#election.candidate_nodes) of - true -> - [Node|E#election.down]; - false -> - E#election.down - end, - E#election{iteration = {Captured -- [Node], - Pos}, % TAKE CARE ! - down = Down, - alive = E#election.alive -- [Node], - monitored = NewMonitored} - end - end. - - - -%% position of element counted from end of the list -%% -position(X,[Head|Tail]) -> - case X==Head of - true -> - length(Tail); - false -> - position(X,Tail) - end. - -%% This is a multi-level comment -%% This is the second line of the comment -lexcompare({C1,P1},{C2,P2}) -> - lexcompare([{length(C1),length(C2)},{P1,P2}]). - -lexcompare([]) -> - equal; -lexcompare([{X,Y}|Rest]) -> - if X less; - X==Y -> lexcompare(Rest); - X>Y -> greater - end. - -add_captured({Captured,Pos}, CandidateNode) -> - {[CandidateNode|[ Node || Node <- Captured, - Node =/= CandidateNode ]], Pos}. - -nodeup(Node, #election{monitored = Monitored, - alive = Alive, - down = Down} = E) -> - %% make sure process is monitored from now on - case [ N || {_,N}<-Monitored, N==Node] of - [] -> - Ref = erlang:monitor(process,{E#election.name,Node}), - E#election{down = Down -- [Node], - alive = [Node | Alive], - monitored = [{Ref,Node}|Monitored]}; - _ -> % already monitored, thus not in down - E#election{alive = [Node | [N || N <- Alive, - N =/= Node]]} - end. - diff --git a/patches/kernel/application_master.erl b/patches/kernel/application_master.erl deleted file mode 100644 index fa3c609..0000000 --- a/patches/kernel/application_master.erl +++ /dev/null @@ -1,428 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(application_master). - -%% External exports --export([start_link/2, start_type/0, stop/1]). --export([get_child/1]). - -%% Internal exports --export([init/4, start_it/4]). - --include("application_master.hrl"). - --record(state, {child, appl_data, children = [], procs = 0, gleader}). - -%%----------------------------------------------------------------- -%% Func: start_link/1 -%% Args: ApplData = record(appl_data) -%% Purpose: Starts an application master for the application. -%% Called from application_controller. (The application is -%% also started). -%% Returns: {ok, Pid} | {error, Reason} (Pid is unregistered) -%%----------------------------------------------------------------- -start_link(ApplData, Type) -> - Parent = whereis(application_controller), - proc_lib:start_link(application_master, init, - [Parent, self(), ApplData, Type]). - -start_type() -> - group_leader() ! {start_type, self()}, - receive - {start_type, Type} -> - Type - after 5000 -> - {error, timeout} - end. - -%%----------------------------------------------------------------- -%% Func: stop/1 -%% Purpose: Stops the application. This function makes sure -%% that all processes belonging to the applicication is -%% stopped (shutdown or killed). The application master -%% is also stopped. -%% Returns: ok -%%----------------------------------------------------------------- -stop(AppMaster) -> call(AppMaster, stop). - -%%----------------------------------------------------------------- -%% Func: get_child/1 -%% Purpose: Get the topmost supervisor of an application. -%% Returns: {pid(), App} -%%----------------------------------------------------------------- -get_child(AppMaster) -> call(AppMaster, get_child). - -call(AppMaster, Req) -> - Tag = make_ref(), - Ref = erlang:monitor(process, AppMaster), - AppMaster ! {Req, Tag, self()}, - receive - {'DOWN', Ref, process, _, _Info} -> - ok; - {Tag, Res} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, process, _, _Info} -> - Res - after 0 -> - Res - end - end. - -%%%----------------------------------------------------------------- -%%% The logical and physical process structrure is as follows: -%%% -%%% logical physical -%%% -%%% -------- -------- -%%% |AM(GL)| |AM(GL)| -%%% -------- -------- -%%% | | -%%% -------- -------- -%%% |Appl P| | X | -%%% -------- -------- -%%% | -%%% -------- -%%% |Appl P| -%%% -------- -%%% -%%% Where AM(GL) == Application Master (Group Leader) -%%% Appl P == The application specific root process (child to AM) -%%% X == A special 'invisible' process -%%% The reason for not using the logical structrure is that -%%% the application start function is synchronous, and -%%% that the AM is GL. This means that if AM executed the start -%%% function, and this function uses spawn_request/1 -%%% or io, deadlock would occur. Therefore, this function is -%%% executed by the process X. Also, AM needs three loops; -%%% init_loop (waiting for the start function to return) -%%% main_loop -%%% terminate_loop (waiting for the process to die) -%%% In each of these loops, io and other requests are handled. -%%%----------------------------------------------------------------- -%%% Internal functions -%%%----------------------------------------------------------------- -init(Parent, Starter, ApplData, Type) -> - link(Parent), - process_flag(trap_exit, true), - gen:reg_behaviour(application), - OldGleader = group_leader(), - group_leader(self(), self()), - %% Insert ourselves as master for the process. This ensures that - %% the processes in the application can use get_env/1 at startup. - Name = ApplData#appl_data.name, - ets:insert(ac_tab, {{application_master, Name}, self()}), - State = #state{appl_data = ApplData, gleader = OldGleader}, - case start_it(State, Type) of - {ok, Pid} -> % apply(M,F,A) returned ok - set_timer(ApplData#appl_data.maxT), - unlink(Starter), - proc_lib:init_ack(Starter, {ok,self()}), - main_loop(Parent, State#state{child = Pid}); - {error, Reason} -> % apply(M,F,A) returned error - exit(Reason); - Else -> % apply(M,F,A) returned erroneous - exit(Else) - end. - -%%----------------------------------------------------------------- -%% We want to start the new application synchronously, but we still -%% want to handle io requests. So we spawn off a new process that -%% performs the apply, and we wait for a start ack. -%%----------------------------------------------------------------- -start_it(State, Type) -> - Tag = make_ref(), - Pid = spawn_link(application_master, start_it, [Tag, State, self(), Type]), - init_loop(Pid, Tag, State, Type). - - -%%----------------------------------------------------------------- -%% These are the three different loops executed by the application_ -%% master -%%----------------------------------------------------------------- -init_loop(Pid, Tag, State, Type) -> - receive - IoReq when element(1, IoReq) =:= io_request -> - State#state.gleader ! IoReq, - init_loop(Pid, Tag, State, Type); - {Tag, Res} -> - Res; - {'EXIT', Pid, Reason} -> - {error, Reason}; - {start_type, From} -> - From ! {start_type, Type}, - init_loop(Pid, Tag, State, Type); - Other -> - NewState = handle_msg(Other, State), - init_loop(Pid, Tag, NewState, Type) - end. - -main_loop(Parent, State) -> - receive - IoReq when element(1, IoReq) =:= io_request -> - State#state.gleader ! IoReq, - main_loop(Parent, State); - {'EXIT', Parent, Reason} -> - terminate(Reason, State); - {'EXIT', Child, Reason} when State#state.child =:= Child -> - terminate(Reason, State#state{child=undefined}); - {'EXIT', _, timeout} -> - terminate(normal, State); - {'EXIT', Pid, _Reason} -> - Children = lists:delete(Pid, State#state.children), - Procs = State#state.procs - 1, - main_loop(Parent, State#state{children=Children, procs=Procs}); - {start_type, From} -> - From ! {start_type, local}, - main_loop(Parent, State); - Other -> - NewState = handle_msg(Other, State), - main_loop(Parent, NewState) - end. - -terminate_loop(Child, State) -> - receive - IoReq when element(1, IoReq) =:= io_request -> - State#state.gleader ! IoReq, - terminate_loop(Child, State); - {'EXIT', Child, _} -> - ok; - Other -> - NewState = handle_msg(Other, State), - terminate_loop(Child, NewState) - end. - - -%%----------------------------------------------------------------- -%% The Application Master is linked to *all* processes in the group -%% (application). -%%----------------------------------------------------------------- -handle_msg({get_child, Tag, From}, State) -> - From ! {Tag, get_child_i(State#state.child)}, - State; -handle_msg({stop, Tag, From}, State) -> - catch terminate(normal, State), - From ! {Tag, ok}, - exit(normal); -handle_msg(_, State) -> - State. - - -terminate(Reason, State) -> - terminate_child(State#state.child, State), - kill_children(State#state.children), - exit(Reason). - - - - -%%====================================================================== -%%====================================================================== -%%====================================================================== -%% This is the process X above... -%%====================================================================== -%%====================================================================== -%%====================================================================== - -%%====================================================================== -%% Start an application. -%% If the start_phases is defined in the .app file, the application is -%% to be started in one or several start phases. -%% If the Module in the mod-key is set to application_starter then -%% the generic help module application_starter is used to control -%% the start. -%%====================================================================== - -start_it(Tag, State, From, Type) -> - process_flag(trap_exit, true), - ApplData = State#state.appl_data, - case {ApplData#appl_data.phases, ApplData#appl_data.mod} of - {undefined, _} -> - start_it_old(Tag, From, Type, ApplData); - {Phases, {application_starter, [M, A]}} -> - start_it_new(Tag, From, Type, M, A, Phases, - [ApplData#appl_data.name]); - {Phases, {M, A}} -> - start_it_new(Tag, From, Type, M, A, Phases, - [ApplData#appl_data.name]); - {OtherP, OtherM} -> - From ! {Tag, {error, {bad_keys, {{mod, OtherM}, - {start_phases, OtherP}}}}} - end. - - -%%%----------------------------------------------------- -%%% No start phases are defined -%%%----------------------------------------------------- -start_it_old(Tag, From, Type, ApplData) -> - {M,A} = ApplData#appl_data.mod, - case catch M:start(Type, A) of - {ok, Pid} -> - link(Pid), - {ok, self()}, - From ! {Tag, {ok, self()}}, - loop_it(From, Pid, M, []); - {ok, Pid, AppState} -> - link(Pid), - {ok, self()}, - From ! {Tag, {ok, self()}}, - loop_it(From, Pid, M, AppState); - {'EXIT', normal} -> - From ! {Tag, {error, {{'EXIT',normal},{M,start,[Type,A]}}}}; - {error, Reason} -> - From ! {Tag, {error, {Reason, {M,start,[Type,A]}}}}; - Other -> - From ! {Tag, {error, {bad_return,{{M,start,[Type,A]},Other}}}} - end. - - -%%%----------------------------------------------------- -%%% Start phases are defined -%%%----------------------------------------------------- -start_it_new(Tag, From, Type, M, A, Phases, Apps) -> - case catch start_the_app(Type, M, A, Phases, Apps) of - {ok, Pid, AppState} -> - From ! {Tag, {ok, self()}}, - loop_it(From, Pid, M, AppState); - Error -> - From ! {Tag, Error} - end. - - -%%%===================================================== -%%% Start the application in the defined phases, -%%% but first the supervisors are starter. -%%%===================================================== -start_the_app(Type, M, A, Phases, Apps) -> - case start_supervisor(Type, M, A) of - {ok, Pid, AppState} -> - link(Pid), - case application_starter:start(Phases, Type, Apps) of - ok -> - {ok, Pid, AppState}; - Error2 -> - unlink(Pid), - Error2 - end; - Error -> - Error - end. - -%%%------------------------------------------------------------- -%%% Start the supervisors -%%%------------------------------------------------------------- -start_supervisor(Type, M, A) -> - case catch M:start(Type, A) of - {ok, Pid} -> - {ok, Pid, []}; - {ok, Pid, AppState} -> - {ok, Pid, AppState}; - {error, Reason} -> - {error, {Reason, {M, start, [Type, A]}}}; - {'EXIT', normal} -> - {error, {{'EXIT', normal}, {M, start, [Type, A]}}}; - Other -> - {error, {bad_return, {{M, start, [Type, A]}, Other}}} - end. - - - - -%%====================================================================== -%% -%%====================================================================== - -loop_it(Parent, Child, Mod, AppState) -> - receive - {Parent, get_child} -> - Parent ! {self(), Child, Mod}, - loop_it(Parent, Child, Mod, AppState); - {Parent, terminate} -> - NewAppState = prep_stop(Mod, AppState), - exit(Child, shutdown), - receive - {'EXIT', Child, _} -> ok - end, - catch Mod:stop(NewAppState), - exit(normal); - {'EXIT', Parent, Reason} -> - NewAppState = prep_stop(Mod, AppState), - exit(Child, Reason), - receive - {'EXIT', Child, Reason2} -> - exit(Reason2) - end, - catch Mod:stop(NewAppState); - {'EXIT', Child, Reason} -> % forward *all* exit reasons (inc. normal) - NewAppState = prep_stop(Mod, AppState), - catch Mod:stop(NewAppState), - exit(Reason); - _ -> - loop_it(Parent, Child, Mod, AppState) - end. - -prep_stop(Mod, AppState) -> - case catch Mod:prep_stop(AppState) of - {'EXIT', {undef, _}} -> - AppState; - {'EXIT', Reason} -> - error_logger:error_report([{?MODULE, shutdown_error}, - {Mod, {prep_stop, [AppState]}}, - {error_info, Reason}]), - AppState; - NewAppState -> - NewAppState - end. - -get_child_i(Child) -> - Child ! {self(), get_child}, - receive - {Child, GrandChild, Mod} -> {GrandChild, Mod} - end. - -terminate_child_i(Child, State) -> - Child ! {self(), terminate}, - terminate_loop(Child, State). - -%% Try to shutdown the child gently -terminate_child(undefined, _) -> ok; -terminate_child(Child, State) -> - terminate_child_i(Child, State). - -kill_children(Children) -> - lists:foreach(fun(Pid) -> exit(Pid, kill) end, Children), - kill_all_procs(). - -kill_all_procs() -> - kill_all_procs_1(processes(), self(), 0). - -kill_all_procs_1([Self|Ps], Self, N) -> - kill_all_procs_1(Ps, Self, N); -kill_all_procs_1([P|Ps], Self, N) -> - case process_info(P, group_leader) of - {group_leader,Self} -> - exit(P, kill), - kill_all_procs_1(Ps, Self, N+1); - _ -> - kill_all_procs_1(Ps, Self, N) - end; -kill_all_procs_1([], _, 0) -> ok; -kill_all_procs_1([], _, _) -> kill_all_procs(). - -set_timer(infinity) -> ok; -set_timer(Time) -> timer:exit_after(Time, timeout). diff --git a/patches/kernel/kernel.app.src b/patches/kernel/kernel.app.src deleted file mode 100644 index 011f743..0000000 --- a/patches/kernel/kernel.app.src +++ /dev/null @@ -1,110 +0,0 @@ -%% This is an -*- erlang -*- file. -{application, kernel, - [ - {description, "ERTS CXC 138 10"}, - {vsn, "%VSN%"}, - {modules, [application, - application_controller, - application_master, - application_starter, - auth, - code, - code_aux, - packages, - code_server, - dist_util, - erl_boot_server, - erl_distribution, - erl_prim_loader, - erl_reply, - erlang, - error_handler, - error_logger, - file, - file_server, - file_io_server, - prim_file, - global, - global_group, - global_search, - gproc, - gen_leader, - group, - heart, - hipe_unified_loader, - inet6_tcp, - inet6_tcp_dist, - inet6_udp, - inet_config, - inet_hosts, - inet_gethost_native, - inet_tcp_dist, - init, - kernel, - kernel_config, - net, - net_adm, - net_kernel, - os, - ram_file, - rpc, - user, - user_drv, - user_sup, - disk_log, - disk_log_1, - disk_log_server, - disk_log_sup, - dist_ac, - erl_ddll, - erl_epmd, - erts_debug, - gen_tcp, - gen_udp, - gen_sctp, - prim_inet, - inet, - inet_db, - inet_dns, - inet_parse, - inet_res, - inet_tcp, - inet_udp, - inet_sctp, - pg2, - seq_trace, - wrap_log_reader, - zlib, - otp_ring0]}, - {registered, [application_controller, - erl_reply, - auth, - boot_server, - code_server, - disk_log_server, - disk_log_sup, - erl_prim_loader, - error_logger, - file_server_2, - fixtable_server, - global_group, - global_name_server, - gproc, - heart, - init, - kernel_config, - kernel_sup, - net_kernel, - net_sup, - rex, - user, - os_server, - ddll_server, - erl_epmd, - inet_db, - pg2]}, - {applications, []}, - {env, [{error_logger, tty}]}, - {mod, {kernel, []}} - ] -}. diff --git a/patches/kernel/kernel.erl b/patches/kernel/kernel.erl deleted file mode 100644 index f39e117..0000000 --- a/patches/kernel/kernel.erl +++ /dev/null @@ -1,306 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(kernel). - --behaviour(supervisor). - -%% External exports --export([start/2, init/1, stop/1]). --export([config_change/3]). - -%%%----------------------------------------------------------------- -%%% The kernel is the first application started. -%%% Callback functions for the kernel application. -%%%----------------------------------------------------------------- -start(_, []) -> - {ok, _} = gproc:start_local(), - case supervisor:start_link({local, kernel_sup}, kernel, []) of - {ok, Pid} -> - Type = get_error_logger_type(), - error_logger:swap_handler(Type), - {ok, Pid, []}; - Error -> Error - end. - -stop(_State) -> - ok. - -%%------------------------------------------------------------------- -%% Some configuration parameters for kernel are changed -%%------------------------------------------------------------------- -config_change(Changed, New, Removed) -> - do_distribution_change(Changed, New, Removed), - do_global_groups_change(Changed, New, Removed), - ok. - -get_error_logger_type() -> - case application:get_env(kernel, error_logger) of - {ok, tty} -> tty; - {ok, {file, File}} when is_list(File) -> {logfile, File}; - {ok, false} -> false; - {ok, silent} -> silent; - undefined -> tty; % default value - {ok, Bad} -> exit({bad_config, {kernel, {error_logger, Bad}}}) - end. - -%%%----------------------------------------------------------------- -%%% The process structure in kernel is as shown in the figure. -%%% -%%% --------------- -%%% | kernel_sup (A)| -%%% --------------- -%%% | -%%% ------------------------------- -%%% | | | -%%% ------------- ------------- -%%% (file,code, | erl_dist (A)| | safe_sup (1)| -%%% rpc, ...) ------------- ------------- -%%% | | -%%% (net_kernel, (disk_log, pg2, -%%% auth, ...) ...) -%%% -%%% The rectangular boxes are supervisors. All supervisors except -%%% for kernel_safe_sup terminates the enitre erlang node if any of -%%% their children dies. Any child that can't be restarted in case -%%% of failure must be placed under one of these supervisors. Any -%%% other child must be placed under safe_sup. These children may -%%% be restarted. Be aware that if a child is restarted the old state -%%% and all data will be lost. -%%%----------------------------------------------------------------- -%%% Callback functions for the kernel_sup supervisor. -%%%----------------------------------------------------------------- - -init([]) -> - SupFlags = {one_for_all, 0, 1}, - - Config = {kernel_config, - {kernel_config, start_link, []}, - permanent, 2000, worker, [kernel_config]}, - Code = {code_server, - {code, start_link, get_code_args()}, - permanent, 2000, worker, [code]}, - File = {file_server_2, - {file_server, start_link, []}, - permanent, 2000, worker, - [file, file_server, file_io_server, prim_file]}, - User = {user, - {user_sup, start, []}, - temporary, 2000, supervisor, [user_sup]}, - - case init:get_argument(mode) of - {ok, [["minimal"]]} -> - - SafeSupervisor = {kernel_safe_sup, - {supervisor, start_link, - [{local, kernel_safe_sup}, ?MODULE, safe]}, - permanent, infinity, supervisor, [?MODULE]}, - - {ok, {SupFlags, - [File, Code, User, - Config, SafeSupervisor]}}; - _ -> - Rpc = {rex, {rpc, start_link, []}, - permanent, 2000, worker, [rpc]}, - Global = {global_name_server, {global, start_link, []}, - permanent, 2000, worker, [global]}, - Glo_grp = {global_group, {global_group,start_link,[]}, - permanent, 2000, worker, [global_group]}, - InetDb = {inet_db, {inet_db, start_link, []}, - permanent, 2000, worker, [inet_db]}, - NetSup = {net_sup, {erl_distribution, start_link, []}, - permanent, infinity, supervisor,[erl_distribution]}, - DistAC = start_dist_ac(), - - GProc = {gproc, {gproc, go_global, []}, - permanent, 3000, worker, [gproc]}, - - Timer = start_timer(), - - SafeSupervisor = {kernel_safe_sup, - {supervisor, start_link, - [{local, kernel_safe_sup}, ?MODULE, safe]}, - permanent, infinity, supervisor, [?MODULE]}, - - {ok, {SupFlags, - [Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, Code, - User, Config, GProc, SafeSupervisor] ++ Timer}} - end; - -init(safe) -> - SupFlags = {one_for_one, 4, 3600}, - Boot = start_boot_server(), - DiskLog = start_disk_log(), - Pg2 = start_pg2(), - {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. - -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. - -start_dist_ac() -> - Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], - case application:get_env(kernel, start_dist_ac) of - {ok, true} -> Spec; - {ok, false} -> []; - undefined -> - case application:get_env(kernel, distributed) of - {ok, _} -> Spec; - _ -> [] - end - end. - -start_boot_server() -> - case application:get_env(kernel, start_boot_server) of - {ok, true} -> - Args = get_boot_args(), - [{boot_server, {erl_boot_server, start_link, [Args]}, permanent, - 1000, worker, [erl_boot_server]}]; - _ -> - [] - end. - -get_boot_args() -> - case application:get_env(kernel, boot_server_slaves) of - {ok, Slaves} -> Slaves; - _ -> [] - end. - -start_disk_log() -> - case application:get_env(kernel, start_disk_log) of - {ok, true} -> - [{disk_log_server, - {disk_log_server, start_link, []}, - permanent, 2000, worker, [disk_log_server]}, - {disk_log_sup, {disk_log_sup, start_link, []}, permanent, - 1000, supervisor, [disk_log_sup]}]; - _ -> - [] - end. - -start_pg2() -> - case application:get_env(kernel, start_pg2) of - {ok, true} -> - [{pg2, {pg2, start_link, []}, permanent, 1000, worker, [pg2]}]; - _ -> - [] - end. - -start_timer() -> - case application:get_env(kernel, start_timer) of - {ok, true} -> - [{timer_server, {timer, start_link, []}, permanent, 1000, worker, - [timer]}]; - _ -> - [] - end. - - - - - -%%----------------------------------------------------------------- -%% The change of the distributed parameter is taken care of here -%%----------------------------------------------------------------- -do_distribution_change(Changed, New, Removed) -> - %% check if the distributed parameter is changed. It is not allowed - %% to make a local application to a distributed one, or vice versa. - case is_dist_changed(Changed, New, Removed) of - %%{changed, new, removed} - {false, false, false} -> - ok; - {C, false, false} -> - %% At last, update the parameter. - gen_server:call(dist_ac, {distribution_changed, C}, infinity); - {false, _, false} -> - error_logger:error_report("Distribution not changed: " - "Not allowed to add the 'distributed' " - "parameter."), - {error, {distribution_not_changed, "Not allowed to add the " - "'distributed' parameter"}}; - {false, false, _} -> - error_logger:error_report("Distribution not changed: " - "Not allowed to remove the " - "distribution parameter."), - {error, {distribution_not_changed, "Not allowed to remove the " - "'distributed' parameter"}} - end. - -%%----------------------------------------------------------------- -%% Check if distribution is changed in someway. -%%----------------------------------------------------------------- -is_dist_changed(Changed, New, Removed) -> - C = case lists:keysearch(distributed, 1, Changed) of - false -> - false; - {value, {distributed, NewDistC}} -> - NewDistC - end, - N = case lists:keysearch(distributed, 1, New) of - false -> - false; - {value, {distributed, NewDistN}} -> - NewDistN - end, - R = lists:member(distributed, Removed), - {C, N, R}. - - - -%%----------------------------------------------------------------- -%% The change of the global_groups parameter is taken care of here -%%----------------------------------------------------------------- -do_global_groups_change(Changed, New, Removed) -> - %% check if the global_groups parameter is changed. - - case is_gg_changed(Changed, New, Removed) of - %%{changed, new, removed} - {false, false, false} -> - ok; - {C, false, false} -> - %% At last, update the parameter. - global_group:global_groups_changed(C); - {false, N, false} -> - global_group:global_groups_added(N); - {false, false, R} -> - global_group:global_groups_removed(R) - end. - -%%----------------------------------------------------------------- -%% Check if global_groups is changed in someway. -%%----------------------------------------------------------------- -is_gg_changed(Changed, New, Removed) -> - C = case lists:keysearch(global_groups, 1, Changed) of - false -> - false; - {value, {global_groups, NewDistC}} -> - NewDistC - end, - N = case lists:keysearch(global_groups, 1, New) of - false -> - false; - {value, {global_groups, NewDistN}} -> - NewDistN - end, - R = lists:member(global_groups, Removed), - {C, N, R}. - - - diff --git a/patches/stdlib/gen.erl b/patches/stdlib/gen.erl deleted file mode 100644 index 85b86f6..0000000 --- a/patches/stdlib/gen.erl +++ /dev/null @@ -1,366 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(gen). - -%%%----------------------------------------------------------------- -%%% This module implements the really generic stuff of the generic -%%% standard behaviours (e.g. gen_server, gen_fsm). -%%% -%%% The standard behaviour should export init_it/6. -%%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/1, - call/3, call/4, reply/2]). --export([reg_behaviour/1]). --export([init_it/6, init_it/7]). - --define(default_timeout, 5000). - -%%----------------------------------------------------------------- -%% Starts a generic process. -%% start(GenMod, LinkP, Mod, Args, Options) -%% start(GenMod, LinkP, Name, Mod, Args, Options) -%% start_link(Mod, Args, Options) -%% start_link(Name, Mod, Args, Options) where: -%% Name = {local, atom()} | {global, atom()} -%% Mod = atom(), callback module implementing the 'real' fsm -%% Args = term(), init arguments (to Mod:init/1) -%% Options = [{debug, [Flag]}] -%% Flag = trace | log | {logfile, File} | statistics | debug -%% (debug == log && statistics) -%% Returns: {ok, Pid} | -%% {error, {already_started, Pid}} | -%% {error, Reason} -%%----------------------------------------------------------------- -start(GenMod, LinkP, Name, Mod, Args, Options) -> - case where(Name) of - undefined -> - do_spawn(GenMod, LinkP, Name, Mod, Args, Options); - Pid -> - {error, {already_started, Pid}} - end. - -start(GenMod, LinkP, Mod, Args, Options) -> - do_spawn(GenMod, LinkP, Mod, Args, Options). - -%%----------------------------------------------------------------- -%% Spawn the process (and link) maybe at another node. -%% If spawn without link, set parent to our selves "self"!!! -%%----------------------------------------------------------------- -do_spawn(GenMod, link, Mod, Args, Options) -> - Time = timeout(Options), - proc_lib:start_link(gen, init_it, - [GenMod, self(), self(), Mod, Args, Options], - Time, - spawn_opts(Options)); -do_spawn(GenMod, _, Mod, Args, Options) -> - Time = timeout(Options), - proc_lib:start(gen, init_it, - [GenMod, self(), self, Mod, Args, Options], - Time, - spawn_opts(Options)). -do_spawn(GenMod, link, Name, Mod, Args, Options) -> - Time = timeout(Options), - proc_lib:start_link(gen, init_it, - [GenMod, self(), self(), Name, Mod, Args, Options], - Time, - spawn_opts(Options)); -do_spawn(GenMod, _, Name, Mod, Args, Options) -> - Time = timeout(Options), - proc_lib:start(gen, init_it, - [GenMod, self(), self, Name, Mod, Args, Options], - Time, - spawn_opts(Options)). - - -reg_behaviour(B) -> - catch begin - Key = {p,l,behaviour}, - try gproc:reg(Key, B) - catch - error:badarg -> - gproc:set_value(Key, B) - end - end. - - -%%----------------------------------------------------------------- -%% Initiate the new process. -%% Register the name using the Rfunc function -%% Calls the Mod:init/Args function. -%% Finally an acknowledge is sent to Parent and the main -%% loop is entered. -%%----------------------------------------------------------------- -init_it(GenMod, Starter, Parent, Mod, Args, Options) -> - init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). - -init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - case name_register(Name) of - true -> - init_it2(GenMod, Starter, Parent, name(Name), Mod, Args, Options); - {false, Pid} -> - proc_lib:init_ack(Starter, {error, {already_started, Pid}}) - end. - -init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - GenMod:init_it(Starter, Parent, Name, Mod, Args, Options). - - -%%----------------------------------------------------------------- -%% Makes a synchronous call to a generic process. -%% Request is sent to the Pid, and the response must be -%% {Tag, _, Reply}. -%%----------------------------------------------------------------- - -%%% New call function which uses the new monitor BIF -%%% call(ServerId, Label, Request) - -call(Process, Label, Request) -> - call(Process, Label, Request, ?default_timeout). - -%% Local or remote by pid -call(Pid, Label, Request, Timeout) - when is_pid(Pid), Timeout =:= infinity; - is_pid(Pid), is_integer(Timeout), Timeout >= 0 -> - do_call(Pid, Label, Request, Timeout); -%% Local by name -call(Name, Label, Request, Timeout) - when is_atom(Name), Timeout =:= infinity; - is_atom(Name), is_integer(Timeout), Timeout >= 0 -> - case whereis(Name) of - Pid when is_pid(Pid) -> - do_call(Pid, Label, Request, Timeout); - undefined -> - exit(noproc) - end; -%% Global by name -call({global, _Name}=Process, Label, Request, Timeout) - when Timeout =:= infinity; - is_integer(Timeout), Timeout >= 0 -> - case where(Process) of - Pid when is_pid(Pid) -> - Node = node(Pid), - case catch do_call(Pid, Label, Request, Timeout) of - {'EXIT', {nodedown, Node}} -> - % A nodedown not yet detected by global, pretend that it - % was. - exit(noproc); - {'EXIT', noproc} -> - exit(noproc); - {'EXIT', OtherExits} -> - exit(OtherExits); - Result -> - Result - end; - undefined -> - exit(noproc) - end; -%% Local by name in disguise -call({Name, Node}, Label, Request, Timeout) - when Node =:= node(), Timeout =:= infinity; - Node =:= node(), is_integer(Timeout), Timeout >= 0 -> - call(Name, Label, Request, Timeout); -%% Remote by name -call({_Name, Node}=Process, Label, Request, Timeout) - when is_atom(Node), Timeout =:= infinity; - is_atom(Node), is_integer(Timeout), Timeout >= 0 -> - if - node() =:= nonode@nohost -> - exit({nodedown, Node}); - true -> - do_call(Process, Label, Request, Timeout) - end. - -do_call(Process, Label, Request, Timeout) -> - %% We trust the arguments to be correct, i.e - %% Process is either a local or remote pid, - %% or a {Name, Node} tuple (of atoms) and in this - %% case this node (node()) _is_ distributed and Node =/= node(). - Node = case Process of - {_S, N} -> - N; - _ when is_pid(Process) -> - node(Process); - _ -> - node() - end, - case catch erlang:monitor(process, Process) of - Mref when is_reference(Mref) -> - receive - {'DOWN', Mref, _, Pid1, noconnection} when is_pid(Pid1) -> - exit({nodedown, node(Pid1)}); - {'DOWN', Mref, _, _, noconnection} -> - exit({nodedown, Node}); - {'DOWN', Mref, _, _, _} -> - exit(noproc) - after 0 -> - Process ! {Label, {self(), Mref}, Request}, - wait_resp_mon(Process, Mref, Timeout) - end; - {'EXIT', _} -> - %% Old node is not supporting the monitor. - %% The other possible case -- this node is not distributed - %% -- should have been handled earlier. - %% Do the best possible with monitor_node/2. - %% This code may hang indefinitely if the Process - %% does not exist. It is only used for old remote nodes. - monitor_node(Node, true), - receive - {nodedown, Node} -> - monitor_node(Node, false), - exit({nodedown, Node}) - after 0 -> - Mref = make_ref(), - Process ! {Label, {self(),Mref}, Request}, - Res = wait_resp(Node, Mref, Timeout), - monitor_node(Node, false), - Res - end - end. - -wait_resp_mon(Process, Mref, Timeout) -> - Node = case Process of - {_S, N} -> - N; - _ when is_pid(Process) -> - node(Process); - _ -> - node() - end, - receive - {Mref, Reply} -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> - {ok, Reply} - after 0 -> - {ok, Reply} - end; - {'DOWN', Mref, _, Pid, Reason} when is_pid(Pid) -> - receive - {'EXIT', Pid, noconnection} -> - exit({nodedown, Node}); - {'EXIT', Pid, What} -> - exit(What) - after 1 -> % Give 'EXIT' message time to arrive - case Reason of - noconnection -> - exit({nodedown, Node}); - _ -> - exit(Reason) - end - end; - {'DOWN', Mref, _, _, noconnection} -> - %% Here is a hole, when the monitor is remote by name - %% and the remote node goes down, we will never find - %% out the Pid and cannot know which 'EXIT' message - %% to read out. This awkward case should have been - %% handled earlier (except for against rex) - %% by not using remote monitor by name. - case Process of - _ when is_pid(Process) -> - receive - {'EXIT', Process, noconnection} -> - exit({nodedown, Node}); - {'EXIT', Process, What} -> - exit(What) - after 1 -> % Give 'EXIT' message time to arrive - exit({nodedown, node(Process)}) - end; - _ -> - exit({nodedown, Node}) - end; - %% {'DOWN', Mref, _, _, noproc} -> - %% exit(noproc); - {'DOWN', Mref, _Tag, _Item, Reason} -> - exit(Reason) - after Timeout -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _Reason} -> true - after 0 -> true - end, - exit(timeout) - end. - -wait_resp(Node, Tag, Timeout) -> - receive - {Tag, Reply} -> - {ok,Reply}; - {nodedown, Node} -> - monitor_node(Node, false), - exit({nodedown, Node}) - after Timeout -> - monitor_node(Node, false), - exit(timeout) - end. - -% -% Send a reply to the client. -% -reply({To, Tag}, Reply) -> - catch To ! {Tag, Reply}. - -%%%----------------------------------------------------------------- -%%% Misc. functions. -%%%----------------------------------------------------------------- -where({global, Name}) -> global:safe_whereis_name(Name); -where({local, Name}) -> whereis(Name). - -name({global, Name}) -> Name; -name({local, Name}) -> Name. - -name_register({local, Name}) -> - case catch register(Name, self()) of - true -> true; - {'EXIT', _} -> - {false, where({local, Name})} - end; -name_register({global, Name}) -> - case global:register_name(Name, self()) of - yes -> true; - no -> {false, where({global, Name})} - end. - -timeout(Options) -> - case opt(timeout, Options) of - {ok, Time} -> - Time; - _ -> - infinity - end. - -spawn_opts(Options) -> - case opt(spawn_opt, Options) of - {ok, Opts} -> - Opts; - _ -> - [] - end. - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Opts) -> - case opt(debug, Opts) of - {ok, Options} -> sys:debug_options(Options); - _ -> [] - end. diff --git a/patches/stdlib/gen_event.erl b/patches/stdlib/gen_event.erl deleted file mode 100644 index 51d0409..0000000 --- a/patches/stdlib/gen_event.erl +++ /dev/null @@ -1,659 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(gen_event). - -%%% -%%% A general event handler. -%%% Several handlers (functions) can be added. -%%% Each handler holds a state and will be called -%%% for every event received of the handler. -%%% - -%%% Modified by Magnus. -%%% Take care of fault situations and made notify asynchronous. -%%% Re-written by Joe with new functional interface ! -%%% Modified by Martin - uses proc_lib, sys and gen! - - --export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2, - sync_notify/2, - add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, - swap_sup_handler/3, which_handlers/1, call/3, call/4]). - --export([behaviour_info/1]). - --export([init_it/6, - system_continue/3, - system_terminate/4, - system_code_change/4, - print_event/3, - format_status/2]). - --import(error_logger, [error_msg/2]). - --define(reply(X), From ! {element(2,Tag), X}). - --record(handler, {module, - id = false, - state, - supervised = false}). - -behaviour_info(callbacks) -> - [{init,1},{handle_event,2},{handle_call,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - -%% gen_event:start(Handler) -> ok | {error, What} -%% gen_event:add_handler(Handler, Mod, Args) -> ok | Other -%% gen_event:notify(Handler, Event) -> ok -%% gen_event:call(Handler, Mod, Query) -> {ok, Val} | {error, Why} -%% gen_event:call(Handler, Mod, Query, Timeout) -> {ok, Val} | {error, Why} -%% gen_event:delete_handler(Handler, Mod, Args) -> Val -%% gen_event:swap_handler(Handler, {OldMod, Args1}, {NewMod, Args2}) -> ok -%% gen_event:which_handler(Handler) -> [Mod] -%% gen_event:stop(Handler) -> ok - - -%% handlers must export -%% Mod:init(Args) -> {ok, State} | Other -%% Mod:handle_event(Event, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_info(Info, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_call(Query, State) -> -%% {ok, Reply, State'} | {remove_handler, Reply} | -%% {swap_handler, Reply, Args1,State1,Mod2,Args2} -%% Mod:terminate(Args, State) -> Val - - -%% add_handler(H, Mod, Args) -> ok | Other -%% Mod:init(Args) -> {ok, State} | Other - -%% delete_handler(H, Mod, Args) -> Val -%% Mod:terminate(Args, State) -> Val - -%% notify(H, Event) -%% Mod:handle_event(Event, State) -> -%% {ok, State1} -%% remove_handler -%% Mod:terminate(remove_handler, State) is called -%% the return value is ignored -%% {swap_handler, Args1, State1, Mod2, Args2} -%% State2 = Mod:terminate(Args1, State1) is called -%% the return value is chained into the new module and -%% Mod2:init({Args2, State2}) is called -%% Other -%% Mod:terminate({error, Other}, State) is called -%% The return value is ignored -%% call(H, Mod, Query) -> Val -%% call(H, Mod, Query, Timeout) -> Val -%% Mod:handle_call(Query, State) -> as above - - -start() -> - gen:start(gen_event, nolink, [], [], []). - -start(Name) -> - gen:start(gen_event, nolink, Name, [], [], []). - -start_link() -> - gen:start(gen_event, link, [], [], []). - -start_link(Name) -> - gen:start(gen_event, link, Name, [], [], []). - -init_it(Starter, self, Name, Mod, Args, Options) -> - init_it(Starter, self(), Name, Mod, Args, Options); -init_it(Starter, Parent, Name, _, _, Options) -> - process_flag(trap_exit, true), - gen:reg_behaviour(?MODULE), - Debug = gen:debug_options(Options), - proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, [], Debug). - -add_handler(M, Handler, Args) -> rpc (M, {add_handler, Handler, Args}). -add_sup_handler(M, Handler, Args) -> - rpc (M, {add_sup_handler, Handler, Args, self()}). -notify(M, Event) -> send(M, {notify, Event}). -sync_notify(M, Event) -> rpc (M, {sync_notify, Event}). -call(M, Handler, Query) -> call1(M, Handler, Query). -call(M, Handler, Query, Timeout) -> call1(M, Handler, Query, Timeout). -delete_handler(M, Handler, Args) -> rpc (M, {delete_handler, Handler, Args}). -swap_handler(M, {H1, A1},{H2, A2}) -> rpc (M, {swap_handler, H1, A1, H2, A2}). -swap_sup_handler(M, {H1, A1},{H2, A2}) -> - rpc (M, {swap_sup_handler, H1, A1, H2, A2, self()}). -which_handlers(M) -> rpc (M, which_handlers). -stop(M) -> rpc (M, stop). - -rpc(M, Cmd) -> - {ok,Reply} = gen:call(M, self(), Cmd, infinity), - Reply. - -call1(M, Handler, Query) -> - Cmd = {call, Handler, Query}, - case catch gen:call(M, self(), Cmd) of - {ok,Res} -> - Res; - {'EXIT', Reason} -> - exit({Reason, {gen_event, call, [M, Handler, Query]}}) - end. - -call1(M, Handler, Query, Timeout) -> - Cmd = {call, Handler, Query}, - case catch gen:call(M, self(), Cmd, Timeout) of - {ok,Res} -> - Res; - {'EXIT', Reason} -> - exit({Reason, {gen_event, call, [M, Handler, Query, Timeout]}}) - end. - -send({global, Name}, Cmd) -> - catch global:send(Name, Cmd), - ok; -send(M, Cmd) -> - M ! Cmd, - ok. - -loop(Parent, ServerName, MSL, Debug) -> - receive - {system, From, Req} -> - sys:handle_system_msg(Req, From, Parent, gen_event, Debug, - [ServerName, MSL]); - {'EXIT', Parent, Reason} -> - terminate_server(Reason, Parent, MSL, ServerName); - Msg when Debug =:= [] -> - handle_msg(Msg, Parent, ServerName, MSL, []); - Msg -> - Debug1 = sys:handle_debug(Debug, {gen_event, print_event}, - ServerName, {in, Msg}), - handle_msg(Msg, Parent, ServerName, MSL, Debug1) - end. - -handle_msg(Msg, Parent, ServerName, MSL, Debug) -> - case Msg of - {notify, Event} -> - MSL1 = server_notify(Event, handle_event, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {sync_notify, Event}} -> - MSL1 = server_notify(Event, handle_event, MSL, ServerName), - ?reply(ok), - loop(Parent, ServerName, MSL1, Debug); - {'EXIT', From, Reason} -> - MSL1 = handle_exit(From, Reason, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {call, Handler, Query}} -> - {Reply, MSL1} = server_call(Handler, Query, MSL, ServerName), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {add_handler, Handler, Args}} -> - {Reply, MSL1} = server_add_handler(Handler, Args, MSL), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {add_sup_handler, Handler, Args, SupP}} -> - {Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {delete_handler, Handler, Args}} -> - {Reply, MSL1} = server_delete_handler(Handler, Args, MSL, - ServerName), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> - {Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, - Args2, MSL, ServerName), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, - Sup}} -> - {Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, - Args2, MSL, Sup, ServerName), - ?reply(Reply), - loop(Parent, ServerName, MSL1, Debug); - {From, Tag, stop} -> - catch terminate_server(normal, Parent, MSL, ServerName), - ?reply(ok); - {From, Tag, which_handlers} -> - ?reply(the_handlers(MSL)), - loop(Parent, ServerName, MSL, Debug); - {From, Tag, get_modules} -> - ?reply(get_modules(MSL)), - loop(Parent, ServerName, MSL, Debug); - Other -> - MSL1 = server_notify(Other, handle_info, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug) - end. - -terminate_server(Reason, Parent, MSL, ServerName) -> - stop_handlers(MSL, ServerName), - do_unlink(Parent, MSL), - exit(Reason). - -%% unlink the supervisor process of all supervised handlers. -%% We do not want a handler supervisor to EXIT due to the -%% termination of the event manager (server). -%% Do not unlink Parent ! -do_unlink(Parent, MSL) -> - lists:foreach(fun(Handler) when Handler#handler.supervised =:= Parent -> - true; - (Handler) when is_pid(Handler#handler.supervised) -> - unlink(Handler#handler.supervised), - true; - (_) -> - true - end, - MSL). - -%% First terminate the supervised (if exists) handlers and -%% then inform other handlers. -%% We do not know if any handler really is interested but it -%% may be so ! -handle_exit(From, Reason, MSL, SName) -> - MSL1 = terminate_supervised(From, Reason, MSL, SName), - server_notify({'EXIT', From, Reason}, handle_info, MSL1, SName). - -terminate_supervised(Pid, Reason, MSL, SName) -> - F = fun(Ha) when Ha#handler.supervised =:= Pid -> - do_terminate(Ha#handler.module, - Ha, - {stop,Reason}, - Ha#handler.state, - {parent_terminated, {Pid,Reason}}, - SName, - shutdown), - false; - (_) -> - true - end, - lists:filter(F, MSL). - -%%----------------------------------------------------------------- -%% Callback functions for system messages handling. -%%----------------------------------------------------------------- -system_continue(Parent, Debug, [ServerName, MSL]) -> - loop(Parent, ServerName, MSL, Debug). - -system_terminate(Reason, Parent, _Debug, [ServerName, MSL]) -> - terminate_server(Reason, Parent, MSL, ServerName). - -%%----------------------------------------------------------------- -%% Module here is sent in the system msg change_code. It specifies -%% which module should be changed. -%%----------------------------------------------------------------- -system_code_change([ServerName, MSL], Module, OldVsn, Extra) -> - MSL1 = lists:zf(fun(H) when H#handler.module =:= Module -> - {ok, NewState} = - Module:code_change(OldVsn, - H#handler.state, Extra), - {true, H#handler{state = NewState}}; - (_) -> true - end, - MSL), - {ok, [ServerName, MSL1]}. - -%%----------------------------------------------------------------- -%% Format debug messages. Print them as the call-back module sees -%% them, not as the real erlang messages. Use trace for that. -%%----------------------------------------------------------------- -print_event(Dev, {in, Msg}, Name) -> - case Msg of - {notify, Event} -> - io:format(Dev, "*DBG* ~p got event ~p~n", [Name, Event]); - {_,_,{call, Handler, Query}} -> - io:format(Dev, "*DBG* ~p(~p) got call ~p~n", - [Name, Handler, Query]); - _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) - end; -print_event(Dev, Dbg, Name) -> - io:format(Dev, "*DBG* ~p : ~p~n", [Name, Dbg]). - - -%% server_add_handler(Handler, Args, MSL) -> {Ret, MSL'}. -%% where MSL = [#handler] -%% Ret goes to the top level MSL' is the new internal state of the -%% event handler - -server_add_handler({Mod,Id}, Args, MSL) -> - Handler = #handler{module = Mod, - id = Id}, - server_add_handler(Mod, Handler, Args, MSL); -server_add_handler(Mod, Args, MSL) -> - Handler = #handler{module = Mod}, - server_add_handler(Mod, Handler, Args, MSL). - -server_add_handler(Mod, Handler, Args, MSL) -> - case catch Mod:init(Args) of - {ok, State} -> - {ok, [Handler#handler{state = State}|MSL]}; - Other -> - {Other, MSL} - end. - -%% Set up a link to the supervising process. -%% (Ought to be unidirected links here, Erl5.0 !!) -%% NOTE: This link will not be removed then the -%% handler is removed in case another handler has -%% own link to this process. -server_add_sup_handler({Mod,Id}, Args, MSL, Parent) -> - link(Parent), - Handler = #handler{module = Mod, - id = Id, - supervised = Parent}, - server_add_handler(Mod, Handler, Args, MSL); -server_add_sup_handler(Mod, Args, MSL, Parent) -> - link(Parent), - Handler = #handler{module = Mod, - supervised = Parent}, - server_add_handler(Mod, Handler, Args, MSL). - -%% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'} - -server_delete_handler(HandlerId, Args, MSL, SName) -> - case split(HandlerId, MSL) of - {Mod, Handler, MSL1} -> - {do_terminate(Mod, Handler, Args, - Handler#handler.state, delete, SName, normal), - MSL1}; - error -> - {{error, module_not_found}, MSL} - end. - -%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SN)= -> MSL' -%% server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SN)= -> MSL' - -server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, SName) -> - {State2, Sup, MSL1} = split_and_terminate(Handler1, Args1, MSL, - SName, Handler2, false), - case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of - {ok, MSL2} -> - {ok, MSL2}; - {What, MSL2} -> - {{error, What}, MSL2} - end. - -server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, SName) -> - {State2, _, MSL1} = split_and_terminate(Handler1, Args1, MSL, - SName, Handler2, Sup), - case s_s_h(Sup, Handler2, {Args2, State2}, MSL1) of - {ok, MSL2} -> - {ok, MSL2}; - {What, MSL2} -> - {{error, What}, MSL2} - end. - -s_s_h(false, Handler, Args, MSL) -> - server_add_handler(Handler, Args, MSL); -s_s_h(Pid, Handler, Args, MSL) -> - server_add_sup_handler(Handler, Args, MSL, Pid). - -split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) -> - case split(HandlerId, MSL) of - {Mod, Handler, MSL1} -> - OldSup = Handler#handler.supervised, - NewSup = if - not Sup -> OldSup; - true -> Sup - end, - {do_terminate(Mod, Handler, Args, - Handler#handler.state, swapped, SName, - {swapped, Handler2, NewSup}), - OldSup, - MSL1}; - error -> - {error, false, MSL} - end. - -%% server_notify(Event, Func, MSL, SName) -> MSL' - -server_notify(Event, Func, [Handler|T], SName) -> - case server_update(Handler, Func, Event, SName) of - {ok, Handler1} -> - [Handler1|server_notify(Event, Func, T, SName)]; - no -> - server_notify(Event, Func, T, SName) - end; -server_notify(_, _, [], _) -> - []. - -%% server_update(Handler, Func, Event, ServerName) -> Handler1 | no - -server_update(Handler1, Func, Event, SName) -> - Mod1 = Handler1#handler.module, - State = Handler1#handler.state, - case catch Mod1:Func(Event, State) of - {ok, State1} -> - {ok, Handler1#handler{state = State1}}; - {swap_handler, Args1, State1, Handler2, Args2} -> - do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName); - remove_handler -> - do_terminate(Mod1, Handler1, remove_handler, State, - remove, SName, normal), - no; - Other -> - do_terminate(Mod1, Handler1, {error, Other}, State, - Event, SName, crash), - no - end. - -do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName) -> - %% finalise the existing handler - State2 = do_terminate(Mod1, Handler1, Args1, State1, - swapped, SName, - {swapped, Handler2, Handler1#handler.supervised}), - {Mod2,Handler} = new_handler(Handler2, Handler1), - case catch Mod2:init({Args2, State2}) of - {ok, State2a} -> - {ok, Handler#handler{state = State2a}}; - Other -> - report_terminate(Handler2, crash, {error, Other}, SName, false), - no - end. - -new_handler({Mod,Id}, Handler1) -> - {Mod,#handler{module = Mod, - id = Id, - supervised = Handler1#handler.supervised}}; -new_handler(Mod, Handler1) -> - {Mod,#handler{module = Mod, - supervised = Handler1#handler.supervised}}. - - -%% split(Handler, [#handler]) -> -%% {Mod, #handler, [#handler]} | error - -split(Ha, MSL) -> split(Ha, MSL, []). - -split({Mod,Id}, [Ha|T], L) when Ha#handler.module =:= Mod, - Ha#handler.id =:= Id -> - {Mod, Ha, lists:reverse(L, T)}; -split(Mod, [Ha|T], L) when Ha#handler.module =:= Mod, - not Ha#handler.id -> - {Mod, Ha, lists:reverse(L, T)}; -split(Ha, [H|T], L) -> - split(Ha, T, [H|L]); -split(_, [], _) -> - error. - -%% server_call(Handler, Query, MSL, ServerName) -> -%% {Reply, MSL1} - -server_call(Handler, Query, MSL, SName) -> - case search(Handler, MSL) of - {ok, Ha} -> - case server_call_update(Ha, Query, SName) of - {no, Reply} -> - {Reply, delete(Handler, MSL)}; - {{ok, Ha1}, Reply} -> - {Reply, replace(Handler, MSL, Ha1)} - end; - false -> - {{error, bad_module}, MSL} - end. - -search({Mod, Id}, [Ha|_MSL]) when Ha#handler.module =:= Mod, - Ha#handler.id =:= Id -> - {ok, Ha}; -search(Mod, [Ha|_MSL]) when Ha#handler.module =:= Mod, - not Ha#handler.id -> - {ok, Ha}; -search(Handler, [_|MSL]) -> - search(Handler, MSL); -search(_, []) -> - false. - -delete({Mod, Id}, [Ha|MSL]) when Ha#handler.module =:= Mod, - Ha#handler.id =:= Id -> - MSL; -delete(Mod, [Ha|MSL]) when Ha#handler.module =:= Mod, - not Ha#handler.id -> - MSL; -delete(Handler, [Ha|MSL]) -> - [Ha|delete(Handler, MSL)]; -delete(_, []) -> - []. - -replace({Mod, Id}, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod, - Ha#handler.id =:= Id -> - [NewHa|MSL]; -replace(Mod, [Ha|MSL], NewHa) when Ha#handler.module =:= Mod, - not Ha#handler.id -> - [NewHa|MSL]; -replace(Handler, [Ha|MSL], NewHa) -> - [Ha|replace(Handler, MSL, NewHa)]; -replace(_, [], NewHa) -> - [NewHa]. - -%% server_call_update(Handler, Query, ServerName) -> -%% {{Handler1, State1} | no, Reply} - -server_call_update(Handler1, Query, SName) -> - Mod1 = Handler1#handler.module, - State = Handler1#handler.state, - case catch Mod1:handle_call(Query, State) of - {ok, Reply, State1} -> - {{ok, Handler1#handler{state = State1}}, Reply}; - {swap_handler, Reply, Args1, State1, Handler2, Args2} -> - {do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply}; - {remove_handler, Reply} -> - do_terminate(Mod1, Handler1, remove_handler, State, - remove, SName, normal), - {no, Reply}; - Other -> - do_terminate(Mod1, Handler1, {error, Other}, State, - Query, SName, crash), - {no, {error, Other}} -end. - -do_terminate(Mod, Handler, Args, State, LastIn, SName, Reason) -> - Res = (catch Mod:terminate(Args, State)), - report_terminate(Handler, Reason, Args, State, LastIn, SName, Res), - Res. - -report_terminate(Handler, crash, {error, Why}, State, LastIn, SName, _) -> - report_terminate(Handler, Why, State, LastIn, SName); -report_terminate(Handler, How, _, State, LastIn, SName, _) -> - %% How == normal | shutdown | {swapped, NewHandler, NewSupervisor} - report_terminate(Handler, How, State, LastIn, SName). - -report_terminate(Handler, Reason, State, LastIn, SName) -> - report_error(Handler, Reason, State, LastIn, SName), - case Handler#handler.supervised of - false -> - ok; - Pid -> - Pid ! {gen_event_EXIT,handler(Handler),Reason}, - ok - end. - -report_error(_Handler, normal, _, _, _) -> ok; -report_error(_Handler, shutdown, _, _, _) -> ok; -report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; -report_error(Handler, Reason, State, LastIn, SName) -> - Reason1 = - case Reason of - {'EXIT',{undef,[{M,F,A}|MFAs]}} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - {undef,[{M,F,A}|MFAs]}; - false -> - {'function not exported',[{M,F,A}|MFAs]} - end - end; - {'EXIT',Why} -> - Why; - _ -> - Reason - end, - error_msg("** gen_event handler ~p crashed.~n" - "** Was installed in ~p~n" - "** Last event was: ~p~n" - "** When handler state == ~p~n" - "** Reason == ~p~n", - [handler(Handler),SName,LastIn,State,Reason1]). - -handler(Handler) when not Handler#handler.id -> - Handler#handler.module; -handler(Handler) -> - {Handler#handler.module, Handler#handler.id}. - -%% stop_handlers(MSL, ServerName) -> [] - -stop_handlers([Handler|T], SName) -> - Mod = Handler#handler.module, - do_terminate(Mod, Handler, stop, Handler#handler.state, - stop, SName, shutdown), - stop_handlers(T, SName); -stop_handlers([], _) -> - []. - -the_handlers(MSL) -> - lists:map(fun(Handler) when not Handler#handler.id -> - Handler#handler.module; - (Handler) -> - {Handler#handler.module, Handler#handler.id} - end, - MSL). - -%% Message from the release_handler. -%% The list of modules got to be a set ! -get_modules(MSL) -> - Mods = lists:map(fun(Handler) -> Handler#handler.module end, - MSL), - ordsets:to_list(ordsets:from_list(Mods)). - -%%----------------------------------------------------------------- -%% Status information -%%----------------------------------------------------------------- -format_status(_Opt, StatusData) -> - [_PDict, SysState, Parent, _Debug, [ServerName, MSL]] = StatusData, - Header = lists:concat(["Status for event handler ", ServerName]), - [{header, Header}, - {data, [{"Status", SysState}, - {"Parent", Parent}]}, - {items, {"Installed handlers", MSL}}]. - - - - - - diff --git a/patches/stdlib/gen_fsm.erl b/patches/stdlib/gen_fsm.erl deleted file mode 100644 index ff71ac7..0000000 --- a/patches/stdlib/gen_fsm.erl +++ /dev/null @@ -1,596 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(gen_fsm). - -%%%----------------------------------------------------------------- -%%% -%%% This state machine is somewhat more pure than state_lib. It is -%%% still based on State dispatching (one function per state), but -%%% allows a function handle_event to take care of events in all states. -%%% It's not that pure anymore :( We also allow synchronized event sending. -%%% -%%% If the Parent process terminates the Module:terminate/2 -%%% function is called. -%%% -%%% The user module should export: -%%% -%%% init(Args) -%%% ==> {ok, StateName, StateData} -%%% {ok, StateName, StateData, Timeout} -%%% ignore -%%% {stop, Reason} -%%% -%%% StateName(Msg, StateData) -%%% -%%% ==> {next_state, NewStateName, NewStateData} -%%% {next_state, NewStateName, NewStateData, Timeout} -%%% {stop, Reason, NewStateData} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% StateName(Msg, From, StateData) -%%% -%%% ==> {next_state, NewStateName, NewStateData} -%%% {next_state, NewStateName, NewStateData, Timeout} -%%% {reply, Reply, NewStateName, NewStateData} -%%% {reply, Reply, NewStateName, NewStateData, Timeout} -%%% {stop, Reason, NewStateData} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% handle_event(Msg, StateName, StateData) -%%% -%%% ==> {next_state, NewStateName, NewStateData} -%%% {next_state, NewStateName, NewStateData, Timeout} -%%% {stop, Reason, Reply, NewStateData} -%%% {stop, Reason, NewStateData} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% handle_sync_event(Msg, From, StateName, StateData) -%%% -%%% ==> {next_state, NewStateName, NewStateData} -%%% {next_state, NewStateName, NewStateData, Timeout} -%%% {reply, Reply, NewStateName, NewStateData} -%%% {reply, Reply, NewStateName, NewStateData, Timeout} -%%% {stop, Reason, Reply, NewStateData} -%%% {stop, Reason, NewStateData} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% handle_info(Info, StateName) (e.g. {'EXIT', P, R}, {nodedown, N}, ... -%%% -%%% ==> {next_state, NewStateName, NewStateData} -%%% {next_state, NewStateName, NewStateData, Timeout} -%%% {stop, Reason, NewStateData} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% terminate(Reason, StateName, StateData) Let the user module clean up -%%% always called when server terminates -%%% -%%% ==> the return value is ignored -%%% -%%% -%%% The work flow (of the fsm) can be described as follows: -%%% -%%% User module fsm -%%% ----------- ------- -%%% start -----> start -%%% init <----- . -%%% -%%% loop -%%% StateName <----- . -%%% -%%% handle_event <----- . -%%% -%%% handle__sunc_event <----- . -%%% -%%% handle_info <----- . -%%% -%%% terminate <----- . -%%% -%%% -%%% --------------------------------------------------- - --export([start/3, start/4, - start_link/3, start_link/4, - send_event/2, sync_send_event/2, sync_send_event/3, - send_all_state_event/2, - sync_send_all_state_event/2, sync_send_all_state_event/3, - reply/2, - start_timer/2,send_event_after/2,cancel_timer/1, - enter_loop/4, enter_loop/5, enter_loop/6]). - --export([behaviour_info/1]). - -%% Internal exports --export([init_it/6, print_event/3, - system_continue/3, - system_terminate/4, - system_code_change/4, - format_status/2]). - --import(error_logger , [format/2]). - -%%% --------------------------------------------------- -%%% Interface functions. -%%% --------------------------------------------------- - -behaviour_info(callbacks) -> - [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3}, - {terminate,3},{code_change,4}]; -behaviour_info(_Other) -> - undefined. - -%%% --------------------------------------------------- -%%% Starts a generic state machine. -%%% start(Mod, Args, Options) -%%% start(Name, Mod, Args, Options) -%%% start_link(Mod, Args, Options) -%%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} -%%% Mod ::= atom(), callback module implementing the 'real' fsm -%%% Args ::= term(), init arguments (to Mod:init/1) -%%% Options ::= [{debug, [Flag]}] -%%% Flag ::= trace | log | {logfile, File} | statistics | debug -%%% (debug == log && statistics) -%%% Returns: {ok, Pid} | -%%% {error, {already_started, Pid}} | -%%% {error, Reason} -%%% --------------------------------------------------- -start(Mod, Args, Options) -> - gen:start(?MODULE, nolink, Mod, Args, Options). - -start(Name, Mod, Args, Options) -> - gen:start(?MODULE, nolink, Name, Mod, Args, Options). - -start_link(Mod, Args, Options) -> - gen:start(?MODULE, link, Mod, Args, Options). - -start_link(Name, Mod, Args, Options) -> - gen:start(?MODULE, link, Name, Mod, Args, Options). - - -send_event({global, Name}, Event) -> - catch global:send(Name, {'$gen_event', Event}), - ok; -send_event(Name, Event) -> - Name ! {'$gen_event', Event}, - ok. - -sync_send_event(Name, Event) -> - case catch gen:call(Name, '$gen_sync_event', Event) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, sync_send_event, [Name, Event]}}) - end. - -sync_send_event(Name, Event, Timeout) -> - case catch gen:call(Name, '$gen_sync_event', Event, Timeout) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, sync_send_event, [Name, Event, Timeout]}}) - end. - -send_all_state_event({global, Name}, Event) -> - catch global:send(Name, {'$gen_all_state_event', Event}), - ok; -send_all_state_event(Name, Event) -> - Name ! {'$gen_all_state_event', Event}, - ok. - -sync_send_all_state_event(Name, Event) -> - case catch gen:call(Name, '$gen_sync_all_state_event', Event) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, sync_send_all_state_event, [Name, Event]}}) - end. - -sync_send_all_state_event(Name, Event, Timeout) -> - case catch gen:call(Name, '$gen_sync_all_state_event', Event, Timeout) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, sync_send_all_state_event, - [Name, Event, Timeout]}}) - end. - -%% Designed to be only callable within one of the callbacks -%% hence using the self() of this instance of the process. -%% This is to ensure that timers don't go astray in global -%% e.g. when straddling a failover, or turn up in a restarted -%% instance of the process. - -%% Returns Ref, sends event {timeout,Ref,Msg} after Time -%% to the (then) current state. -start_timer(Time, Msg) -> - erlang:start_timer(Time, self(), {'$gen_timer', Msg}). - -%% Returns Ref, sends Event after Time to the (then) current state. -send_event_after(Time, Event) -> - erlang:start_timer(Time, self(), {'$gen_event', Event}). - -%% Returns the remaining time for the timer if Ref referred to -%% an active timer/send_event_after, false otherwise. -cancel_timer(Ref) -> - case erlang:cancel_timer(Ref) of - false -> - receive {timeout, Ref, _} -> 0 - after 0 -> false - end; - RemainingTime -> - RemainingTime - end. - -%% enter_loop/4,5,6 -%% Makes an existing process into a gen_fsm. -%% The calling process will enter the gen_fsm receive loop and become a -%% gen_fsm process. -%% The process *must* have been started using one of the start functions -%% in proc_lib, see proc_lib(3). -%% The user is responsible for any initialization of the process, -%% including registering a name for it. -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, ServerName,infinity); -enter_loop(Mod, Options, StateName, StateData, Timeout) -> - enter_loop(Mod, Options, StateName, StateData, self(), Timeout). - -enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = gen:debug_options(Options), - loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:safe_whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent) -> - Parent; - [Parent | _] when is_atom(Parent) -> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:safe_whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - -%%% --------------------------------------------------- -%%% Initiate the new process. -%%% Register the name using the Rfunc function -%%% Calls the Mod:init/Args function. -%%% Finally an acknowledge is sent to Parent and the main -%%% loop is entered. -%%% --------------------------------------------------- -init_it(Starter, self, Name, Mod, Args, Options) -> - init_it(Starter, self(), Name, Mod, Args, Options); -init_it(Starter, Parent, Name, Mod, Args, Options) -> - Debug = gen:debug_options(Options), - gen:reg_behaviour(?MODULE), - case catch Mod:init(Args) of - {ok, StateName, StateData} -> - proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, StateName, StateData, Mod, infinity, Debug); - {ok, StateName, StateData, Timeout} -> - proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); - {stop, Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - ignore -> - proc_lib:init_ack(Starter, ignore), - exit(normal); - {'EXIT', Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - Else -> - Error = {bad_return_value, Else}, - proc_lib:init_ack(Starter, {error, Error}), - exit(Error) - end. - -%%----------------------------------------------------------------- -%% The MAIN loop -%%----------------------------------------------------------------- -loop(Parent, Name, StateName, StateData, Mod, Time, Debug) -> - Msg = receive - Input -> - Input - after Time -> - {'$gen_event', timeout} - end, - case Msg of - {system, From, Req} -> - sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [Name, StateName, StateData, Mod, Time]); - {'EXIT', Parent, Reason} -> - terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug); - _Msg when Debug =:= [] -> - handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time); - _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - {Name, StateName}, {in, Msg}), - handle_msg(Msg, Parent, Name, StateName, StateData, - Mod, Time, Debug1) - end. - -%%----------------------------------------------------------------- -%% Callback functions for system messages handling. -%%----------------------------------------------------------------- -system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time]) -> - loop(Parent, Name, StateName, StateData, Mod, Time, Debug). - -system_terminate(Reason, _Parent, Debug, - [Name, StateName, StateData, Mod, _Time]) -> - terminate(Reason, Name, [], Mod, StateName, StateData, Debug). - -system_code_change([Name, StateName, StateData, Mod, Time], - _Module, OldVsn, Extra) -> - case catch Mod:code_change(OldVsn, StateName, StateData, Extra) of - {ok, NewStateName, NewStateData} -> - {ok, [Name, NewStateName, NewStateData, Mod, Time]}; - Else -> Else - end. - -%%----------------------------------------------------------------- -%% Format debug messages. Print them as the call-back module sees -%% them, not as the real erlang messages. Use trace for that. -%%----------------------------------------------------------------- -print_event(Dev, {in, Msg}, {Name, StateName}) -> - case Msg of - {'$gen_event', Event} -> - io:format(Dev, "*DBG* ~p got event ~p in state ~w~n", - [Name, Event, StateName]); - {'$gen_all_state_event', Event} -> - io:format(Dev, - "*DBG* ~p got all_state_event ~p in state ~w~n", - [Name, Event, StateName]); - {timeout, Ref, {'$gen_timer', Message}} -> - io:format(Dev, - "*DBG* ~p got timer ~p in state ~w~n", - [Name, {timeout, Ref, Message}, StateName]); - {timeout, _Ref, {'$gen_event', Event}} -> - io:format(Dev, - "*DBG* ~p got timer ~p in state ~w~n", - [Name, Event, StateName]); - _ -> - io:format(Dev, "*DBG* ~p got ~p in state ~w~n", - [Name, Msg, StateName]) - end; -print_event(Dev, {out, Msg, To, StateName}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w~n" - " and switched to state ~w~n", - [Name, Msg, To, StateName]); -print_event(Dev, return, {Name, StateName}) -> - io:format(Dev, "*DBG* ~p switched to state ~w~n", - [Name, StateName]). - -handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time) -> %No debug here - From = from(Msg), - case catch dispatch(Msg, Mod, StateName, StateData) of - {next_state, NStateName, NStateData} -> - loop(Parent, Name, NStateName, NStateData, Mod, infinity, []); - {next_state, NStateName, NStateData, Time1} -> - loop(Parent, Name, NStateName, NStateData, Mod, Time1, []); - {reply, Reply, NStateName, NStateData} when From =/= undefined -> - reply(From, Reply), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, []); - {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> - reply(From, Reply), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, []); - {stop, Reason, NStateData} -> - terminate(Reason, Name, Msg, Mod, StateName, NStateData, []); - {stop, Reason, Reply, NStateData} when From =/= undefined -> - {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, - StateName, NStateData, [])), - reply(From, Reply), - exit(R); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, StateName, StateData, []); - Reply -> - terminate({bad_return_value, Reply}, - Name, Msg, Mod, StateName, StateData, []) - end. - -handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) -> - From = from(Msg), - case catch dispatch(Msg, Mod, StateName, StateData) of - {next_state, NStateName, NStateData} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - {Name, NStateName}, return), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); - {next_state, NStateName, NStateData, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - {Name, NStateName}, return), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); - {reply, Reply, NStateName, NStateData} when From =/= undefined -> - Debug1 = reply(Name, From, Reply, Debug, NStateName), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); - {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> - Debug1 = reply(Name, From, Reply, Debug, NStateName), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); - {stop, Reason, NStateData} -> - terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug); - {stop, Reason, Reply, NStateData} when From =/= undefined -> - {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, - StateName, NStateData, Debug)), - reply(Name, From, Reply, Debug, StateName), - exit(R); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, StateName, StateData, Debug); - Reply -> - terminate({bad_return_value, Reply}, - Name, Msg, Mod, StateName, StateData, Debug) - end. - -dispatch({'$gen_event', Event}, Mod, StateName, StateData) -> - Mod:StateName(Event, StateData); -dispatch({'$gen_all_state_event', Event}, Mod, StateName, StateData) -> - Mod:handle_event(Event, StateName, StateData); -dispatch({'$gen_sync_event', From, Event}, Mod, StateName, StateData) -> - Mod:StateName(Event, From, StateData); -dispatch({'$gen_sync_all_state_event', From, Event}, - Mod, StateName, StateData) -> - Mod:handle_sync_event(Event, From, StateName, StateData); -dispatch({timeout, Ref, {'$gen_timer', Msg}}, Mod, StateName, StateData) -> - Mod:StateName({timeout, Ref, Msg}, StateData); -dispatch({timeout, _Ref, {'$gen_event', Event}}, Mod, StateName, StateData) -> - Mod:StateName(Event, StateData); -dispatch(Info, Mod, StateName, StateData) -> - Mod:handle_info(Info, StateName, StateData). - -from({'$gen_sync_event', From, _Event}) -> From; -from({'$gen_sync_all_state_event', From, _Event}) -> From; -from(_) -> undefined. - -%% Send a reply to the client. -reply({To, Tag}, Reply) -> - catch To ! {Tag, Reply}. - -reply(Name, {To, Tag}, Reply, Debug, StateName) -> - reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {out, Reply, To, StateName}). - -%%% --------------------------------------------------- -%%% Terminate the server. -%%% --------------------------------------------------- - -terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> - case catch Mod:terminate(Reason, StateName, StateData) of - {'EXIT', R} -> - error_info(R, Name, Msg, StateName, StateData, Debug), - exit(R); - _ -> - case Reason of - normal -> - exit(normal); - shutdown -> - exit(shutdown); - _ -> - error_info(Reason, Name, Msg, StateName, StateData, Debug), - exit(Reason) - end - end. - -error_info(Reason, Name, Msg, StateName, StateData, Debug) -> - Reason1 = - case Reason of - {undef,[{M,F,A}|MFAs]} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - Reason; - false -> - {'function not exported',[{M,F,A}|MFAs]} - end - end; - _ -> - Reason - end, - Str = "** State machine ~p terminating \n" ++ - get_msg_str(Msg) ++ - "** When State == ~p~n" - "** Data == ~p~n" - "** Reason for termination = ~n** ~p~n", - format(Str, [Name, get_msg(Msg), StateName, StateData, Reason1]), - sys:print_log(Debug), - ok. - -get_msg_str({'$gen_event', _Event}) -> - "** Last event in was ~p~n"; -get_msg_str({'$gen_sync_event', _Event}) -> - "** Last sync event in was ~p~n"; -get_msg_str({'$gen_all_state_event', _Event}) -> - "** Last event in was ~p (for all states)~n"; -get_msg_str({'$gen_sync_all_state_event', _Event}) -> - "** Last sync event in was ~p (for all states)~n"; -get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) -> - "** Last timer event in was ~p~n"; -get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) -> - "** Last timer event in was ~p~n"; -get_msg_str(_Msg) -> - "** Last message in was ~p~n". - -get_msg({'$gen_event', Event}) -> Event; -get_msg({'$gen_sync_event', Event}) -> Event; -get_msg({'$gen_all_state_event', Event}) -> Event; -get_msg({'$gen_sync_all_state_event', Event}) -> Event; -get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> {timeout, Ref, Msg}; -get_msg({timeout, _Ref, {'$gen_event', Event}}) -> Event; -get_msg(Msg) -> Msg. - -%%----------------------------------------------------------------- -%% Status information -%%----------------------------------------------------------------- -format_status(Opt, StatusData) -> - [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] = - StatusData, - Header = lists:concat(["Status for state machine ", Name]), - Log = sys:get_debug(log, Debug, []), - Specific = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> [{data, [{"StateData", StateData}]}]; - Else -> Else - end; - _ -> - [{data, [{"StateData", StateData}]}] - end, - [{header, Header}, - {data, [{"Status", SysState}, - {"Parent", Parent}, - {"Logged events", Log}, - {"StateName", StateName}]} | - Specific]. diff --git a/patches/stdlib/gen_server.erl b/patches/stdlib/gen_server.erl deleted file mode 100644 index 588b7a8..0000000 --- a/patches/stdlib/gen_server.erl +++ /dev/null @@ -1,814 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(gen_server). - -%%% --------------------------------------------------- -%%% -%%% The idea behind THIS server is that the user module -%%% provides (different) functions to handle different -%%% kind of inputs. -%%% If the Parent process terminates the Module:terminate/2 -%%% function is called. -%%% -%%% The user module should export: -%%% -%%% init(Args) -%%% ==> {ok, State} -%%% {ok, State, Timeout} -%%% ignore -%%% {stop, Reason} -%%% -%%% handle_call(Msg, {From, Tag}, State) -%%% -%%% ==> {reply, Reply, State} -%%% {reply, Reply, State, Timeout} -%%% {noreply, State} -%%% {noreply, State, Timeout} -%%% {stop, Reason, Reply, State} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% handle_cast(Msg, State) -%%% -%%% ==> {noreply, State} -%%% {noreply, State, Timeout} -%%% {stop, Reason, State} -%%% Reason = normal | shutdown | Term terminate(State) is called -%%% -%%% handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ... -%%% -%%% ==> {noreply, State} -%%% {noreply, State, Timeout} -%%% {stop, Reason, State} -%%% Reason = normal | shutdown | Term, terminate(State) is called -%%% -%%% terminate(Reason, State) Let the user module clean up -%%% always called when server terminates -%%% -%%% ==> ok -%%% -%%% -%%% The work flow (of the server) can be described as follows: -%%% -%%% User module Generic -%%% ----------- ------- -%%% start -----> start -%%% init <----- . -%%% -%%% loop -%%% handle_call <----- . -%%% -----> reply -%%% -%%% handle_cast <----- . -%%% -%%% handle_info <----- . -%%% -%%% terminate <----- . -%%% -%%% -----> reply -%%% -%%% -%%% --------------------------------------------------- - -%% API --export([start/3, start/4, - start_link/3, start_link/4, - call/2, call/3, - cast/2, reply/2, - abcast/2, abcast/3, - multi_call/2, multi_call/3, multi_call/4, - enter_loop/3, enter_loop/4, enter_loop/5]). - --export([behaviour_info/1]). - -%% System exports --export([system_continue/3, - system_terminate/4, - system_code_change/4, - format_status/2]). - -%% Internal exports --export([init_it/6, print_event/3]). - --import(error_logger, [format/2]). - -%%%========================================================================= -%%% API -%%%========================================================================= - -behaviour_info(callbacks) -> - [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - -%%% ----------------------------------------------------------------- -%%% Starts a generic server. -%%% start(Mod, Args, Options) -%%% start(Name, Mod, Args, Options) -%%% start_link(Mod, Args, Options) -%%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} -%%% Mod ::= atom(), callback module implementing the 'real' server -%%% Args ::= term(), init arguments (to Mod:init/1) -%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}] -%%% Flag ::= trace | log | {logfile, File} | statistics | debug -%%% (debug == log && statistics) -%%% Returns: {ok, Pid} | -%%% {error, {already_started, Pid}} | -%%% {error, Reason} -%%% ----------------------------------------------------------------- -start(Mod, Args, Options) -> - gen:start(?MODULE, nolink, Mod, Args, Options). - -start(Name, Mod, Args, Options) -> - gen:start(?MODULE, nolink, Name, Mod, Args, Options). - -start_link(Mod, Args, Options) -> - gen:start(?MODULE, link, Mod, Args, Options). - -start_link(Name, Mod, Args, Options) -> - gen:start(?MODULE, link, Name, Mod, Args, Options). - - -%% ----------------------------------------------------------------- -%% Make a call to a generic server. -%% If the server is located at another node, that node will -%% be monitored. -%% If the client is trapping exits and is linked server termination -%% is handled here (? Shall we do that here (or rely on timeouts) ?). -%% ----------------------------------------------------------------- -call(Name, Request) -> - case catch gen:call(Name, '$gen_call', Request) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, call, [Name, Request]}}) - end. - -call(Name, Request, Timeout) -> - case catch gen:call(Name, '$gen_call', Request, Timeout) of - {ok,Res} -> - Res; - {'EXIT',Reason} -> - exit({Reason, {?MODULE, call, [Name, Request, Timeout]}}) - end. - -%% ----------------------------------------------------------------- -%% Make a cast to a generic server. -%% ----------------------------------------------------------------- -cast({global,Name}, Request) -> - catch global: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) -> - do_cast(Dest, Request); -cast(Dest, Request) when is_pid(Dest) -> - do_cast(Dest, Request). - -do_cast(Dest, Request) -> - do_send(Dest, cast_msg(Request)), - ok. - -cast_msg(Request) -> {'$gen_cast',Request}. - -%% ----------------------------------------------------------------- -%% Send a reply to the client. -%% ----------------------------------------------------------------- -reply({To, Tag}, Reply) -> - catch To ! {Tag, Reply}. - -%% ----------------------------------------------------------------- -%% Asynchronous broadcast, returns nothing, it's just send'n prey -%%----------------------------------------------------------------- -abcast(Name, Request) when is_atom(Name) -> - do_abcast([node() | nodes()], Name, cast_msg(Request)). - -abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) -> - do_abcast(Nodes, Name, cast_msg(Request)). - -do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) -> - do_send({Name,Node},Msg), - do_abcast(Nodes, Name, Msg); -do_abcast([], _,_) -> abcast. - -%%% ----------------------------------------------------------------- -%%% Make a call to servers at several nodes. -%%% Returns: {[Replies],[BadNodes]} -%%% A Timeout can be given -%%% -%%% A middleman process is used in case late answers arrives after -%%% the timeout. If they would be allowed to glog the callers message -%%% queue, it would probably become confused. Late answers will -%%% now arrive to the terminated middleman and so be discarded. -%%% ----------------------------------------------------------------- -multi_call(Name, Req) - when is_atom(Name) -> - do_multi_call([node() | nodes()], Name, Req, infinity). - -multi_call(Nodes, Name, Req) - when is_list(Nodes), is_atom(Name) -> - do_multi_call(Nodes, Name, Req, infinity). - -multi_call(Nodes, Name, Req, infinity) -> - do_multi_call(Nodes, Name, Req, infinity); -multi_call(Nodes, Name, Req, Timeout) - when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 -> - do_multi_call(Nodes, Name, Req, Timeout). - - -%%----------------------------------------------------------------- -%% enter_loop(Mod, Options, State, , ) ->_ -%% -%% Description: Makes an existing process into a gen_server. -%% The calling process will enter the gen_server receive -%% loop and become a gen_server process. -%% The process *must* have been started using one of the -%% start functions in proc_lib, see proc_lib(3). -%% The user is responsible for any initialization of the -%% process, including registering a name for it. -%%----------------------------------------------------------------- -enter_loop(Mod, Options, State) -> - enter_loop(Mod, Options, State, self(), infinity). - -enter_loop(Mod, Options, State, ServerName = {_, _}) -> - enter_loop(Mod, Options, State, ServerName, infinity); - -enter_loop(Mod, Options, State, Timeout) -> - enter_loop(Mod, Options, State, self(), Timeout). - -enter_loop(Mod, Options, State, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = debug_options(Name, Options), - loop(Parent, Name, State, Mod, Timeout, Debug). - -%%%======================================================================== -%%% Gen-callback functions -%%%======================================================================== - -%%% --------------------------------------------------- -%%% Initiate the new process. -%%% Register the name using the Rfunc function -%%% Calls the Mod:init/Args function. -%%% Finally an acknowledge is sent to Parent and the main -%%% loop is entered. -%%% --------------------------------------------------- -init_it(Starter, self, Name, Mod, Args, Options) -> - init_it(Starter, self(), Name, Mod, Args, Options); -init_it(Starter, Parent, Name, Mod, Args, Options) -> - Debug = debug_options(Name, Options), - gen:reg_behaviour(?MODULE), - case catch Mod:init(Args) of - {ok, State} -> - proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, State, Mod, infinity, Debug); - {ok, State, Timeout} -> - proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, State, Mod, Timeout, Debug); - {stop, Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - ignore -> - proc_lib:init_ack(Starter, ignore), - exit(normal); - {'EXIT', Reason} -> - proc_lib:init_ack(Starter, {error, Reason}), - exit(Reason); - Else -> - Error = {bad_return_value, Else}, - proc_lib:init_ack(Starter, {error, Error}), - exit(Error) - end. - -%%%======================================================================== -%%% Internal functions -%%%======================================================================== -%%% --------------------------------------------------- -%%% The MAIN loop. -%%% --------------------------------------------------- -loop(Parent, Name, State, Mod, Time, Debug) -> - Msg = receive - Input -> - Input - after Time -> - timeout - end, - case Msg of - {system, From, Req} -> - sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [Name, State, Mod, Time]); - {'EXIT', Parent, Reason} -> - terminate(Reason, Name, Msg, Mod, State, Debug); - _Msg when Debug =:= [] -> - handle_msg(Msg, Parent, Name, State, Mod, Time); - _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, - Name, {in, Msg}), - handle_msg(Msg, Parent, Name, State, Mod, Time, Debug1) - end. - -%%% --------------------------------------------------- -%%% Send/receive functions -%%% --------------------------------------------------- -do_send(Dest, Msg) -> - case catch erlang:send(Dest, Msg, [noconnect]) of - noconnect -> - spawn(erlang, send, [Dest,Msg]); - Other -> - Other - end. - -do_multi_call(Nodes, Name, Req, infinity) -> - Tag = make_ref(), - Monitors = send_nodes(Nodes, Name, Tag, Req), - rec_nodes(Tag, Monitors, Name, undefined); -do_multi_call(Nodes, Name, Req, Timeout) -> - Tag = make_ref(), - Caller = self(), - Receiver = - spawn( - fun() -> - %% Middleman process. Should be unsensitive to regular - %% exit signals. The synchronization is needed in case - %% the receiver would exit before the caller started - %% the monitor. - process_flag(trap_exit, true), - Mref = erlang:monitor(process, Caller), - receive - {Caller,Tag} -> - Monitors = send_nodes(Nodes, Name, Tag, Req), - TimerId = erlang:start_timer(Timeout, self(), ok), - Result = rec_nodes(Tag, Monitors, Name, TimerId), - exit({self(),Tag,Result}); - {'DOWN',Mref,_,_,_} -> - %% Caller died before sending us the go-ahead. - %% Give up silently. - exit(normal) - end - end), - Mref = erlang:monitor(process, Receiver), - Receiver ! {self(),Tag}, - receive - {'DOWN',Mref,_,_,{Receiver,Tag,Result}} -> - Result; - {'DOWN',Mref,_,_,Reason} -> - %% The middleman code failed. Or someone did - %% exit(_, kill) on the middleman process => Reason==killed - exit(Reason) - end. - -send_nodes(Nodes, Name, Tag, Req) -> - send_nodes(Nodes, Name, Tag, Req, []). - -send_nodes([Node|Tail], Name, Tag, Req, Monitors) - when is_atom(Node) -> - Monitor = start_monitor(Node, Name), - %% Handle non-existing names in rec_nodes. - catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req}, - send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]); -send_nodes([_Node|Tail], Name, Tag, Req, Monitors) -> - %% Skip non-atom Node - send_nodes(Tail, Name, Tag, Req, Monitors); -send_nodes([], _Name, _Tag, _Req, Monitors) -> - Monitors. - -%% Against old nodes: -%% If no reply has been delivered within 2 secs. (per node) check that -%% the server really exists and wait for ever for the answer. -%% -%% Against contemporary nodes: -%% Wait for reply, server 'DOWN', or timeout from TimerId. - -rec_nodes(Tag, Nodes, Name, TimerId) -> - rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId). - -rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) -> - receive - {'DOWN', R, _, _, _} -> - rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId); - {{Tag, N}, Reply} -> %% Tag is bound !!! - unmonitor(R), - rec_nodes(Tag, Tail, Name, Badnodes, - [{N,Reply}|Replies], Time, TimerId); - {timeout, TimerId, _} -> - unmonitor(R), - %% Collect all replies that already have arrived - rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) - end; -rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) -> - %% R6 node - receive - {nodedown, N} -> - monitor_node(N, false), - rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId); - {{Tag, N}, Reply} -> %% Tag is bound !!! - receive {nodedown, N} -> ok after 0 -> ok end, - monitor_node(N, false), - rec_nodes(Tag, Tail, Name, Badnodes, - [{N,Reply}|Replies], 2000, TimerId); - {timeout, TimerId, _} -> - receive {nodedown, N} -> ok after 0 -> ok end, - monitor_node(N, false), - %% Collect all replies that already have arrived - rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies) - after Time -> - case rpc:call(N, erlang, whereis, [Name]) of - Pid when is_pid(Pid) -> % It exists try again. - rec_nodes(Tag, [N|Tail], Name, Badnodes, - Replies, infinity, TimerId); - _ -> % badnode - receive {nodedown, N} -> ok after 0 -> ok end, - monitor_node(N, false), - rec_nodes(Tag, Tail, Name, [N|Badnodes], - Replies, 2000, TimerId) - end - end; -rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) -> - case catch erlang:cancel_timer(TimerId) of - false -> % It has already sent it's message - receive - {timeout, TimerId, _} -> ok - after 0 -> - ok - end; - _ -> % Timer was cancelled, or TimerId was 'undefined' - ok - end, - {Replies, Badnodes}. - -%% Collect all replies that already have arrived -rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) -> - receive - {'DOWN', R, _, _, _} -> - rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); - {{Tag, N}, Reply} -> %% Tag is bound !!! - unmonitor(R), - rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) - after 0 -> - unmonitor(R), - rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) - end; -rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) -> - %% R6 node - receive - {nodedown, N} -> - monitor_node(N, false), - rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); - {{Tag, N}, Reply} -> %% Tag is bound !!! - receive {nodedown, N} -> ok after 0 -> ok end, - monitor_node(N, false), - rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) - after 0 -> - receive {nodedown, N} -> ok after 0 -> ok end, - monitor_node(N, false), - rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) - end; -rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) -> - {Replies, Badnodes}. - - -%%% --------------------------------------------------- -%%% Monitor functions -%%% --------------------------------------------------- - -start_monitor(Node, Name) when is_atom(Node), is_atom(Name) -> - if node() =:= nonode@nohost, Node =/= nonode@nohost -> - Ref = make_ref(), - self() ! {'DOWN', Ref, process, {Name, Node}, noconnection}, - {Node, Ref}; - true -> - case catch erlang:monitor(process, {Name, Node}) of - {'EXIT', _} -> - %% Remote node is R6 - monitor_node(Node, true), - Node; - Ref when is_reference(Ref) -> - {Node, Ref} - end - end. - -%% Cancels a monitor started with Ref=erlang:monitor(_, _). -unmonitor(Ref) when is_reference(Ref) -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, _, _, _} -> - true - after 0 -> - true - end. - -%%% --------------------------------------------------- -%%% Message handling functions -%%% --------------------------------------------------- - -dispatch({'$gen_cast', Msg}, Mod, State) -> - Mod:handle_cast(Msg, State); -dispatch(Info, Mod, State) -> - Mod:handle_info(Info, State). - -handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, _Time) -> - case catch Mod:handle_call(Msg, From, State) of - {reply, Reply, NState} -> - reply(From, Reply), - loop(Parent, Name, NState, Mod, infinity, []); - {reply, Reply, NState, Time1} -> - reply(From, Reply), - loop(Parent, Name, NState, Mod, Time1, []); - {noreply, NState} -> - loop(Parent, Name, NState, Mod, infinity, []); - {noreply, NState, Time1} -> - loop(Parent, Name, NState, Mod, Time1, []); - {stop, Reason, Reply, NState} -> - {'EXIT', R} = - (catch terminate(Reason, Name, Msg, Mod, NState, [])), - reply(From, Reply), - exit(R); - Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State) - end; -handle_msg(Msg, Parent, Name, State, Mod, _Time) -> - Reply = (catch dispatch(Msg, Mod, State)), - handle_common_reply(Reply, Parent, Name, Msg, Mod, State). - -handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, _Time, Debug) -> - case catch Mod:handle_call(Msg, From, State) of - {reply, Reply, NState} -> - Debug1 = reply(Name, From, Reply, NState, Debug), - loop(Parent, Name, NState, Mod, infinity, Debug1); - {reply, Reply, NState, Time1} -> - Debug1 = reply(Name, From, Reply, NState, Debug), - loop(Parent, Name, NState, Mod, Time1, Debug1); - {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {noreply, NState}), - loop(Parent, Name, NState, Mod, infinity, Debug1); - {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {noreply, NState}), - loop(Parent, Name, NState, Mod, Time1, Debug1); - {stop, Reason, Reply, NState} -> - {'EXIT', R} = - (catch terminate(Reason, Name, Msg, Mod, NState, Debug)), - reply(Name, From, Reply, NState, Debug), - exit(R); - Other -> - handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug) - end; -handle_msg(Msg, Parent, Name, State, Mod, _Time, Debug) -> - Reply = (catch dispatch(Msg, Mod, State)), - handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug). - -handle_common_reply(Reply, Parent, Name, Msg, Mod, State) -> - case Reply of - {noreply, NState} -> - loop(Parent, Name, NState, Mod, infinity, []); - {noreply, NState, Time1} -> - loop(Parent, Name, NState, Mod, Time1, []); - {stop, Reason, NState} -> - terminate(Reason, Name, Msg, Mod, NState, []); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, State, []); - _ -> - terminate({bad_return_value, Reply}, Name, Msg, Mod, State, []) - end. - -handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> - case Reply of - {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {noreply, NState}), - loop(Parent, Name, NState, Mod, infinity, Debug1); - {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {noreply, NState}), - loop(Parent, Name, NState, Mod, Time1, Debug1); - {stop, Reason, NState} -> - terminate(Reason, Name, Msg, Mod, NState, Debug); - {'EXIT', What} -> - terminate(What, Name, Msg, Mod, State, Debug); - _ -> - terminate({bad_return_value, Reply}, Name, Msg, Mod, State, Debug) - end. - -reply(Name, {To, Tag}, Reply, State, Debug) -> - reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, - {out, Reply, To, State} ). - - -%%----------------------------------------------------------------- -%% Callback functions for system messages handling. -%%----------------------------------------------------------------- -system_continue(Parent, Debug, [Name, State, Mod, Time]) -> - loop(Parent, Name, State, Mod, Time, Debug). - -system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time]) -> - terminate(Reason, Name, [], Mod, State, Debug). - -system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> - case catch Mod:code_change(OldVsn, State, Extra) of - {ok, NewState} -> {ok, [Name, NewState, Mod, Time]}; - Else -> Else - end. - -%%----------------------------------------------------------------- -%% Format debug messages. Print them as the call-back module sees -%% them, not as the real erlang messages. Use trace for that. -%%----------------------------------------------------------------- -print_event(Dev, {in, Msg}, Name) -> - case Msg of - {'$gen_call', {From, _Tag}, Call} -> - io:format(Dev, "*DBG* ~p got call ~p from ~w~n", - [Name, Call, From]); - {'$gen_cast', Cast} -> - io:format(Dev, "*DBG* ~p got cast ~p~n", - [Name, Cast]); - _ -> - io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) - end; -print_event(Dev, {out, Msg, To, State}, Name) -> - io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", - [Name, Msg, To, State]); -print_event(Dev, {noreply, State}, Name) -> - io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); -print_event(Dev, Event, Name) -> - io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). - - -%%% --------------------------------------------------- -%%% Terminate the server. -%%% --------------------------------------------------- - -terminate(Reason, Name, Msg, Mod, State, Debug) -> - case catch Mod:terminate(Reason, State) of - {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), - exit(R); - _ -> - case Reason of - normal -> - exit(normal); - shutdown -> - exit(shutdown); - _ -> - error_info(Reason, Name, Msg, State, Debug), - exit(Reason) - end - end. - -error_info(_Reason, application_controller, _Msg, _State, _Debug) -> - %% OTP-5811 Don't send an error report if it's the system process - %% application_controller which is terminating - let init take care - %% of it instead - ok; -error_info(Reason, Name, Msg, State, Debug) -> - Reason1 = - case Reason of - {undef,[{M,F,A}|MFAs]} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - Reason; - false -> - {'function not exported',[{M,F,A}|MFAs]} - end - end; - _ -> - Reason - end, - format("** Generic server ~p terminating \n" - "** Last message in was ~p~n" - "** When Server state == ~p~n" - "** Reason for termination == ~n** ~p~n", - [Name, Msg, State, Reason1]), - sys:print_log(Debug), - ok. - -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) - end. - -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:safe_whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent)-> - Parent; - [Parent | _] when is_atom(Parent)-> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:safe_whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - -%%----------------------------------------------------------------- -%% Status information -%%----------------------------------------------------------------- -format_status(Opt, StatusData) -> - [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - NameTag = if is_pid(Name) -> - pid_to_list(Name); - is_atom(Name) -> - Name - end, - Header = lists:concat(["Status for generic server ", NameTag]), - Log = sys:get_debug(log, Debug, []), - Specific = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> [{data, [{"State", State}]}]; - Else -> Else - end; - _ -> - [{data, [{"State", State}]}] - end, - [{header, Header}, - {data, [{"Status", SysState}, - {"Parent", Parent}, - {"Logged events", Log}]} | - Specific]. diff --git a/patches/stdlib/supervisor.erl b/patches/stdlib/supervisor.erl deleted file mode 100644 index 30c96c0..0000000 --- a/patches/stdlib/supervisor.erl +++ /dev/null @@ -1,934 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(supervisor). - --behaviour(gen_server). - -%% External exports --export([start_link/2,start_link/3, - start_child/2, restart_child/2, - delete_child/2, terminate_child/2, - which_children/1, - check_childspecs/1]). - --export([behaviour_info/1]). - -%% Internal exports --export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). --export([handle_cast/2]). - --define(DICT, dict). - - - --record(state, {name, - strategy, - children = [], - dynamics = ?DICT:new(), - intensity, - period, - restarts = [], - module, - args}). - --record(child, {pid = undefined, % pid is undefined when child is not running - name, - mfa, - restart_type, - shutdown, - child_type, - modules = []}). - --define(is_simple(State), State#state.strategy =:= simple_one_for_one). - -behaviour_info(callbacks) -> - [{init,1}]; -behaviour_info(_Other) -> - undefined. - -%%% --------------------------------------------------- -%%% This is a general process supervisor built upon gen_server.erl. -%%% Servers/processes should/could also be built using gen_server.erl. -%%% SupName = {local, atom()} | {global, atom()}. -%%% --------------------------------------------------- -start_link(Mod, Args) -> - gen_server:start_link(supervisor, {self, Mod, Args}, []). - -start_link(SupName, Mod, Args) -> - gen_server:start_link(SupName, supervisor, {SupName, Mod, Args}, []). - -%%% --------------------------------------------------- -%%% Interface functions. -%%% --------------------------------------------------- -start_child(Supervisor, ChildSpec) -> - call(Supervisor, {start_child, ChildSpec}). - -restart_child(Supervisor, Name) -> - call(Supervisor, {restart_child, Name}). - -delete_child(Supervisor, Name) -> - call(Supervisor, {delete_child, Name}). - -%%----------------------------------------------------------------- -%% Func: terminate_child/2 -%% Returns: ok | {error, Reason} -%% Note that the child is *always* terminated in some -%% way (maybe killed). -%%----------------------------------------------------------------- -terminate_child(Supervisor, Name) -> - call(Supervisor, {terminate_child, Name}). - -which_children(Supervisor) -> - call(Supervisor, which_children). - -call(Supervisor, Req) -> - gen_server:call(Supervisor, Req, infinity). - -check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> - case check_startspec(ChildSpecs) of - {ok, _} -> ok; - Error -> {error, Error} - end; -check_childspecs(X) -> {error, {badarg, X}}. - -%%% --------------------------------------------------- -%%% -%%% Initialize the supervisor. -%%% -%%% --------------------------------------------------- -init({SupName, Mod, Args}) -> - process_flag(trap_exit, true), - gen:reg_behaviour(?MODULE), - case Mod:init(Args) of - {ok, {SupFlags, StartSpec}} -> - gproc:reg({p,l,supflags}, SupFlags), - case init_state(SupName, SupFlags, Mod, Args) of - {ok, State} when ?is_simple(State) -> - init_dynamic(State, StartSpec); - {ok, State} -> - init_children(State, StartSpec); - Error -> - {stop, {supervisor_data, Error}} - end; - ignore -> - ignore; - Error -> - {stop, {bad_return, {Mod, init, Error}}} - end. - -init_children(State, StartSpec) -> - SupName = State#state.name, - case check_startspec(StartSpec) of - {ok, Children} -> - reg_children(Children), - case start_children(Children, SupName) of - {ok, NChildren} -> - set_children(NChildren), - {ok, State#state{children = NChildren}}; - {error, NChildren} -> - terminate_children(NChildren, SupName), - {stop, shutdown} - end; - Error -> - {stop, {start_spec, Error}} - end. - - -reg_children(Children) -> - lists:foreach( - fun(Ch) -> - gproc:reg({p,l,{childspec,Ch#child.name}}, Ch) - end, Children). - -set_children(Children) -> - lists:foreach( - fun(Ch) -> - gproc:set_value({p,l,{childspec,Ch#child.name}}, Ch) - end, Children). - -unreg_child(Child) -> - gproc:unreg({p,l,{childspec,Child#child.name}}). - -set_child(Child) -> - catch gproc:set_value({p,l,{childspec,Child#child.name}}, Child). - - - -init_dynamic(State, [StartSpec]) -> - case check_startspec([StartSpec]) of - {ok, Children} -> - reg_children(Children), - {ok, State#state{children = Children}}; - Error -> - {stop, {start_spec, Error}} - end; -init_dynamic(_State, StartSpec) -> - {stop, {bad_start_spec, StartSpec}}. - -%%----------------------------------------------------------------- -%% Func: start_children/2 -%% Args: Children = [#child] in start order -%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} -%% Purpose: Start all children. The new list contains #child's -%% with pids. -%% Returns: {ok, NChildren} | {error, NChildren} -%% NChildren = [#child] in termination order (reversed -%% start order) -%%----------------------------------------------------------------- -start_children(Children, SupName) -> start_children(Children, [], SupName). - -start_children([Child|Chs], NChildren, SupName) -> - case do_start_child(SupName, Child) of - {ok, Pid} -> - start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); - {ok, Pid, _Extra} -> - start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); - {error, Reason} -> - report_error(start_error, Reason, Child, SupName), - {error, lists:reverse(Chs) ++ [Child | NChildren]} - end; -start_children([], NChildren, _SupName) -> - {ok, NChildren}. - -do_start_child(SupName, Child) -> - #child{mfa = {M, F, A}} = Child, - case catch apply(M, F, A) of - {ok, Pid} when is_pid(Pid) -> - NChild = Child#child{pid = Pid}, - report_progress(NChild, SupName), - {ok, Pid}; - {ok, Pid, Extra} when is_pid(Pid) -> - NChild = Child#child{pid = Pid}, - report_progress(NChild, SupName), - {ok, Pid, Extra}; - ignore -> - {ok, undefined}; - {error, What} -> {error, What}; - What -> {error, What} - end. - -do_start_child_i(M, F, A) -> - case catch apply(M, F, A) of - {ok, Pid} when is_pid(Pid) -> - {ok, Pid}; - {ok, Pid, Extra} when is_pid(Pid) -> - {ok, Pid, Extra}; - ignore -> - {ok, undefined}; - {error, Error} -> - {error, Error}; - What -> - {error, What} - end. - - -%%% --------------------------------------------------- -%%% -%%% Callback functions. -%%% -%%% --------------------------------------------------- -handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> - #child{mfa = {M, F, A}} = hd(State#state.children), - Args = A ++ EArgs, - case do_start_child_i(M, F, Args) of - {ok, Pid} -> - gproc:reg({p,l,{simple_child,Pid}}, Args), - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, - {reply, {ok, Pid}, NState}; - {ok, Pid, Extra} -> - gproc:reg({p,l,{simple_child,Pid}}, Args), - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, - {reply, {ok, Pid, Extra}, NState}; - What -> - {reply, What, State} - end; - -%%% The requests terminate_child, delete_child and restart_child are -%%% invalid for simple_one_for_one supervisors. -handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> - {reply, {error, simple_one_for_one}, State}; - -handle_call({start_child, ChildSpec}, _From, State) -> - case check_childspec(ChildSpec) of - {ok, Child} -> - {Resp, NState} = handle_start_child(Child, State), - {reply, Resp, NState}; - What -> - {reply, {error, What}, State} - end; - -handle_call({restart_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} when Child#child.pid =:= undefined -> - case do_start_child(State#state.name, Child) of - {ok, Pid} -> - NState = replace_child(Child#child{pid = Pid}, State), - {reply, {ok, Pid}, NState}; - {ok, Pid, Extra} -> - NState = replace_child(Child#child{pid = Pid}, State), - {reply, {ok, Pid, Extra}, NState}; - Error -> - {reply, Error, State} - end; - {value, _} -> - {reply, {error, running}, State}; - _ -> - {reply, {error, not_found}, State} - end; - -handle_call({delete_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} when Child#child.pid =:= undefined -> - NState = remove_child(Child, State), - {reply, ok, NState}; - {value, _} -> - {reply, {error, running}, State}; - _ -> - {reply, {error, not_found}, State} - end; - -handle_call({terminate_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} -> - NChild = do_terminate(Child, State#state.name), - {reply, ok, replace_child(NChild, State)}; - _ -> - {reply, {error, not_found}, State} - end; - -handle_call(which_children, _From, State) when ?is_simple(State) -> - [#child{child_type = CT, modules = Mods}] = State#state.children, - Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end, - ?DICT:to_list(State#state.dynamics)), - {reply, Reply, State}; - -handle_call(which_children, _From, State) -> - Resp = - lists:map(fun(#child{pid = Pid, name = Name, - child_type = ChildType, modules = Mods}) -> - {Name, Pid, ChildType, Mods} - end, - State#state.children), - {reply, Resp, State}. - - -%%% Hopefully cause a function-clause as there is no API function -%%% that utilizes cast. -handle_cast(null, State) -> - error_logger:error_msg("ERROR: Supervisor received cast-message 'null'~n", - []), - - {noreply, State}. - -%% -%% Take care of terminated children. -%% -handle_info({'EXIT', Pid, Reason}, State) -> - case restart_child(Pid, Reason, State) of - {ok, State1} -> - {noreply, State1}; - {shutdown, State1} -> - {stop, shutdown, State1} - end; - -handle_info(Msg, State) -> - error_logger:error_msg("Supervisor received unexpected message: ~p~n", - [Msg]), - {noreply, State}. -%% -%% Terminate this server. -%% -terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. - -%% -%% Change code for the supervisor. -%% Call the new call-back module and fetch the new start specification. -%% Combine the new spec. with the old. If the new start spec. is -%% not valid the code change will not succeed. -%% Use the old Args as argument to Module:init/1. -%% NOTE: This requires that the init function of the call-back module -%% does not have any side effects. -%% -code_change(_, State, _) -> - case (State#state.module):init(State#state.args) of - {ok, {SupFlags, StartSpec}} -> - case catch check_flags(SupFlags) of - ok -> - {Strategy, MaxIntensity, Period} = SupFlags, - update_childspec(State#state{strategy = Strategy, - intensity = MaxIntensity, - period = Period}, - StartSpec); - Error -> - {error, Error} - end; - ignore -> - {ok, State}; - Error -> - Error - end. - -check_flags({Strategy, MaxIntensity, Period}) -> - validStrategy(Strategy), - validIntensity(MaxIntensity), - validPeriod(Period), - ok; -check_flags(What) -> - {bad_flags, What}. - -update_childspec(State, StartSpec) when ?is_simple(State) -> - case check_startspec(StartSpec) of - {ok, [Child]} -> - set_children([Child]), - {ok, State#state{children = [Child]}}; - Error -> - {error, Error} - end; - -update_childspec(State, StartSpec) -> - case check_startspec(StartSpec) of - {ok, Children} -> - OldC = State#state.children, % In reverse start order ! - NewC = update_childspec1(OldC, Children, []), - set_children(NewC), - {ok, State#state{children = NewC}}; - Error -> - {error, Error} - end. - -update_childspec1([Child|OldC], Children, KeepOld) -> - case update_chsp(Child, Children) of - {ok,NewChildren} -> - update_childspec1(OldC, NewChildren, KeepOld); - false -> - update_childspec1(OldC, Children, [Child|KeepOld]) - end; -update_childspec1([], Children, KeepOld) -> - % Return them in (keeped) reverse start order. - lists:reverse(Children ++ KeepOld). - -update_chsp(OldCh, Children) -> - case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name -> - Ch#child{pid = OldCh#child.pid}; - (Ch) -> - Ch - end, - Children) of - Children -> - false; % OldCh not found in new spec. - NewC -> - {ok, NewC} - end. - -%%% --------------------------------------------------- -%%% Start a new child. -%%% --------------------------------------------------- - -handle_start_child(Child, State) -> - case get_child(Child#child.name, State) of - false -> - case do_start_child(State#state.name, Child) of - {ok, Pid} -> - Children = State#state.children, - NewChild = Child#child{pid = Pid}, - NewC = [NewChild|Children], - set_child(NewChild), - {{ok, Pid}, - State#state{children = NewC}}; - {ok, Pid, Extra} -> - Children = State#state.children, - NewChild = Child#child{pid = Pid}, - NewC = [NewChild|Children], - set_child(NewChild), - {{ok, Pid, Extra}, - State#state{children = NewC}}; - {error, What} -> - {{error, {What, Child}}, State} - end; - {value, OldChild} when OldChild#child.pid =/= undefined -> - {{error, {already_started, OldChild#child.pid}}, State}; - {value, _OldChild} -> - {{error, already_present}, State} - end. - -%%% --------------------------------------------------- -%%% Restart. A process has terminated. -%%% Returns: {ok, #state} | {shutdown, #state} -%%% --------------------------------------------------- - -restart_child(Pid, Reason, State) when ?is_simple(State) -> - case ?DICT:find(Pid, State#state.dynamics) of - {ok, Args} -> - [Child] = State#state.children, - RestartType = Child#child.restart_type, - {M, F, _} = Child#child.mfa, - NChild = Child#child{pid = Pid, mfa = {M, F, Args}}, - do_restart(RestartType, Reason, NChild, State); - error -> - {ok, State} - end; -restart_child(Pid, Reason, State) -> - Children = State#state.children, - case lists:keysearch(Pid, #child.pid, Children) of - {value, Child} -> - RestartType = Child#child.restart_type, - do_restart(RestartType, Reason, Child, State); - _ -> - {ok, State} - end. - -do_restart(permanent, Reason, Child, State) -> - report_error(child_terminated, Reason, Child, State#state.name), - restart(Child, State); -do_restart(_, normal, Child, State) -> - NState = state_del_child(Child, State), - {ok, NState}; -do_restart(_, shutdown, Child, State) -> - NState = state_del_child(Child, State), - {ok, NState}; -do_restart(transient, Reason, Child, State) -> - report_error(child_terminated, Reason, Child, State#state.name), - restart(Child, State); -do_restart(temporary, Reason, Child, State) -> - report_error(child_terminated, Reason, Child, State#state.name), - NState = state_del_child(Child, State), - {ok, NState}. - -restart(Child, State) -> - case add_restart(State) of - {ok, NState} -> - restart(NState#state.strategy, Child, NState); - {terminate, NState} -> - report_error(shutdown, reached_max_restart_intensity, - Child, State#state.name), - {shutdown, remove_child(Child, NState)} - end. - -restart(simple_one_for_one, Child, State) -> - #child{mfa = {M, F, A}} = Child, - Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics), - case do_start_child_i(M, F, A) of - {ok, Pid} -> - NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, - {ok, NState}; - {ok, Pid, _Extra} -> - NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, - {ok, NState}; - {error, Error} -> - report_error(start_error, Error, Child, State#state.name), - restart(Child, State) - end; -restart(one_for_one, Child, State) -> - case do_start_child(State#state.name, Child) of - {ok, Pid} -> - NState = replace_child(Child#child{pid = Pid}, State), - {ok, NState}; - {ok, Pid, _Extra} -> - NState = replace_child(Child#child{pid = Pid}, State), - {ok, NState}; - {error, Reason} -> - report_error(start_error, Reason, Child, State#state.name), - restart(Child, State) - end; -restart(rest_for_one, Child, State) -> - {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children), - ChAfter2 = terminate_children(ChAfter, State#state.name), - case start_children(ChAfter2, State#state.name) of - {ok, ChAfter3} -> - NewC = ChAfter3 ++ ChBefore, - {ok, State#state{children = NewC}}; - {error, ChAfter3} -> - NewC = ChAfter3 ++ ChBefore, - restart(Child, State#state{children = NewC}) - end; -restart(one_for_all, Child, State) -> - Children1 = del_child(Child#child.pid, State#state.children), - Children2 = terminate_children(Children1, State#state.name), - case start_children(Children2, State#state.name) of - {ok, NChs} -> - {ok, State#state{children = NChs}}; - {error, NChs} -> - restart(Child, State#state{children = NChs}) - end. - -%%----------------------------------------------------------------- -%% Func: terminate_children/2 -%% Args: Children = [#child] in termination order -%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} -%% Returns: NChildren = [#child] in -%% startup order (reversed termination order) -%%----------------------------------------------------------------- -terminate_children(Children, SupName) -> - terminate_children(Children, SupName, []). - -terminate_children([Child | Children], SupName, Res) -> - NChild = do_terminate(Child, SupName), - set_child(NChild), - terminate_children(Children, SupName, [NChild | Res]); -terminate_children([], _SupName, Res) -> - Res. - -do_terminate(Child, SupName) when Child#child.pid =/= undefined -> - case shutdown(Child#child.pid, - Child#child.shutdown) of - ok -> - Child#child{pid = undefined}; - {error, OtherReason} -> - report_error(shutdown_error, OtherReason, Child, SupName), - Child#child{pid = undefined} - end; -do_terminate(Child, _SupName) -> - Child. - -%%----------------------------------------------------------------- -%% Shutdowns a child. We must check the EXIT value -%% of the child, because it might have died with another reason than -%% the wanted. In that case we want to report the error. We put a -%% monitor on the child an check for the 'DOWN' message instead of -%% checking for the 'EXIT' message, because if we check the 'EXIT' -%% message a "naughty" child, who does unlink(Sup), could hang the -%% supervisor. -%% Returns: ok | {error, OtherReason} (this should be reported) -%%----------------------------------------------------------------- -shutdown(Pid, brutal_kill) -> - - case monitor_child(Pid) of - ok -> - exit(Pid, kill), - receive - {'DOWN', _MRef, process, Pid, killed} -> - ok; - {'DOWN', _MRef, process, Pid, OtherReason} -> - {error, OtherReason} - end; - {error, Reason} -> - {error, Reason} - end; - -shutdown(Pid, Time) -> - - case monitor_child(Pid) of - ok -> - exit(Pid, shutdown), %% Try to shutdown gracefully - receive - {'DOWN', _MRef, process, Pid, shutdown} -> - ok; - {'DOWN', _MRef, process, Pid, OtherReason} -> - {error, OtherReason} - after Time -> - exit(Pid, kill), %% Force termination. - receive - {'DOWN', _MRef, process, Pid, OtherReason} -> - {error, OtherReason} - end - end; - {error, Reason} -> - {error, Reason} - end. - -%% Help function to shutdown/2 switches from link to monitor approach -monitor_child(Pid) -> - - %% Do the monitor operation first so that if the child dies - %% before the monitoring is done causing a 'DOWN'-message with - %% reason noproc, we will get the real reason in the 'EXIT'-message - %% unless a naughty child has already done unlink... - erlang:monitor(process, Pid), - unlink(Pid), - - receive - %% If the child dies before the unlik we must empty - %% the mail-box of the 'EXIT'-message and the 'DOWN'-message. - {'EXIT', Pid, Reason} -> - receive - {'DOWN', _, process, Pid, _} -> - {error, Reason} - end - after 0 -> - %% If a naughty child did unlink and the child dies before - %% monitor the result will be that shutdown/2 receives a - %% 'DOWN'-message with reason noproc. - %% If the child should die after the unlink there - %% will be a 'DOWN'-message with a correct reason - %% that will be handled in shutdown/2. - ok - end. - - -%%----------------------------------------------------------------- -%% Child/State manipulating functions. -%%----------------------------------------------------------------- -state_del_child(#child{pid = Pid}, State) when ?is_simple(State) -> - gproc:unreg({p,l,{simple_child,Pid}}), - NDynamics = ?DICT:erase(Pid, State#state.dynamics), - State#state{dynamics = NDynamics}; -state_del_child(Child, State) -> - NChildren = del_child(Child#child.name, State#state.children), - State#state{children = NChildren}. - -del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name -> - NewCh = Ch#child{pid = undefined}, - set_child(NewCh), - [NewCh | Chs]; -del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid -> - NewCh = Ch#child{pid = undefined}, - set_child(NewCh), - [NewCh | Chs]; -del_child(Name, [Ch|Chs]) -> - [Ch|del_child(Name, Chs)]; -del_child(_, []) -> - []. - -%% Chs = [S4, S3, Ch, S1, S0] -%% Ret: {[S4, S3, Ch], [S1, S0]} -split_child(Name, Chs) -> - split_child(Name, Chs, []). - -split_child(Name, [Ch|Chs], After) when Ch#child.name =:= Name -> - {lists:reverse([Ch#child{pid = undefined} | After]), Chs}; -split_child(Pid, [Ch|Chs], After) when Ch#child.pid =:= Pid -> - {lists:reverse([Ch#child{pid = undefined} | After]), Chs}; -split_child(Name, [Ch|Chs], After) -> - split_child(Name, Chs, [Ch | After]); -split_child(_, [], After) -> - {lists:reverse(After), []}. - -get_child(Name, State) -> - lists:keysearch(Name, #child.name, State#state.children). -replace_child(Child, State) -> - Chs = do_replace_child(Child, State#state.children), - State#state{children = Chs}. - -do_replace_child(Child, [Ch|Chs]) when Ch#child.name =:= Child#child.name -> - set_child(Child), - [Child | Chs]; -do_replace_child(Child, [Ch|Chs]) -> - [Ch|do_replace_child(Child, Chs)]. - -remove_child(Child, State) -> - Chs = lists:keydelete(Child#child.name, #child.name, State#state.children), - unreg_child(Child), - State#state{children = Chs}. - -%%----------------------------------------------------------------- -%% Func: init_state/4 -%% Args: SupName = {local, atom()} | {global, atom()} | self -%% Type = {Strategy, MaxIntensity, Period} -%% Strategy = one_for_one | one_for_all | simple_one_for_one | -%% rest_for_one -%% MaxIntensity = integer() -%% Period = integer() -%% Mod :== atom() -%% Arsg :== term() -%% Purpose: Check that Type is of correct type (!) -%% Returns: {ok, #state} | Error -%%----------------------------------------------------------------- -init_state(SupName, Type, Mod, Args) -> - case catch init_state1(SupName, Type, Mod, Args) of - {ok, State} -> - {ok, State}; - Error -> - Error - end. - -init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) -> - validStrategy(Strategy), - validIntensity(MaxIntensity), - validPeriod(Period), - {ok, #state{name = supname(SupName,Mod), - strategy = Strategy, - intensity = MaxIntensity, - period = Period, - module = Mod, - args = Args}}; -init_state1(_SupName, Type, _, _) -> - {invalid_type, Type}. - -validStrategy(simple_one_for_one) -> true; -validStrategy(one_for_one) -> true; -validStrategy(one_for_all) -> true; -validStrategy(rest_for_one) -> true; -validStrategy(What) -> throw({invalid_strategy, What}). - -validIntensity(Max) when is_integer(Max), - Max >= 0 -> true; -validIntensity(What) -> throw({invalid_intensity, What}). - -validPeriod(Period) when is_integer(Period), - Period > 0 -> true; -validPeriod(What) -> throw({invalid_period, What}). - -supname(self,Mod) -> {self(),Mod}; -supname(N,_) -> N. - -%%% ------------------------------------------------------ -%%% Check that the children start specification is valid. -%%% Shall be a six (6) tuple -%%% {Name, Func, RestartType, Shutdown, ChildType, Modules} -%%% where Name is an atom -%%% Func is {Mod, Fun, Args} == {atom, atom, list} -%%% RestartType is permanent | temporary | transient -%%% Shutdown = integer() | infinity | brutal_kill -%%% ChildType = supervisor | worker -%%% Modules = [atom()] | dynamic -%%% Returns: {ok, [#child]} | Error -%%% ------------------------------------------------------ - -check_startspec(Children) -> check_startspec(Children, []). - -check_startspec([ChildSpec|T], Res) -> - case check_childspec(ChildSpec) of - {ok, Child} -> - case lists:keysearch(Child#child.name, #child.name, Res) of - {value, _} -> {duplicate_child_name, Child#child.name}; - _ -> check_startspec(T, [Child | Res]) - end; - Error -> Error - end; -check_startspec([], Res) -> - {ok, lists:reverse(Res)}. - -check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) -> - catch check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods); -check_childspec(X) -> {invalid_child_spec, X}. - -check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) -> - validName(Name), - validFunc(Func), - validRestartType(RestartType), - validChildType(ChildType), - validShutdown(Shutdown, ChildType), - validMods(Mods), - {ok, #child{name = Name, mfa = Func, restart_type = RestartType, - shutdown = Shutdown, child_type = ChildType, modules = Mods}}. - -validChildType(supervisor) -> true; -validChildType(worker) -> true; -validChildType(What) -> throw({invalid_child_type, What}). - -validName(_Name) -> true. - -validFunc({M, F, A}) when is_atom(M), - is_atom(F), - is_list(A) -> true; -validFunc(Func) -> throw({invalid_mfa, Func}). - -validRestartType(permanent) -> true; -validRestartType(temporary) -> true; -validRestartType(transient) -> true; -validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). - -validShutdown(Shutdown, _) - when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; -validShutdown(brutal_kill, _) -> true; -validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). - -validMods(dynamic) -> true; -validMods(Mods) when is_list(Mods) -> - lists:foreach(fun(Mod) -> - if - is_atom(Mod) -> ok; - true -> throw({invalid_module, Mod}) - end - end, - Mods); -validMods(Mods) -> throw({invalid_modules, Mods}). - -%%% ------------------------------------------------------ -%%% Add a new restart and calculate if the max restart -%%% intensity has been reached (in that case the supervisor -%%% shall terminate). -%%% All restarts occurred inside the period amount of seconds -%%% are kept in the #state.restarts list. -%%% Returns: {ok, State'} | {terminate, State'} -%%% ------------------------------------------------------ - -add_restart(State) -> - I = State#state.intensity, - P = State#state.period, - R = State#state.restarts, - Now = erlang:now(), - R1 = add_restart([Now|R], Now, P), - State1 = State#state{restarts = R1}, - case length(R1) of - CurI when CurI =< I -> - {ok, State1}; - _ -> - {terminate, State1} - end. - -add_restart([R|Restarts], Now, Period) -> - case inPeriod(R, Now, Period) of - true -> - [R|add_restart(Restarts, Now, Period)]; - _ -> - [] - end; -add_restart([], _, _) -> - []. - -inPeriod(Time, Now, Period) -> - case difference(Time, Now) of - T when T > Period -> - false; - _ -> - true - end. - -%% -%% Time = {MegaSecs, Secs, MicroSecs} (NOTE: MicroSecs is ignored) -%% Calculate the time elapsed in seconds between two timestamps. -%% If MegaSecs is equal just subtract Secs. -%% Else calculate the Mega difference and add the Secs difference, -%% note that Secs difference can be negative, e.g. -%% {827, 999999, 676} diff {828, 1, 653753} == > 2 secs. -%% -difference({TimeM, TimeS, _}, {CurM, CurS, _}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000) + (CurS - TimeS); -difference({_, TimeS, _}, {_, CurS, _}) -> - CurS - TimeS. - -%%% ------------------------------------------------------ -%%% Error and progress reporting. -%%% ------------------------------------------------------ - -report_error(Error, Reason, Child, SupName) -> - ErrorMsg = [{supervisor, SupName}, - {errorContext, Error}, - {reason, Reason}, - {offender, extract_child(Child)}], - error_logger:error_report(supervisor_report, ErrorMsg). - - -extract_child(Child) -> - [{pid, Child#child.pid}, - {name, Child#child.name}, - {mfa, Child#child.mfa}, - {restart_type, Child#child.restart_type}, - {shutdown, Child#child.shutdown}, - {child_type, Child#child.child_type}]. - -report_progress(Child, SupName) -> - Progress = [{supervisor, SupName}, - {started, extract_child(Child)}], - error_logger:info_report(progress, Progress). diff --git a/patches/stdlib/sys.erl b/patches/stdlib/sys.erl deleted file mode 100644 index 7256a62..0000000 --- a/patches/stdlib/sys.erl +++ /dev/null @@ -1,361 +0,0 @@ -%% ``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 via the world wide web 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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id$ -%% --module(sys). - -%% External exports --export([suspend/1, suspend/2, resume/1, resume/2, - get_status/1, get_status/2, - change_code/4, change_code/5, - log/2, log/3, trace/2, trace/3, statistics/2, statistics/3, - log_to_file/2, log_to_file/3, no_debug/1, no_debug/2, - install/2, install/3, remove/2, remove/3]). --export([reg/3, reg/4]). --export([handle_system_msg/6, handle_debug/4, - print_log/1, get_debug/3, debug_options/1]). - -%%----------------------------------------------------------------- -%% System messages -%%----------------------------------------------------------------- -suspend(Name) -> send_system_msg(Name, suspend). -suspend(Name, Timeout) -> send_system_msg(Name, suspend, Timeout). - -resume(Name) -> send_system_msg(Name, resume). -resume(Name, Timeout) -> send_system_msg(Name, resume, Timeout). - -get_status(Name) -> send_system_msg(Name, get_status). -get_status(Name, Timeout) -> send_system_msg(Name, get_status, Timeout). - -change_code(Name, Mod, Vsn, Extra) -> - send_system_msg(Name, {change_code, Mod, Vsn, Extra}). -change_code(Name, Mod, Vsn, Extra, Timeout) -> - send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout). - -reg(Name, Key, Value) -> - send_system_msg(Name, {reg, Key, Value}). -reg(Name, Key, Value, Timeout) -> - send_system_msg(Name, {reg, Key, Value}, Timeout). - -%%----------------------------------------------------------------- -%% Debug commands -%%----------------------------------------------------------------- -log(Name, Flag) -> - send_system_msg(Name, {debug, {log, Flag}}). -log(Name, Flag, Timeout) -> - send_system_msg(Name, {debug, {log, Flag}}, Timeout). - -trace(Name, Flag) -> - send_system_msg(Name, {debug, {trace, Flag}}). -trace(Name, Flag, Timeout) -> - send_system_msg(Name, {debug, {trace, Flag}}, Timeout). - -log_to_file(Name, FileName) -> - send_system_msg(Name, {debug, {log_to_file, FileName}}). -log_to_file(Name, FileName, Timeout) -> - send_system_msg(Name, {debug, {log_to_file, FileName}}, Timeout). - -statistics(Name, Flag) -> - send_system_msg(Name, {debug, {statistics, Flag}}). -statistics(Name, Flag, Timeout) -> - send_system_msg(Name, {debug, {statistics, Flag}}, Timeout). - -no_debug(Name) -> send_system_msg(Name, {debug, no_debug}). -no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout). - -install(Name, {Func, FuncState}) -> - send_system_msg(Name, {debug, {install, {Func, FuncState}}}). -install(Name, {Func, FuncState}, Timeout) -> - send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout). - -remove(Name, Func) -> - send_system_msg(Name, {debug, {remove, Func}}). -remove(Name, Func, Timeout) -> - send_system_msg(Name, {debug, {remove, Func}}, Timeout). - -%%----------------------------------------------------------------- -%% All system messages sent are on the form {system, From, Msg} -%% The receiving side should send Msg to handle_system_msg/5. -%%----------------------------------------------------------------- -send_system_msg(Name, Request) -> - case catch gen:call(Name, system, Request) of - {ok,Res} -> Res; - {'EXIT', Reason} -> exit({Reason, mfa(Name, Request)}) - end. - -send_system_msg(Name, Request, Timeout) -> - case catch gen:call(Name, system, Request, Timeout) of - {ok,Res} -> Res; - {'EXIT', Reason} -> exit({Reason, mfa(Name, Request, Timeout)}) - end. - -mfa(Name, {debug, {Func, Arg2}}) -> - {sys, Func, [Name, Arg2]}; -mfa(Name, {change_code, Mod, Vsn, Extra}) -> - {sys, change_code, [Name, Mod, Vsn, Extra]}; -mfa(Name, Atom) -> - {sys, Atom, [Name]}. -mfa(Name, Req, Timeout) -> - {M, F, A} = mfa(Name, Req), - {M, F, A ++ [Timeout]}. - -%%----------------------------------------------------------------- -%% Func: handle_system_msg/6 -%% Args: Msg ::= term() -%% From ::= {pid(),Ref} but don't count on that -%% Parent ::= pid() -%% Module ::= atom() -%% Debug ::= [debug_opts()] -%% Misc ::= term() -%% Purpose: Used by a process module that wishes to take care of -%% system messages. The process receives a {system, From, -%% Msg} message, and passes the Msg to this function. -%% Returns: This function *never* returns! It calls the function -%% Module:system_continue(Parent, NDebug, Misc) -%% there the process continues the execution or -%% Module:system_terminate(Raeson, Parent, Debug, Misc) if -%% the process should terminate. -%% The Module must export system_continue/3, system_terminate/4 -%% and format_status/2 for status information. -%%----------------------------------------------------------------- -handle_system_msg(Msg, From, Parent, Module, Debug, Misc) -> - handle_system_msg(running, Msg, From, Parent, Module, Debug, Misc). - -handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc) -> - case do_cmd(SysState, Msg, Parent, Mod, Debug, Misc) of - {suspended, Reply, NDebug, NMisc} -> - gen:reply(From, Reply), - suspend_loop(suspended, Parent, Mod, NDebug, NMisc); - {running, Reply, NDebug, NMisc} -> - gen:reply(From, Reply), - Mod:system_continue(Parent, NDebug, NMisc) - end. - -%%----------------------------------------------------------------- -%% Func: handle_debug/4 -%% Args: Debug ::= [debug_opts()] -%% Func ::= {M,F} | fun() arity 3 -%% State ::= term() -%% Event ::= {in, Msg} | {in, Msg, From} | {out, Msg, To} | term() -%% Purpose: Called by a process that wishes to debug an event. -%% Func is a formatting function, called as Func(Device, Event). -%% Returns: [debug_opts()] -%%----------------------------------------------------------------- -handle_debug([{trace, true} | T], FormFunc, State, Event) -> - print_event({Event, State, FormFunc}), - [{trace, true} | handle_debug(T, FormFunc, State, Event)]; -handle_debug([{log, {N, LogData}} | T], FormFunc, State, Event) -> - NLogData = [{Event, State, FormFunc} | trim(N, LogData)], - [{log, {N, NLogData}} | handle_debug(T, FormFunc, State, Event)]; -handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) -> - print_event(Fd, {Event, State, FormFunc}), - [{log_to_file, Fd} | handle_debug(T, FormFunc, State, Event)]; -handle_debug([{statistics, StatData} | T], FormFunc, State, Event) -> - NStatData = stat(Event, StatData), - [{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)]; -handle_debug([{Func, FuncState} | T], FormFunc, State, Event) -> - case catch Func(FuncState, Event, State) of - done -> handle_debug(T, FormFunc, State, Event); - {'EXIT', _} -> handle_debug(T, FormFunc, State, Event); - NFuncState -> - [{Func, NFuncState} | handle_debug(T, FormFunc, State, Event)] - end; -handle_debug([], _FormFunc, _State, _Event) -> - []. - - -%%----------------------------------------------------------------- -%% When a process is suspended, it can only respond to system -%% messages. -%%----------------------------------------------------------------- -suspend_loop(SysState, Parent, Mod, Debug, Misc) -> - receive - {system, From, Msg} -> - handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc); - {'EXIT', Parent, Reason} -> - Mod:system_terminate(Reason, Parent, Debug, Misc) - end. - -do_cmd(_, suspend, _Parent, _Mod, Debug, Misc) -> - {suspended, ok, Debug, Misc}; -do_cmd(_, resume, _Parent, _Mod, Debug, Misc) -> - {running, ok, Debug, Misc}; -do_cmd(SysState, {reg, Key, Value}, _Parent, Mod, Debug, Misc) -> - Res = case erlang:function_exported(Mod, system_reg, 3) of - true -> - catch Mod:system_reg(Misc, Key, Value); - false -> - catch gproc:reg(Key, Value) - end, - {SysState, Res, Debug, Misc}; -do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> - Res = get_status(SysState, Parent, Mod, Debug, Misc), - {SysState, Res, Debug, Misc}; -do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) -> - {Res, NDebug} = debug_cmd(What, Debug), - {SysState, Res, NDebug, Misc}; -do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, - Mod, Debug, Misc) -> - {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc), - {suspended, Res, Debug, NMisc}; -do_cmd(SysState, Other, _Parent, _Mod, Debug, Misc) -> - {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}. - -get_status(SysState, Parent, Mod, Debug, Misc) -> - {status, self(), {module, Mod}, - [get(), SysState, Parent, Debug, Misc]}. - -%%----------------------------------------------------------------- -%% These are the system debug commands. -%% {trace, true|false} -> io:format -%% {log, true|false|get|print} -> keeps the 10 last debug messages -%% {log_to_file, FileName | false} -> io:format to file. -%% {statistics, true|false|get} -> keeps track of messages in/out + reds. -%%----------------------------------------------------------------- -debug_cmd({trace, true}, Debug) -> - {ok, install_debug(trace, true, Debug)}; -debug_cmd({trace, false}, Debug) -> - {ok, remove_debug(trace, Debug)}; -debug_cmd({log, true}, Debug) -> - {_N, Logs} = get_debug(log, Debug, {0, []}), - {ok, install_debug(log, {10, trim(10, Logs)}, Debug)}; -debug_cmd({log, {true, N}}, Debug) when is_integer(N), N > 0 -> - {_N, Logs} = get_debug(log, Debug, {0, []}), - {ok, install_debug(log, {N, trim(N, Logs)}, Debug)}; -debug_cmd({log, false}, Debug) -> - {ok, remove_debug(log, Debug)}; -debug_cmd({log, print}, Debug) -> - print_log(Debug), - {ok, Debug}; -debug_cmd({log, get}, Debug) -> - {_N, Logs} = get_debug(log, Debug, {0, []}), - {{ok, lists:reverse(Logs)}, Debug}; -debug_cmd({log_to_file, false}, Debug) -> - NDebug = close_log_file(Debug), - {ok, NDebug}; -debug_cmd({log_to_file, FileName}, Debug) -> - NDebug = close_log_file(Debug), - case file:open(FileName, write) of - {ok, Fd} -> - {ok, install_debug(log_to_file, Fd, NDebug)}; - _Error -> - {{error, open_file}, NDebug} - end; -debug_cmd({statistics, true}, Debug) -> - {ok, install_debug(statistics, init_stat(), Debug)}; -debug_cmd({statistics, false}, Debug) -> - {ok, remove_debug(statistics, Debug)}; -debug_cmd({statistics, get}, Debug) -> - {{ok, get_stat(get_debug(statistics, Debug, []))}, Debug}; -debug_cmd(no_debug, Debug) -> - close_log_file(Debug), - {ok, []}; -debug_cmd({install, {Func, FuncState}}, Debug) -> - {ok, install_debug(Func, FuncState, Debug)}; -debug_cmd({remove, Func}, Debug) -> - {ok, remove_debug(Func, Debug)}; -debug_cmd(_Unknown, Debug) -> - {unknown_debug, Debug}. - - -do_change_code(Mod, Module, Vsn, Extra, Misc) -> - case catch Mod:system_code_change(Misc, Module, Vsn, Extra) of - {ok, NMisc} -> {ok, NMisc}; - Else -> {{error, Else}, Misc} - end. - -print_event(X) -> print_event(standard_io, X). - -print_event(Dev, {Event, State, FormFunc}) -> - FormFunc(Dev, Event, State). - -init_stat() -> {erlang:localtime(), process_info(self(), reductions), 0, 0}. -get_stat({Time, {reductions, Reds}, In, Out}) -> - {reductions, Reds2} = process_info(self(), reductions), - [{start_time, Time}, {current_time, erlang:localtime()}, - {reductions, Reds2 - Reds}, {messages_in, In}, {messages_out, Out}]; -get_stat(_) -> - no_statistics. - -stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out}; -stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out}; -stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1}; -stat(_, StatData) -> StatData. - -trim(N, LogData) -> - lists:sublist(LogData, 1, N-1). - -%%----------------------------------------------------------------- -%% Debug structure manipulating functions -%%----------------------------------------------------------------- -install_debug(Item, Data, Debug) -> - case get_debug(Item, Debug, undefined) of - undefined -> [{Item, Data} | Debug]; - _ -> Debug - end. -remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug). -get_debug(Item, Debug, Default) -> - case lists:keysearch(Item, 1, Debug) of - {value, {Item, Data}} -> Data; - _ -> Default - end. - -print_log(Debug) -> - {_N, Logs} = get_debug(log, Debug, {0, []}), - lists:foreach(fun print_event/1, - lists:reverse(Logs)). - -close_log_file(Debug) -> - case get_debug(log_to_file, Debug, []) of - [] -> - Debug; - Fd -> - file:close(Fd), - remove_debug(log_to_file, Debug) - end. - -%%----------------------------------------------------------------- -%% Func: debug_options/1 -%% Args: [trace|log|{log,N}|statistics|{log_to_file, FileName}| -%% {install, {Func, FuncState}}] -%% Purpose: Initiate a debug structure. Called by a process that -%% wishes to initiate the debug structure without the -%% system messages. -%% Returns: [debug_opts()] -%%----------------------------------------------------------------- -debug_options(Options) -> - debug_options(Options, []). -debug_options([trace | T], Debug) -> - debug_options(T, install_debug(trace, true, Debug)); -debug_options([log | T], Debug) -> - debug_options(T, install_debug(log, {10, []}, Debug)); -debug_options([{log, N} | T], Debug) when is_integer(N), N > 0 -> - debug_options(T, install_debug(log, {N, []}, Debug)); -debug_options([statistics | T], Debug) -> - debug_options(T, install_debug(statistics, init_stat(), Debug)); -debug_options([{log_to_file, FileName} | T], Debug) -> - case file:open(FileName, write) of - {ok, Fd} -> - debug_options(T, install_debug(log_to_file, Fd, Debug)); - _Error -> - debug_options(T, Debug) - end; -debug_options([{install, {Func, FuncState}} | T], Debug) -> - debug_options(T, install_debug(Func, FuncState, Debug)); -debug_options([_ | T], Debug) -> - debug_options(T, Debug); -debug_options([], Debug) -> - Debug. diff --git a/rebar.config b/rebar.config index d9d3b95..756f6f0 100644 --- a/rebar.config +++ b/rebar.config @@ -13,6 +13,7 @@ no_opaque, no_fail_call, error_handling, no_match, unmatched_returns, underspecs]}]}. + {profiles, [ {edown, [ {deps, [ diff --git a/src/gproc.app.src b/src/gproc.app.src index 41892b7..570f16d 100644 --- a/src/gproc.app.src +++ b/src/gproc.app.src @@ -5,13 +5,11 @@ {application, gproc, [ {description, "Extended process registry for Erlang"}, - {vsn, git}, + {vsn, "zomp"}, {id, "GPROC"}, {registered, [ ] }, {applications, [ kernel, stdlib ] }, {mod, {gproc_app, []} }, - - {maintainers, ["Ulf Wiger"]}, {licenses, ["Apache-2.0"]}, {links, [{"Github", "https://github.com/uwiger/gproc"}]} ] diff --git a/src/gproc.app.src.script b/src/gproc.app.src.script new file mode 100644 index 0000000..becbb46 --- /dev/null +++ b/src/gproc.app.src.script @@ -0,0 +1,14 @@ +%% -*- erlang-mode; erlang-indent-level: 4; indent-tabs-mode: nil -*- + +[{application, Name, Opts}] = CONFIG. +case lists:keyfind(vsn, 1, Opts) of + {vsn, "zomp"} -> + ZompMetaF = filename:join(filename:dirname(filename:dirname(SCRIPT)), "zomp.meta"), + {ok, ZMeta} = file:consult(ZompMetaF), + {_, {_, _, {Vmaj,Vmin,Vpatch}}} = lists:keyfind(package_id, 1, ZMeta), + VsnStr = unicode:characters_to_list(io_lib:fwrite("~w.~w.~w", [Vmaj, Vmin, Vpatch])), + Opts1 = lists:keyreplace(vsn, 1, Opts, {vsn, VsnStr}), + [{application, Name, Opts1}]; + _ -> + CONFIG +end. diff --git a/zomp.ignore b/zomp.ignore new file mode 100644 index 0000000..0858a81 --- /dev/null +++ b/zomp.ignore @@ -0,0 +1,10 @@ +tetrapak +rebar.lock +doc/*.pdf +doc/edoc-info +doc/stylesheet.css +reference +edoc-info +test +dist_shell.config +priv \ No newline at end of file diff --git a/zomp.meta b/zomp.meta new file mode 100644 index 0000000..12bfad3 --- /dev/null +++ b/zomp.meta @@ -0,0 +1,17 @@ +{name,"gproc"}. +{type,app}. +{modules,[]}. +{prefix,"gproc"}. +{author,"Ulf Wiger"}. +{desc,"Extended process registry for Erlang"}. +{package_id,{"uwiger","gproc",{1,1,0}}}. +{deps,[]}. +{key_name,none}. +{a_email,"ulf@wiger.net"}. +{c_email,"ulf@wiger.net"}. +{copyright,"Ulf Wiger"}. +{file_exts,[]}. +{license,"Apache-2.0"}. +{repo_url,"https://github.com/uwiger/gproc"}. +{tags,[]}. +{ws_url,[]}. diff --git a/zompify.sh b/zompify.sh new file mode 100755 index 0000000..66aca1c --- /dev/null +++ b/zompify.sh @@ -0,0 +1,42 @@ +#!/bin/sh +set -e + +APP=$(basename "$PWD") + +SRC="_build/default/lib/$APP" +DST="$PWD/_build/zomp/lib/$APP" +IGNORE_FILE="zomp.ignore" + +mkdir -p "$DST" + +# Remove broken symlinks +find "$SRC" -type l ! -exec test -e {} \; -delete || true + +# Build ignore matcher +IGNORE_TEMP=$(mktemp) +trap "rm -f $IGNORE_TEMP" EXIT + +# Expand globs in zomp.ignore to patterns suitable for grep +if [ -e "$IGNORE_FILE" ]; then + grep -v '^\s*#' "$IGNORE_FILE" | sed 's#/#\\/#g' | sed 's/\./\\./g' | sed 's/\*/.*/g' > "$IGNORE_TEMP" +fi + +# Copy Git-tracked and Zomp-allowed files +git ls-files -z | while IFS= read -r -d '' file; do + # Skip if ignored + echo "$file" | grep -Eq -f "$IGNORE_TEMP" && continue + # Only copy if file exists in the build dir + if [ -e "$SRC/$file" ]; then + mkdir -p "$DST/$(dirname "$file")" + cp -a "$SRC/$file" "$DST/$file" + fi +done + +rm "$IGNORE_TEMP" + +# Copy metadata +cp "$PWD/zomp.meta" "$DST/" +cp "$PWD/Emakefile" "$DST/" + +# Clean up beam files just in case +[ -d "$DST/ebin" ] && find "$DST/ebin" -name '*.beam' -exec rm -f {} + || true