1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2019. 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(supervisor_bridge).
21
22-behaviour(gen_server).
23
24-include("logger.hrl").
25
26%% External exports
27-export([start_link/2, start_link/3]).
28%% Internal exports
29-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).
30-export([code_change/3]).
31%% logger callback
32-export([format_log/1, format_log/2]).
33
34-callback init(Args :: term()) ->
35    {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}.
36-callback terminate(Reason :: (shutdown | term()), State :: term()) ->
37    Ignored :: term().
38
39%%%-----------------------------------------------------------------
40%%% This is a rewrite of supervisor_bridge from BS.3.
41%%%
42%%% This module is built to function as process code
43%%% for a process sitting inbetween a real supervisor
44%%% and a not start&recovery complient server/system
45%%% The process inbetween simulates start&recovery
46%%% behaviour of the server/system below.
47%%%
48%%% The supervisor_bridge behaviour must export the following
49%%% functions:
50%%%    init(Args) -> {ok, Pid, State} | {error, Reason} | ignore
51%%%       where Pid is the child process
52%%%    terminate(Reason, State) -> ok
53%%%-----------------------------------------------------------------
54-record(state, {mod, pid, child_state, name}).
55
56-spec start_link(Module, Args) -> Result when
57      Module :: module(),
58      Args :: term(),
59      Result :: {ok, Pid} | ignore | {error, Error},
60      Error :: {already_started, Pid} | term(),
61      Pid :: pid().
62
63start_link(Mod, StartArgs) ->
64    gen_server:start_link(supervisor_bridge, [Mod, StartArgs, self], []).
65
66-spec start_link(SupBridgeName, Module, Args) -> Result when
67      SupBridgeName :: {local, Name} | {global, Name},
68      Name :: atom(),
69      Module :: module(),
70      Args :: term(),
71      Result :: {ok, Pid} | ignore | {error, Error},
72      Error :: {already_started, Pid} | term(),
73      Pid :: pid().
74
75start_link(Name, Mod, StartArgs) ->
76    gen_server:start_link(Name, supervisor_bridge, [Mod, StartArgs, Name], []).
77
78%%-----------------------------------------------------------------
79%% Callback functions from gen_server
80%%-----------------------------------------------------------------
81init([Mod, StartArgs, Name0]) ->
82    process_flag(trap_exit, true),
83    Name = supname(Name0, Mod),
84    case Mod:init(StartArgs) of
85	{ok, Pid, ChildState} when is_pid(Pid) ->
86	    link(Pid),
87	    report_progress(Pid, Mod, StartArgs, Name),
88	    {ok, #state{mod = Mod, pid = Pid,
89			child_state = ChildState, name = Name}};
90	ignore ->
91	    ignore;
92	{error, Reason} ->
93	    {stop, Reason}
94    end.
95
96supname(self, Mod) -> {self(),Mod};
97supname(N, _)      -> N.
98
99%% A supervisor *must* answer the supervisor:which_children call.
100handle_call(which_children, _From, State) ->
101    {reply, [], State};
102handle_call(_Req, _From, State) ->
103    {reply, {error, badcall}, State}.
104
105handle_cast(_, State) ->
106    {noreply, State}.
107
108handle_info({'EXIT', Pid, Reason}, State) when State#state.pid =:= Pid ->
109	case Reason of
110	normal ->
111	    ok;
112	shutdown ->
113	    ok;
114	{shutdown, _Term} ->
115	    ok;
116	_ ->
117	    report_error(child_terminated, Reason, State)
118	end,
119    {stop, Reason, State#state{pid = undefined}};
120handle_info(_, State) ->
121    {noreply, State}.
122
123terminate(_Reason, #state{pid = undefined}) ->
124    ok;
125terminate(Reason, State) ->
126    terminate_pid(Reason, State).
127
128code_change(_OldVsn, State, _Extra) ->
129    {ok, State}.
130
131%% This function is supposed to terminate the 'real' server.
132terminate_pid(Reason, #state{mod = Mod, child_state = ChildState}) ->
133    Mod:terminate(Reason, ChildState).
134
135report_progress(Pid, Mod, StartArgs, SupName) ->
136    ?LOG_INFO(#{label=>{supervisor,progress},
137                report=>[{supervisor, SupName},
138                         {started, [{pid, Pid},
139                                    {mfa, {Mod, init, [StartArgs]}}]}]},
140              #{domain=>[otp,sasl],
141                report_cb=>fun supervisor_bridge:format_log/2,
142                logger_formatter=>#{title=>"PROGRESS REPORT"},
143                error_logger=>#{tag=>info_report,
144                                type=>progress,
145                                report_cb=>
146                                    fun supervisor_bridge:format_log/1}}).
147
148report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) ->
149    ?LOG_ERROR(#{label=>{supervisor,error},
150                 report=>[{supervisor, Name},
151                          {errorContext, Error},
152                          {reason, Reason},
153                          {offender, [{pid, Pid}, {mod, Mod}]}]},
154               #{domain=>[otp,sasl],
155                 report_cb=>fun supervisor_bridge:format_log/2,
156                 logger_formatter=>#{title=>"SUPERVISOR REPORT"},
157                 error_logger=>#{tag=>error_report,
158                                 type=>supervisor_report,
159                                 report_cb=>
160                                     fun supervisor_bridge:format_log/1}}).
161
162%% format_log/1 is the report callback used by Logger handler
163%% error_logger only. It is kept for backwards compatibility with
164%% legacy error_logger event handlers. This function must always
165%% return {Format,Args} compatible with the arguments in this module's
166%% calls to error_logger prior to OTP-21.0.
167format_log(LogReport) ->
168    Depth = error_logger:get_format_depth(),
169    FormatOpts = #{chars_limit => unlimited,
170                   depth => Depth,
171                   single_line => false,
172                   encoding => utf8},
173    format_log_multi(limit_report(LogReport, Depth), FormatOpts).
174
175limit_report(LogReport, unlimited) ->
176    LogReport;
177limit_report(#{label:={supervisor,progress},
178               report:=[{supervisor,_}=Supervisor,{started,Child}]}=LogReport,
179             Depth) ->
180    LogReport#{report=>[Supervisor,
181                        {started,limit_child_report(Child, Depth)}]};
182limit_report(#{label:={supervisor,error},
183               report:=[{supervisor,_}=Supervisor,{errorContext,Ctxt},
184                        {reason,Reason},{offender,Child}]}=LogReport,
185             Depth) ->
186    LogReport#{report=>[Supervisor,
187                        {errorContext,io_lib:limit_term(Ctxt, Depth)},
188                        {reason,io_lib:limit_term(Reason, Depth)},
189                        {offender,io_lib:limit_term(Child, Depth)}]}.
190
191limit_child_report(ChildReport, Depth) ->
192    {mfa,{M,F,[As]}} = lists:keyfind(mfa, 1, ChildReport),
193    NewMFAs = {M,F,[io_lib:limit_term(As, Depth)]},
194    lists:keyreplace(mfa, 1, ChildReport, {mfa,NewMFAs}).
195
196%% format_log/2 is the report callback for any Logger handler, except
197%% error_logger.
198format_log(Report, FormatOpts0) ->
199    Default = #{chars_limit => unlimited,
200                depth => unlimited,
201                single_line => false,
202                encoding => utf8},
203    FormatOpts = maps:merge(Default, FormatOpts0),
204    IoOpts =
205        case FormatOpts of
206            #{chars_limit:=unlimited} ->
207                [];
208            #{chars_limit:=Limit} ->
209                [{chars_limit,Limit}]
210        end,
211    {Format,Args} = format_log_single(Report, FormatOpts),
212    io_lib:format(Format, Args, IoOpts).
213
214format_log_single(#{label:={supervisor,progress},
215                    report:=[{supervisor,SupName},{started,Child}]},
216                  #{single_line:=true,depth:=Depth}=FormatOpts) ->
217    P = p(FormatOpts),
218    {ChildFormat,ChildArgs} =
219        format_child_log_progress_single(Child, "Started:", FormatOpts),
220    Format = "Supervisor: "++P++".",
221    Args =
222        case Depth of
223            unlimited ->
224                [SupName];
225            _ ->
226                [SupName,Depth]
227        end,
228    {Format++ChildFormat,Args++ChildArgs};
229format_log_single(#{label:={supervisor,_Error},
230                    report:=[{supervisor,SupName},
231                             {errorContext,Ctxt},
232                             {reason,Reason},
233                             {offender,Child}]},
234                  #{single_line:=true,depth:=Depth}=FormatOpts) ->
235    P = p(FormatOpts),
236    Format = lists:append(["Supervisor: ",P,". Context: ",P,
237                            ". Reason: ",P,"."]),
238    {ChildFormat,ChildArgs} =
239        format_child_log_error_single(Child, "Offender:"),
240    Args =
241        case Depth of
242            unlimited ->
243                [SupName,Ctxt,Reason];
244            _ ->
245                [SupName,Depth,Ctxt,Depth,Reason,Depth]
246        end,
247    {Format++ChildFormat,Args++ChildArgs};
248format_log_single(Report, FormatOpts) ->
249    format_log_multi(Report, FormatOpts).
250
251format_log_multi(#{label:={supervisor,progress},
252                   report:=[{supervisor,SupName},
253                            {started,Child}]},
254                 #{depth:=Depth}=FormatOpts) ->
255    P = p(FormatOpts),
256    Format =
257        lists:append(
258          ["    supervisor: ",P,"~n",
259           "    started: ",P,"~n"]),
260    Args =
261        case Depth of
262            unlimited ->
263                [SupName,Child];
264            _ ->
265                [SupName,Depth,Child,Depth]
266        end,
267    {Format,Args};
268format_log_multi(#{label:={supervisor,_Error},
269                   report:=[{supervisor,SupName},
270                            {errorContext,Ctxt},
271                            {reason,Reason},
272                            {offender,Child}]},
273                 #{depth:=Depth}=FormatOpts) ->
274    P = p(FormatOpts),
275    Format =
276        lists:append(
277          ["    supervisor: ",P,"~n",
278           "    errorContext: ",P,"~n",
279           "    reason: ",P,"~n",
280           "    offender: ",P,"~n"]),
281    Args =
282        case Depth of
283            unlimited ->
284                [SupName,Ctxt,Reason,Child];
285            _ ->
286                [SupName,Depth,Ctxt,Depth,Reason,Depth,Child,Depth]
287        end,
288    {Format,Args}.
289
290format_child_log_progress_single(Child, Tag, FormatOpts) ->
291    {pid,Pid} = lists:keyfind(pid, 1, Child),
292    {mfa,MFAs} = lists:keyfind(mfa, 1, Child),
293    Args =
294        case maps:get(depth, FormatOpts) of
295            unlimited ->
296                [MFAs];
297            Depth ->
298                [MFAs, Depth]
299        end,
300    {" ~s pid=~w,mfa="++p(FormatOpts)++".",[Tag,Pid]++Args}.
301
302format_child_log_error_single(Child, Tag) ->
303    {pid,Pid} = lists:keyfind(pid, 1, Child),
304    {mod,Mod} = lists:keyfind(mod, 1, Child),
305    {" ~s pid=~w,mod=~w.",[Tag,Pid,Mod]}.
306
307p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) ->
308    "~"++single(Single)++mod(Enc)++p(Depth);
309p(unlimited) ->
310    "p";
311p(_Depth) ->
312    "P".
313
314single(true) -> "0";
315single(false) -> "".
316
317mod(latin1) -> "";
318mod(_) -> "t".
319