1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2016-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(erts_code_purger).
21
22%% Purpose : Implement system process erts_code_purger
23%%           to handle code module purging.
24
25-export([start/0, purge/1, soft_purge/1, pending_purge_lambda/3,
26	 finish_after_on_load/2]).
27
28%% Internal export
29-export([wait_for_request/0]).
30
31-spec start() -> no_return().
32start() ->
33    register(erts_code_purger, self()),
34    process_flag(trap_exit, true),
35    wait_for_request().
36
37wait_for_request() ->
38    handle_request(
39      receive Msg -> Msg
40      after 60_000 ->
41              erlang:hibernate(?MODULE,wait_for_request,[])
42      end, []).
43
44handle_request({purge, Mod, From, Ref}, Reqs) when is_atom(Mod), is_pid(From) ->
45    {Res, NewReqs} = do_purge(Mod, Reqs),
46    From ! {reply, purge, Res, Ref},
47    check_requests(NewReqs);
48handle_request({soft_purge, Mod, From, Ref}, Reqs) when is_atom(Mod), is_pid(From) ->
49    {Res, NewReqs} = do_soft_purge(Mod, Reqs),
50    From ! {reply, soft_purge, Res, Ref},
51    check_requests(NewReqs);
52handle_request({finish_after_on_load, {Mod,Keep}, From, Ref}, Reqs)
53  when is_atom(Mod), is_boolean(Keep), is_pid(From) ->
54    NewReqs = do_finish_after_on_load(Mod, Keep, Reqs),
55    From ! {reply, finish_after_on_load, ok, Ref},
56    check_requests(NewReqs);
57handle_request({test_purge, Mod, From, Type, Ref}, Reqs) when is_atom(Mod), is_pid(From) ->
58    NewReqs = do_test_purge(Mod, From, Type, Ref, Reqs),
59    check_requests(NewReqs);
60handle_request(_Garbage, Reqs) ->
61    check_requests(Reqs).
62
63check_requests([]) ->
64    wait_for_request();
65check_requests([R|Rs]) ->
66    handle_request(R, Rs).
67
68%%
69%% Processes that tries to call a fun that belongs to
70%% a module that currently is being purged will end
71%% up here (pending_purge_lambda) in a suspended state.
72%% When the purge operation completes or aborts (soft
73%% purge that failed) these processes will be resumed.
74%%
75pending_purge_lambda(_Module, Fun, Args) ->
76    %%
77    %% When the process is resumed, the following
78    %% scenarios exist:
79    %% * The code that the fun refers to is still
80    %%   there due to a failed soft purge. The
81    %%   call to the fun will succeed via apply/2.
82    %% * The code was purged, and a current version
83    %%   of the module is loaded which does not
84    %%   contain this fun. The call will result
85    %%   in an exception being raised.
86    %% * The code was purged, and no current
87    %%   version of the module is loaded. An attempt
88    %%   to load the module (via the error_handler)
89    %%   will be made. This may or may not succeed.
90    %%   If the module is loaded, it may or may
91    %%   not contain the fun. The call will
92    %%   succeed if the error_handler was able
93    %%   to load the module and loaded module
94    %%   contains this fun; otherwise, an exception
95    %%   will be raised.
96    %%
97    apply(Fun, Args).
98
99%% purge(Module)
100%%  Kill all processes running code from *old* Module, and then purge the
101%%  module. Return {WasOld, DidKill}:
102%%  {false, false} there was no old module to purge
103%%  {true, false} module purged, no process killed
104%%  {true, true} module purged, at least one process killed
105
106purge(Mod) when is_atom(Mod) ->
107    Ref = make_ref(),
108    erts_code_purger ! {purge, Mod, self(), Ref},
109    receive
110	{reply, purge, Result, Ref} ->
111	    Result
112    end.
113
114do_purge(Mod, Reqs) ->
115    case erts_internal:purge_module(Mod, prepare) of
116	false ->
117	    {{false, false}, Reqs};
118	true ->
119	    {DidKill, NewReqs} = check_proc_code(erlang:processes(),
120						 Mod, true, Reqs),
121	    true = erts_internal:purge_module(Mod, complete),
122	    {{true, DidKill}, NewReqs}
123    end.
124
125%% soft_purge(Module)
126%% Purge old code only if no procs remain that run old code.
127%% Return true in that case, false if procs remain (in this
128%% case old code is not purged)
129
130soft_purge(Mod) ->
131    Ref = make_ref(),
132    erts_code_purger ! {soft_purge, Mod, self(), Ref},
133    receive
134	{reply, soft_purge, Result, Ref} ->
135	    Result
136    end.
137
138do_soft_purge(Mod, Reqs) ->
139    case erts_internal:purge_module(Mod, prepare) of
140	false ->
141	    {true, Reqs};
142	true ->
143	    {PurgeOp, NewReqs} = check_proc_code(erlang:processes(),
144						 Mod, false, Reqs),
145	    {erts_internal:purge_module(Mod, PurgeOp), NewReqs}
146    end.
147
148%% finish_after_on_load(Module, Keep)
149%% Finish after running on_load function. If Keep is false,
150%% purge the code for the on_load function.
151
152finish_after_on_load(Mod, Keep) ->
153    Ref = make_ref(),
154    erts_code_purger ! {finish_after_on_load, {Mod,Keep}, self(), Ref},
155    receive
156	{reply, finish_after_on_load, Result, Ref} ->
157	    Result
158    end.
159
160do_finish_after_on_load(Mod, Keep, Reqs) ->
161    erlang:finish_after_on_load(Mod, Keep),
162    case Keep of
163	true ->
164	    Reqs;
165	false ->
166	    case erts_internal:purge_module(Mod, prepare_on_load) of
167		false ->
168		    Reqs;
169		true ->
170		    {_DidKill, NewReqs} =
171			check_proc_code(erlang:processes(),
172					Mod, true, Reqs),
173		    true = erts_internal:purge_module(Mod, complete),
174		    NewReqs
175	    end
176    end.
177
178
179%%
180%% check_proc_code(Pids, Mod, Hard, Preqs) - Send asynchronous
181%%   requests to all processes to perform a check_process_code
182%%   operation. Each process will check their own state and
183%%   reply with the result. If 'Hard' equals
184%%   - true, processes that refer 'Mod' will be killed. If
185%%     any processes were killed true is returned; otherwise,
186%%     false.
187%%   - false, and any processes refer 'Mod', 'abort' will
188%%     be returned; otherwise, 'complete'.
189%%
190%%   We only allow ?MAX_CPC_NO_OUTSTANDING_KILLS
191%%   outstanding kills. This both in order to avoid flooding
192%%   our message queue with 'DOWN' messages and limiting the
193%%   amount of memory used to keep references to all
194%%   outstanding kills.
195%%
196
197-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10).
198
199-record(cpc_static, {hard, module, tag, purge_requests}).
200
201-record(cpc_kill, {outstanding = [],
202		   no_outstanding = 0,
203		   waiting = [],
204		   killed = false}).
205
206check_proc_code(Pids, Mod, Hard, PReqs) ->
207    Tag = erlang:make_ref(),
208    CpcS = #cpc_static{hard = Hard,
209		       module = Mod,
210		       tag = Tag,
211		       purge_requests = PReqs},
212    cpc_receive(CpcS, cpc_init(CpcS, Pids, 0), #cpc_kill{}, []).
213
214cpc_receive(#cpc_static{hard = true} = CpcS,
215	    0,
216	    #cpc_kill{outstanding = [], waiting = [], killed = Killed},
217	    PReqs) ->
218    %% No outstanding cpc requests. We did a hard check, so result is
219    %% whether or not we killed any processes...
220    cpc_result(CpcS, PReqs, Killed);
221cpc_receive(#cpc_static{hard = false} = CpcS, 0, _KillState, PReqs) ->
222    %% No outstanding cpc requests and we did a soft check that succeeded...
223    cpc_result(CpcS, PReqs, complete);
224cpc_receive(#cpc_static{tag = Tag} = CpcS, NoReq, KillState0, PReqs) ->
225    receive
226	{check_process_code, {Tag, _Pid}, false} ->
227	    %% Process not referring the module; done with this process...
228	    cpc_receive(CpcS, NoReq-1, KillState0, PReqs);
229	{check_process_code, {Tag, Pid}, true} ->
230	    %% Process referring the module...
231	    case CpcS#cpc_static.hard of
232		false ->
233		    %% ... and soft check. The whole operation failed so
234		    %% no point continuing; fail straight away. Garbage
235		    %% messages from this session will be ignored
236		    %% by following sessions...
237		    cpc_result(CpcS, PReqs, abort);
238		true ->
239		    %% ... and hard check; schedule kill of it...
240		    KillState1 = cpc_sched_kill(Pid, KillState0),
241		    cpc_receive(CpcS, NoReq-1, KillState1, PReqs)
242	    end;
243	{'DOWN', MonRef, process, _, _} ->
244	    KillState1 = cpc_handle_down(MonRef, KillState0),
245	    cpc_receive(CpcS, NoReq, KillState1, PReqs);
246	PReq when element(1, PReq) == purge;
247		  element(1, PReq) == soft_purge;
248		  element(1, PReq) == test_purge ->
249	    %% A new purge request; save it until later...
250	    cpc_receive(CpcS, NoReq, KillState0, [PReq | PReqs]);
251	_Garbage ->
252	    %% Garbage message; ignore it...
253	    cpc_receive(CpcS, NoReq, KillState0, PReqs)
254    end.
255
256cpc_result(#cpc_static{purge_requests = PReqs}, NewPReqs, Res) ->
257    {Res, PReqs ++ cpc_reverse(NewPReqs)}.
258
259cpc_reverse([_] = L) -> L;
260cpc_reverse(Xs) -> cpc_reverse(Xs, []).
261
262cpc_reverse([], Ys) -> Ys;
263cpc_reverse([X|Xs], Ys) -> cpc_reverse(Xs, [X|Ys]).
264
265cpc_handle_down(R, #cpc_kill{outstanding = Rs,
266			     no_outstanding = N} = KillState0) ->
267    try
268	NewOutst = cpc_list_rm(R, Rs),
269	KillState1 = KillState0#cpc_kill{outstanding = NewOutst,
270					 no_outstanding = N-1},
271	cpc_sched_kill_waiting(KillState1)
272    catch
273	throw : undefined -> %% Triggered by garbage message...
274	    KillState0
275    end.
276
277cpc_list_rm(_R, []) ->
278    throw(undefined);
279cpc_list_rm(R, [R|Rs]) ->
280    Rs;
281cpc_list_rm(R0, [R1|Rs]) ->
282    [R1|cpc_list_rm(R0, Rs)].
283
284cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) ->
285    KillState;
286cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs,
287				 no_outstanding = N,
288				 waiting = [P|Ps]} = KillState) ->
289    R = erlang:monitor(process, P),
290    exit(P, kill),
291    KillState#cpc_kill{outstanding = [R|Rs],
292		       no_outstanding = N+1,
293		       waiting = Ps,
294		       killed = true}.
295
296cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState)
297  when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS ->
298    KillState#cpc_kill{waiting = [Pid|Pids]};
299cpc_sched_kill(Pid,
300	       #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) ->
301    R = erlang:monitor(process, Pid),
302    exit(Pid, kill),
303    KillState#cpc_kill{outstanding = [R|Rs],
304		       no_outstanding = N+1,
305		       killed = true}.
306
307cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid) ->
308    erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid}}]).
309
310cpc_init(_CpcS, [], NoReqs) ->
311    NoReqs;
312cpc_init(CpcS, [Pid|Pids], NoReqs) ->
313    cpc_request(CpcS, Pid),
314    cpc_init(CpcS, Pids, NoReqs+1).
315
316% end of check_proc_code() implementation.
317
318%%
319%% FOR TESTING ONLY
320%%
321%% do_test_purge() is for testing only. The purge is done
322%% as usual, but the tester can control when to enter the
323%% specific phases.
324%%
325do_test_purge(Mod, From, true, Ref, Reqs) ->
326    {Res, NewReqs} = do_test_hard_purge(Mod, From, Ref, Reqs),
327    From ! {test_purge, Res, Ref},
328    NewReqs;
329do_test_purge(Mod, From, false, Ref, Reqs) ->
330    {Res, NewReqs} = do_test_soft_purge(Mod, From, Ref, Reqs),
331    From ! {test_purge, Res, Ref},
332    NewReqs;
333do_test_purge(_, _, _, _, Reqs) ->
334    Reqs.
335
336do_test_soft_purge(Mod, From, Ref, Reqs) ->
337    PrepRes = erts_internal:purge_module(Mod, prepare),
338    TestRes = test_progress(started, From, Ref, ok),
339    case PrepRes of
340	false ->
341	    _ = test_progress(continued, From, Ref, TestRes),
342	    {true, Reqs};
343	true ->
344	    {PurgeOp, NewReqs} = check_proc_code(erlang:processes(),
345						 Mod, false, Reqs),
346	    _ = test_progress(continued, From, Ref, TestRes),
347	    {erts_internal:purge_module(Mod, PurgeOp), NewReqs}
348    end.
349
350do_test_hard_purge(Mod, From, Ref, Reqs) ->
351    PrepRes = erts_internal:purge_module(Mod, prepare),
352    TestRes = test_progress(started, From, Ref, ok),
353    case PrepRes of
354	false ->
355	    _ = test_progress(continued, From, Ref, TestRes),
356	    {{false, false}, Reqs};
357	true ->
358	    {DidKill, NewReqs} = check_proc_code(erlang:processes(),
359						 Mod, true, Reqs),
360	    _ = test_progress(continued, From, Ref, TestRes),
361	    true = erts_internal:purge_module(Mod, complete),
362	    {{true, DidKill}, NewReqs}
363    end.
364
365test_progress(_State, _From, _Ref, died) ->
366    %% Test process died; continue so we wont
367    %% leave the system in an inconsistent
368    %% state...
369    died;
370test_progress(started, From, Ref, ok) ->
371    From ! {started, Ref},
372    Mon = erlang:monitor(process, From),
373    receive
374	{'DOWN', Mon, process, From, _} -> died;
375	{continue, Ref} -> erlang:demonitor(Mon, [flush]), ok
376    end;
377test_progress(continued, From, Ref, ok) ->
378    From ! {continued, Ref},
379    Mon = erlang:monitor(process, From),
380    receive
381	{'DOWN', Mon, process, From, _} -> died;
382	{complete, Ref} -> erlang:demonitor(Mon, [flush]), ok
383    end.
384
385