1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2017. 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(error_logger_tty_h).
21
22-behaviour(gen_event).
23
24%%%
25%%% A handler that can be connected to the error_logger
26%%% event handler. Writes all events formatted to stdout.
27%%%
28%%% It can only be started from error_logger:swap_handler(tty)
29%%% or error_logger:tty(true).
30%%%
31
32-export([init/1,
33	 handle_event/2, handle_call/2, handle_info/2,
34	 terminate/2, code_change/3]).
35
36-export([write_event/2,write_event/3]).
37
38-record(st,
39	{user,
40	 prev_handler,
41	 io_mod=io,
42	 depth=unlimited,
43         modifier=""}).
44
45%% This one is used when we takeover from the simple error_logger.
46init({[], {error_logger, Buf}}) ->
47    User = set_group_leader(),
48    Depth = error_logger:get_format_depth(),
49    Modifier = modifier(),
50    State = #st{user=User,prev_handler=error_logger,
51                depth=Depth,modifier=Modifier},
52    write_events(State, Buf),
53    {ok, State};
54%% This one is used if someone took over from us, and now wants to
55%% go back.
56init({[], {error_logger_tty_h, PrevHandler}}) ->
57    User = set_group_leader(),
58    {ok, #st{user=User,prev_handler=PrevHandler}};
59%% This one is used when we are started directly.
60init([]) ->
61    User = set_group_leader(),
62    Depth = error_logger:get_format_depth(),
63    Modifier = modifier(),
64    {ok, #st{user=User,prev_handler=[],depth=Depth,modifier=Modifier}}.
65
66handle_event({_Type, GL, _Msg}, State) when node(GL) =/= node() ->
67    {ok, State};
68handle_event(Event, State) ->
69    ok = do_write_event(State, tag_event(Event)),
70    {ok, State}.
71
72handle_info({'EXIT', User, _Reason},
73	    #st{user=User,prev_handler=PrevHandler}=State) ->
74    case PrevHandler of
75	[] ->
76	    remove_handler;
77	_ ->
78	    {swap_handler, install_prev, State,
79	     PrevHandler, go_back}
80    end;
81handle_info(_, State) ->
82    {ok, State}.
83
84handle_call(_Query, State) -> {ok, {error, bad_query}, State}.
85
86terminate(install_prev, _State) ->
87    [];
88terminate(_Reason, #st{prev_handler=PrevHandler}) ->
89    {error_logger_tty_h, PrevHandler}.
90
91code_change(_OldVsn, State, _Extra) ->
92    {ok, State}.
93
94%% Exported (but unoffical) API.
95write_event(Event, IoMod) ->
96    do_write_event(#st{io_mod=IoMod}, Event).
97
98write_event(Event, IoMod, {Depth, Enc}) ->
99    Modifier = modifier(Enc),
100    do_write_event(#st{io_mod=IoMod,depth=Depth,modifier=Modifier}, Event).
101
102
103%%% ------------------------------------------------------
104%%% Misc. functions.
105%%% ------------------------------------------------------
106
107set_group_leader() ->
108    case whereis(user) of
109	User when is_pid(User) ->
110	    link(User),
111	    group_leader(User,self()),
112	    User;
113	_ ->
114	    false
115    end.
116
117tag_event(Event) ->
118    {erlang:universaltime(), Event}.
119
120write_events(State, [Ev|Es]) ->
121    %% Write the events in reverse order.
122    _ = write_events(State, Es),
123    _ = do_write_event(State, Ev),
124    ok;
125write_events(_State, []) ->
126    ok.
127
128do_write_event(#st{modifier=M}=State, {Time, Event}) ->
129    case parse_event(Event,M) of
130	ignore ->
131	    ok;
132	{Title,Pid,FormatList} ->
133	    Header = header(Time, Title, M),
134	    Body = format_body(State, FormatList),
135	    AtNode = if
136			 node(Pid) =/= node() ->
137			     ["** at node ",atom_to_list(node(Pid))," **\n"];
138			 true ->
139			     []
140		     end,
141	    Str = [Header,AtNode,Body],
142	    case State#st.io_mod of
143		io_lib ->
144		    Str;
145		io ->
146		    io:put_chars(user, Str)
147	    end
148    end;
149do_write_event(_, _) ->
150    ok.
151
152format_body(#st{modifier=M}=State, [{Format,Args}|T]) ->
153    S = try format(State, Format, Args) of
154	    S0 ->
155		S0
156	catch
157	    _:_ ->
158		format(State, "ERROR: ~"++M++"p - ~"++M++"p\n", [Format,Args])
159	end,
160    [S|format_body(State, T)];
161format_body(_State, []) ->
162    [].
163
164format(#st{depth=unlimited}, Format, Args) ->
165    io_lib:format(Format, Args);
166format(#st{depth=Depth}, Format0, Args) ->
167    Format1 = io_lib:scan_format(Format0, Args),
168    Format = limit_format(Format1, Depth),
169    io_lib:build_text(Format).
170
171limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p;
172						     C0 =:= $w ->
173    C = C0 - ($a - $A),				%To uppercase.
174    #{args:=Args} = M0,
175    M = M0#{control_char:=C,args:=Args++[Depth]},
176    [M|limit_format(T, Depth)];
177limit_format([H|T], Depth) ->
178    [H|limit_format(T, Depth)];
179limit_format([], _) ->
180    [].
181
182parse_event({error, _GL, {Pid, Format, Args}},_) ->
183    {"ERROR REPORT",Pid,[{Format,Args}]};
184parse_event({info_msg, _GL, {Pid, Format, Args}},_) ->
185    {"INFO REPORT",Pid,[{Format, Args}]};
186parse_event({warning_msg, _GL, {Pid, Format, Args}},_) ->
187    {"WARNING REPORT",Pid,[{Format,Args}]};
188parse_event({error_report, _GL, {Pid, std_error, Args}},M) ->
189    {"ERROR REPORT",Pid,format_term(Args,M)};
190parse_event({info_report, _GL, {Pid, std_info, Args}},M) ->
191    {"INFO REPORT",Pid,format_term(Args,M)};
192parse_event({warning_report, _GL, {Pid, std_warning, Args}},M) ->
193    {"WARNING REPORT",Pid,format_term(Args,M)};
194parse_event(_,_) -> ignore.
195
196format_term(Term,M) when is_list(Term) ->
197    case string_p(lists:flatten(Term)) of
198	true ->
199	    [{"~"++M++"s\n",[Term]}];
200	false ->
201	    format_term_list(Term,M)
202    end;
203format_term(Term,M) ->
204    [{"~"++M++"p\n",[Term]}].
205
206format_term_list([{Tag,Data}|T],M) ->
207    [{"    ~"++M++"p: ~"++M++"p\n",[Tag,Data]}|format_term_list(T,M)];
208format_term_list([Data|T],M) ->
209    [{"    ~"++M++"p\n",[Data]}|format_term_list(T,M)];
210format_term_list([],_) ->
211    [].
212
213string_p([]) ->
214    false;
215string_p(FlatList) ->
216    io_lib:printable_list(FlatList).
217
218get_utc_config() ->
219    %% SASL utc_log configuration overrides stdlib config
220    %% in order to have uniform timestamps in log messages
221    case application:get_env(sasl, utc_log) of
222        {ok, Val} -> Val;
223        undefined ->
224            case application:get_env(stdlib, utc_log) of
225                {ok, Val} -> Val;
226                undefined -> false
227            end
228    end.
229
230header(Time, Title, M) ->
231    case get_utc_config() of
232        true ->
233            header(Time, Title, "UTC ", M);
234        _ ->
235            header(calendar:universal_time_to_local_time(Time), Title, "", M)
236    end.
237
238header({{Y,Mo,D},{H,Mi,S}}, Title, UTC, M) ->
239    io_lib:format("~n=~"++M++"s==== ~p-~s-~p::~s:~s:~s ~s===~n",
240                 [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]).
241
242t(X) when is_integer(X) ->
243    t1(integer_to_list(X));
244t(_) ->
245    "".
246t1([X]) -> [$0,X];
247t1(X)   -> X.
248
249month(1) -> "Jan";
250month(2) -> "Feb";
251month(3) -> "Mar";
252month(4) -> "Apr";
253month(5) -> "May";
254month(6) -> "Jun";
255month(7) -> "Jul";
256month(8) -> "Aug";
257month(9) -> "Sep";
258month(10) -> "Oct";
259month(11) -> "Nov";
260month(12) -> "Dec".
261
262modifier() ->
263    modifier(encoding()).
264modifier(latin1) ->
265    "";
266modifier(_) ->
267    "t".
268
269encoding() ->
270    proplists:get_value(encoding,io:getopts(),latin1).
271