1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2015-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(error_logger_h_SUITE).
21-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
22	 init_per_group/2,end_per_group/2]).
23-export([logfile/1,logfile_truncated/1,tty/1,tty_truncated/1]).
24
25%% Event handler exports.
26-export([init/1,handle_event/2,terminate/2]).
27
28-include_lib("common_test/include/ct.hrl").
29
30suite() -> [{ct_hooks,[ts_install_cth]}].
31
32all() ->
33    [logfile,logfile_truncated,tty,tty_truncated].
34
35groups() ->
36    [].
37
38init_per_suite(Config) ->
39    Config.
40
41end_per_suite(_Config) ->
42    ok.
43
44init_per_group(_GroupName, Config) ->
45    Config.
46
47end_per_group(_GroupName, Config) ->
48    Config.
49
50logfile(Config) ->
51    PrivDir = proplists:get_value(priv_dir, Config),
52    LogDir = filename:join(PrivDir, ?MODULE),
53    Log = filename:join(LogDir, "logfile.log"),
54    ok = filelib:ensure_dir(Log),
55
56    Ev = event_templates(),
57
58    do_one_logfile(Log, Ev, unlimited),
59
60    Pa = "-pa " ++ filename:dirname(code:which(?MODULE)),
61    {ok,Node} = start_node(logfile, Pa),
62    error_logger:logfile({open,Log}),
63    ok = rpc:call(Node, erlang, apply, [fun gen_events/1,[Ev]]),
64    AtNode = iolist_to_binary(["** at node ",atom_to_list(Node)," **"]),
65    timer:sleep(1000), % some time get all log events in the log
66    error_logger:logfile(close),
67    analyse_events(Log, Ev, [AtNode], unlimited),
68
69    %% Make sure that the file_io_server process has been stopped
70    [] = lists:filtermap(
71           fun(X) ->
72                   case {process_info(X, [current_function]),
73                         file:pid2name(X)} of
74                       {[{current_function, {file_io_server, _, _}}],
75                        {ok,P2N = Log}} ->
76                           {true, {X, P2N}};
77                       _ ->
78                           false
79                   end
80           end, processes()),
81
82    test_server:stop_node(Node),
83
84    cleanup(Log),
85    ok.
86
87logfile_truncated(Config) ->
88    PrivDir = proplists:get_value(priv_dir, Config),
89    LogDir = filename:join(PrivDir, ?MODULE),
90    Log = filename:join(LogDir, "logfile_truncated.log"),
91    ok = filelib:ensure_dir(Log),
92
93    Ev = event_templates(),
94
95    Depth = 20,
96    application:set_env(kernel, error_logger_format_depth, Depth),
97    try
98	do_one_logfile(Log, Ev, Depth)
99    after
100	application:unset_env(kernel, error_logger_format_depth)
101    end,
102
103    cleanup(Log),
104    ok.
105
106do_one_logfile(Log, Ev, Depth) ->
107    error_logger:logfile({open,Log}),
108    gen_events(Ev),
109    error_logger:logfile(close),
110    analyse_events(Log, Ev, [], Depth).
111
112tty(Config) ->
113    PrivDir = proplists:get_value(priv_dir, Config),
114    LogDir = filename:join(PrivDir, ?MODULE),
115    Log = filename:join(LogDir, "tty.log"),
116    ok = filelib:ensure_dir(Log),
117
118    Ev = event_templates(),
119
120    do_one_tty(Log, Ev, unlimited),
121
122    Pa = "-pa " ++ filename:dirname(code:which(?MODULE)),
123    {ok,Node} = start_node(tty, Pa),
124    tty_log_open(Log),
125    ok = rpc:call(Node, erlang, apply, [fun gen_events/1,[Ev]]),
126    tty_log_close(),
127    AtNode = iolist_to_binary(["** at node ",atom_to_list(Node)," **"]),
128    timer:sleep(1000), % some time get all log events in the log
129    analyse_events(Log, Ev, [AtNode], unlimited),
130
131    test_server:stop_node(Node),
132
133    cleanup(Log),
134    ok.
135
136tty_truncated(Config) ->
137    PrivDir = proplists:get_value(priv_dir, Config),
138    LogDir = filename:join(PrivDir, ?MODULE),
139    Log = filename:join(LogDir, "tty_truncated.log"),
140    ok = filelib:ensure_dir(Log),
141
142    Ev = event_templates(),
143
144    Depth = 20,
145    application:set_env(kernel, error_logger_format_depth, Depth),
146    try
147       do_one_tty(Log, Ev, Depth)
148    after
149	application:unset_env(kernel, error_logger_format_depth)
150    end,
151
152    cleanup(Log),
153    ok.
154
155do_one_tty(Log, Ev, Depth) ->
156    tty_log_open(Log),
157    gen_events(Ev),
158    tty_log_close(),
159    analyse_events(Log, Ev, [], Depth).
160
161tty_log_open(Log) ->
162    {ok,Fd} = file:open(Log, [write]),
163    Depth = case application:get_env(kernel, error_logger_format_depth) of
164		{ok,D} -> D;
165		_ -> unlimited
166	    end,
167    error_logger:add_report_handler(?MODULE, {Fd,Depth,latin1}),
168    Fd.
169
170tty_log_close() ->
171    error_logger:delete_report_handler(?MODULE),
172    ok.
173
174event_templates() ->
175    [{error_msg,["Pure error string\n",[]]},
176     {error_msg,["Pure error string with error ~p\n",[]]},
177     {error_msg,["Error string with ~p\n", [format]]},
178     {error_msg,["Error string with bad format ~p\n", []]},
179
180     {error_report,[error_atom]},
181     {error_report,["error string"]},
182     {error_report,[[{error_tag,value},error_value]]},
183
184     {info_msg,["Pure info string\n",[]]},
185     {info_msg,["Pure info string with error ~p\n",[]]},
186     {info_msg,["Pure string with ~p\n", [format]]},
187     {info_msg,["Pure string with bad format ~p\n", []]},
188
189     {info_report,[info_atom]},
190     {info_report,["info string"]},
191     {info_report,[[{info_tag,value},info_value]]},
192
193     {warning_msg,["Pure warning string\n",[]]},
194     {warning_msg,["Pure warning string with error ~p\n",[]]},
195     {warning_msg,["Warning string with ~p\n", [format]]},
196     {warning_msg,["Warning string with bad format ~p\n", []]},
197
198     {warning_report,[warning_atom]},
199     {warning_report,["warning string"]},
200     {warning_report,[[{warning_tag,value},warning_value]]},
201
202     %% Bigger terms.
203     {error_msg,["fairly big: ~p\n",[lists:seq(1, 128)]]},
204     {error_report,[list_to_tuple(lists:seq(1, 100))]},
205     {error_report,[lists:seq(32, 126)]},
206     {error_report,[[{tag,lists:seq(1, 64)}]]}
207    ].
208
209gen_events(Ev) ->
210    io:format("node = ~p\n", [node()]),
211    io:format("group leader = ~p\n", [group_leader()]),
212    io:format("~p\n", [error_logger:which_report_handlers()]),
213    call_error_logger(Ev),
214
215    {Pid,Ref} = spawn_monitor(fun() -> error(ouch) end),
216    receive
217	{'DOWN',Ref,process,Pid,_} ->
218	    ok
219    end,
220
221    %% The following calls with a custom type will be ignored.
222    error_logger:error_report(ignored, value),
223    error_logger:warning_report(ignored, value),
224    error_logger:info_report(ignored, value),
225    receive after 100 -> ok end,
226    ok.
227
228analyse_events(Log, Ev, AtNode, Depth) ->
229    {ok,Bin} = file:read_file(Log),
230
231    io:format("*** Contents of log file ***\n\n~s\n", [Bin]),
232
233    Lines = binary:split(Bin, <<"\n">>, [global,trim_all]),
234    io:format("~p\n", [Lines]),
235
236    Rest = match_output(Ev, Lines, AtNode, Depth),
237    io:format("~p\n", [Rest]),
238
239    [] = match_emulator_error(Rest),
240    ok.
241
242
243call_error_logger([{F,Args}|T]) ->
244    apply(error_logger, F, Args),
245    timer:sleep(10),
246    call_error_logger(T);
247call_error_logger([]) -> ok.
248
249
250match_emulator_error([Head,Second,Third,_|Lines]) ->
251    match_head(<<"ERROR">>, Head),
252    {match,[{0,_}]} = re:run(Second,
253			   "^Error in process <\\d+[.]\\d+[.]\\d+> on "
254			   "node [^ ]* with exit value:"),
255    {match,[{0,_}]} = re:run(Third, "^[{]ouch,"),
256    Lines.
257
258match_output([Item|T], Lines0, AtNode, Depth) ->
259    try match_item(Item, Lines0, AtNode, Depth) of
260	Lines ->
261	    match_output(T, Lines, AtNode, Depth)
262    catch
263	C:E:Stk ->
264	    io:format("ITEM: ~p", [Item]),
265	    io:format("LINES: ~p", [Lines0]),
266	    erlang:raise(C, E, Stk)
267    end;
268match_output([], Lines, _, _) -> Lines.
269
270match_item(Item, Lines, AtNode, Depth) ->
271    case item_type(Item) of
272	{msg,Head,Args} ->
273	    match_format(Head, Args, Lines, AtNode, Depth);
274	{report,Head,Args} ->
275	    match_term(Head, Args, Lines, AtNode, Depth)
276    end.
277
278item_type({error_msg,Args}) ->
279    {msg,<<"ERROR">>,Args};
280item_type({info_msg,Args}) ->
281    {msg,<<"INFO">>,Args};
282item_type({warning_msg,Args}) ->
283    {msg,<<"WARNING">>,Args};
284item_type({error_report,Args}) ->
285    {report,<<"ERROR">>,Args};
286item_type({info_report,Args}) ->
287    {report,<<"INFO">>,Args};
288item_type({warning_report,Args}) ->
289    {report,<<"WARNING">>,Args}.
290
291match_format(Tag, [Format,Args], [Head|Lines], AtNode, Depth) ->
292    match_head(Tag, Head),
293    Bin = try dl_format(Depth, Format, Args) of
294	      Str ->
295		  iolist_to_binary(Str)
296    catch
297	_:_ ->
298	    S = dl_format(Depth, "ERROR: ~p - ~p~n", [Format,Args]),
299	    iolist_to_binary(S)
300    end,
301    Expected0 = binary:split(Bin, <<"\n">>, [global,trim]),
302    Expected = AtNode ++ Expected0,
303    match_term_lines(Expected, Lines).
304
305match_term(Tag, [Arg], [Head|Lines], AtNode, Depth) ->
306    match_head(Tag, Head),
307    Expected0 = match_term_get_expected(Arg, Depth),
308    Expected = AtNode ++ Expected0,
309    match_term_lines(Expected, Lines).
310
311match_term_get_expected(List, Depth) when is_list(List) ->
312    Bin = try iolist_to_binary(dl_format(Depth, "~s\n", [List])) of
313	      Bin0 -> Bin0
314	  catch
315	      _:_ ->
316		  iolist_to_binary(format_rep(List, Depth))
317	  end,
318    binary:split(Bin, <<"\n">>, [global,trim]);
319match_term_get_expected(Term, Depth) ->
320    S = dl_format(Depth, "~p\n", [Term]),
321    Bin = iolist_to_binary(S),
322    binary:split(Bin, <<"\n">>, [global,trim]).
323
324format_rep([{Tag,Data}|Rep], Depth) ->
325    [dl_format(Depth, "    ~p: ~p\n", [Tag,Data])|
326     format_rep(Rep, Depth)];
327format_rep([Other|Rep], Depth) ->
328    [dl_format(Depth, "    ~p\n", [Other])|
329     format_rep(Rep, Depth)];
330format_rep([], _Depth) -> [].
331
332match_term_lines([Line|T], [Line|Lines]) ->
333    match_term_lines(T, Lines);
334match_term_lines([], Lines) -> Lines.
335
336match_head(Tag, Head) ->
337    Re = <<"^=",Tag/binary,
338	   " REPORT==== \\d\\d?-[A-Z][a-z][a-z]-\\d{4}::"
339	   "\\d\\d:\\d\\d:\\d\\d ===$">>,
340    {match,_} = re:run(Head, Re).
341
342start_node(Name, Args) ->
343    case test_server:start_node(Name, slave, [{args,Args}]) of
344	{ok,Node} ->
345	    {ok,Node};
346	Error  ->
347	    ct:fail(Error)
348    end.
349
350cleanup(File) ->
351    %% The point of this test case is not to test file operations.
352    %% Therefore ignore any failures.
353    case file:delete(File) of
354	ok ->
355	    ok;
356	{error,Error1} ->
357	    io:format("file:delete(~s) failed with error ~p",
358		      [File,Error1])
359    end,
360    Dir = filename:dirname(File),
361    case file:del_dir(Dir) of
362	ok ->
363	    ok;
364	{error,Error2} ->
365	    io:format("file:del_dir(~s) failed with error ~p",
366		      [Dir,Error2])
367    end,
368    ok.
369
370
371%% Depth-limited io_lib:format. Intentionally implemented here instead
372%% of using io_lib:scan_format/2 to avoid using the same implementation
373%% as in the error_logger handlers.
374
375dl_format(unlimited, Format, Args) ->
376    io_lib:format(Format, Args);
377dl_format(Depth, Format0, Args0) ->
378    {Format,Args} = dl_format_1(Format0, Args0, Depth, [], []),
379    io_lib:format(Format, Args).
380
381dl_format_1("~p"++Fs, [A|As], Depth, Facc, Acc) ->
382    dl_format_1(Fs, As, Depth, [$P,$~|Facc], [Depth,A|Acc]);
383dl_format_1("~w"++Fs, [A|As], Depth, Facc, Acc) ->
384    dl_format_1(Fs, As, Depth, [$W,$~|Facc], [Depth,A|Acc]);
385dl_format_1("~s"++Fs, [A|As], Depth, Facc, Acc) ->
386    dl_format_1(Fs, As, Depth, [$s,$~|Facc], [A|Acc]);
387dl_format_1([F|Fs], As, Depth, Facc, Aacc) ->
388    dl_format_1(Fs, As, Depth, [F|Facc], Aacc);
389dl_format_1([], [], _, Facc, Aacc) ->
390    {lists:reverse(Facc),lists:reverse(Aacc)}.
391
392%%%
393%%% Our own event handler. There is no way to intercept the output
394%%% from error_logger_tty_h, but we can use the same code by
395%%% calling error_logger_tty_h:write_event/2.
396%%%
397
398init({_,_,_}=St) ->
399    {ok,St}.
400
401handle_event(Event, {Fd,Depth,Enc}=St) ->
402    case error_logger_tty_h:write_event(tag_event(Event), io_lib, {Depth,Enc}) of
403	ok ->
404	    ok;
405	Str when is_list(Str) ->
406	    io:put_chars(Fd, Str)
407    end,
408    {ok,St}.
409
410terminate(_Reason, {Fd,_,_}) ->
411    ok = file:close(Fd),
412    [].
413
414tag_event(Event) ->
415    {erlang:universaltime(),Event}.
416