Add support for supervisor intensity and period

Adds support for honoring intensity and period supervisor options, allowing the prevention of
endless crash and restarts by misbehaving children.

Adds a test to ensure the settings work as expected on AtomVM and match OTP.

Closes #1915

Signed-off-by: Winford <[email protected]>

Author: UncleGrumpy

CHANGELOG.md

@@ -92,6 +92,7 @@ instead `badarg`.
 - Fix a memory leak in distribution when a BEAM node would monitor a process by name.
 - Fix `list_to_integer`, it was likely buggy with integers close to INT64_MAX
 - Added missing support for supervisor `one_for_all` strategy.
+- Supervisor now honors period and intensity options.
 
 ## [0.6.7] - Unreleased
 

libs/estdlib/src/supervisor.erl

@@ -92,7 +92,21 @@
     modules = [] :: [module()] | dynamic
 }).
 %% note: the list of children should always be kept in order, with first to start at the head.
--record(state, {restart_strategy = one_for_one :: strategy(), children = [] :: [#child{}]}).
+-record(state, {
+    restart_strategy = one_for_one :: strategy(),
+    intensity = 3 :: non_neg_integer(),
+    period = 5 :: pos_integer(),
+    restart_count = 0 :: non_neg_integer(),
+    restarts = [] :: [integer()],
+    children = [] :: [#child{}]
+}).
+
+%% Used to trim stale restarts when the 'intensity' value is large.
+%% The number of restarts before triggering a purge of restarts older
+%% than 'period', so stale restarts do not continue to consume ram for
+%% the sake of MCUs with limited memory. In the future a function
+%% could be used to set a sane default for the platform (OTP uses 1000).
+-define(STALE_RESTART_LIMIT, 100).
 
 start_link(Module, Args) ->
     gen_server:start_link(?MODULE, {Module, Args}, []).
@@ -121,12 +135,23 @@ count_children(Supervisor) ->
 init({Mod, Args}) ->
     erlang:process_flag(trap_exit, true),
     case Mod:init(Args) of
-        {ok, {{Strategy, _Intensity, _Period}, StartSpec}} ->
-            State = init_state(StartSpec, #state{restart_strategy = Strategy}),
+        {ok, {{Strategy, Intensity, Period}, StartSpec}} ->
+            State = init_state(StartSpec, #state{
+                restart_strategy = Strategy,
+                intensity = Intensity,
+                period = Period
+            }),
             NewChildren = start_children(State#state.children, []),
             {ok, State#state{children = NewChildren}};
-        {ok, {#{strategy := Strategy}, StartSpec}} ->
-            State = init_state(StartSpec, #state{restart_strategy = Strategy}),
+        {ok, {#{} = SupSpec, StartSpec}} ->
+            Strategy = maps:get(strategy, SupSpec, one_for_one),
+            Intensity = maps:get(intensity, SupSpec, 3),
+            Period = maps:get(period, SupSpec, 5),
+            State = init_state(StartSpec, #state{
+                restart_strategy = Strategy,
+                intensity = Intensity,
+                period = Period
+            }),
             NewChildren = start_children(State#state.children, []),
             {ok, State#state{children = NewChildren}};
         Error ->
@@ -321,7 +346,15 @@ handle_child_exit(Pid, Reason, State) ->
         #child{} = Child ->
             case should_restart(Reason, Child#child.restart) of
                 true ->
-                    handle_restart_strategy(Child, State);
+                    case add_restart(State) of
+                        {ok, State1} ->
+                            handle_restart_strategy(Child, State1);
+                        {shutdown, State1} ->
+                            RemainingChildren = lists:keydelete(
+                                Pid, #child.pid, State1#state.children
+                            ),
+                            {shutdown, State1#state{children = RemainingChildren}}
+                    end;
                 false ->
                     Children = lists:keydelete(Pid, #child.pid, State#state.children),
                     {ok, State#state{children = Children}}
@@ -360,6 +393,8 @@ should_restart(Reason, transient) ->
 
 loop_terminate([#child{pid = undefined} | Tail], AccRemaining) ->
     loop_terminate(Tail, AccRemaining);
+loop_terminate([#child{pid = {restarting, _}} | Tail], AccRemaining) ->
+    loop_terminate(Tail, AccRemaining);
 loop_terminate([#child{pid = Pid} = Child | Tail], AccRemaining) when is_pid(Pid) ->
     do_terminate(Child),
     loop_terminate(Tail, [Pid | AccRemaining]);
@@ -454,6 +489,49 @@ wait_child_exit(#child{pid = Pid, shutdown = Timeout} = Child) ->
         {timeout, {no_exit, Child}}
     end.
 
+add_restart(
+    #state{
+        intensity = Intensity, period = Period, restart_count = RestartCount, restarts = Restarts
+    } = State
+) ->
+    Now = erlang:monotonic_time(millisecond),
+    Threshold = Now - Period * 1000,
+    case can_restart(Intensity, Threshold, Restarts, RestartCount) of
+        {true, RestartCount1, Restarts1} ->
+            {ok, State#state{
+                restarts = Restarts1 ++ [Now], restart_count = RestartCount1 + 1
+            }};
+        {false, RestartCount1, Restarts1} ->
+            % TODO: log supervisor shutdown due to maximum intensity exceeded
+            {shutdown, State#state{
+                restarts = Restarts1, restart_count = RestartCount1
+            }}
+    end.
+
+can_restart(0, _, _, _) ->
+    {false, 0, []};
+can_restart(_, _, _, 0) ->
+    {true, 0, []};
+can_restart(Intensity, Threshold, Restarts, RestartCount) when
+    RestartCount >= ?STALE_RESTART_LIMIT
+->
+    {NewCount, Restarts1} = trim_expired_restarts(Threshold, lists:sort(Restarts)),
+    can_restart(Intensity, Threshold, Restarts1, NewCount);
+can_restart(Intensity, Threshold, [Restart | _] = Restarts, RestartCount) when
+    RestartCount >= Intensity andalso Restart < Threshold
+->
+    {NewCount, Restarts1} = trim_expired_restarts(Threshold, lists:sort(Restarts)),
+    can_restart(Intensity, Threshold, Restarts1, NewCount);
+can_restart(Intensity, _, Restarts, RestartCount) when RestartCount >= Intensity ->
+    {false, RestartCount, Restarts};
+can_restart(Intensity, _, Restarts, RestartCount) when RestartCount < Intensity ->
+    {true, RestartCount, Restarts}.
+
+trim_expired_restarts(Threshold, [Restart | Restarts]) when Restart < Threshold ->
+    trim_expired_restarts(Threshold, Restarts);
+trim_expired_restarts(_Threshold, Restarts) ->
+    {length(Restarts), Restarts}.
+
 child_to_info(#child{id = Id, pid = Pid, type = Type, modules = Modules}) ->
     Child =
         case Pid of

tests/libs/estdlib/test_supervisor.erl

@@ -36,6 +36,7 @@ test() ->
     ok = test_which_children(),
     ok = test_count_children(),
     ok = test_one_for_all(),
+    ok = test_crash_limits(),
     ok.
 
 test_basic_supervisor() ->
@@ -321,7 +322,19 @@ init({test_one_for_all, Parent}) ->
             modules => [notify_init_server]
         }
     ],
-    {ok, {#{strategy => one_for_all, intensity => 10000, period => 3600}, ChildSpecs}}.
+    {ok, {#{strategy => one_for_all, intensity => 10000, period => 3600}, ChildSpecs}};
+init({test_crash_limits, Intensity, Period, Parent}) ->
+    ChildSpec = [
+        #{
+            id => test_child,
+            start => {ping_pong_server, start_link, [Parent]},
+            restart => transient,
+            shutdown => brutal_kill,
+            type => worker,
+            modules => [ping_pong_server]
+        }
+    ],
+    {ok, {#{strategy => one_for_one, intensity => Intensity, period => Period}, ChildSpec}}.
 
 test_supervisor_order() ->
     {ok, SupPid} = supervisor:start_link(?MODULE, {test_supervisor_order, self()}),
@@ -440,3 +453,71 @@ test_one_for_all() ->
     unlink(SupPid),
     exit(SupPid, shutdown),
     ok.
+
+test_crash_limits() ->
+    %% Trap exits so this test doesn't shutdown with the supervisor
+    process_flag(trap_exit, true),
+    Intensity = 2,
+    Period = 5,
+    {ok, SupPid} = supervisor:start_link(
+        {local, test_crash_limits}, ?MODULE, {test_crash_limits, Intensity, Period, self()}
+    ),
+    Pid1 = get_ping_pong_pid(),
+    gen_server:call(Pid1, {stop, test_crash1}),
+    Pid2 = get_ping_pong_pid(),
+    gen_server:cast(Pid2, {crash, test_crash2}),
+    Pid3 = get_ping_pong_pid(),
+    %% Wait until period expires so we can test that stale shutdowns are purged from the shutdown list
+    timer:sleep(6000),
+
+    gen_server:call(Pid3, {stop, test_crash3}),
+    Pid4 = get_ping_pong_pid(),
+    gen_server:cast(Pid4, {crash, test_crash4}),
+    Pid5 = get_ping_pong_pid(),
+
+    %% The next crash will reach the restart threshold and shutdown the supervisor
+    gen_server:call(Pid5, {stop, test_crash5}),
+
+    %% Test supervisor has exited
+    ok =
+        receive
+            {'EXIT', SupPid, shutdown} ->
+                ok
+        after 2000 ->
+            error({supervisor_not_stopped, reached_max_restart_intensity})
+        end,
+    process_flag(trap_exit, false),
+
+    %% Test child crashed and was not restarted
+    ok =
+        try gen_server:call(Pid5, ping) of
+            pong -> error(not_stopped, Pid5)
+        catch
+            exit:{noproc, _MFA} -> ok
+        end,
+    ok =
+        try get_ping_pong_pid() of
+            Pid6 when is_pid(Pid6) ->
+                error({child_restarted, reached_max_restart_intensity})
+        catch
+            throw:timeout ->
+                ok
+        end,
+
+    ok =
+        try erlang:process_info(SupPid, links) of
+            {links, Links} when is_list(Links) ->
+                error({not_stopped, reached_max_restart_intensity});
+            undefined ->
+                ok
+        catch
+            error:badarg ->
+                ok
+        end,
+    ok.
+
+get_ping_pong_pid() ->
+    receive
+        {ping_pong_server_ready, Pid} -> Pid
+    after 2000 -> throw(timeout)
+    end.