1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2008-2020. 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
21-module(z_SUITE).
22
23%%
24%% This suite expects to be run as the last suite of all suites.
25%%
26
27-include_lib("kernel/include/file.hrl").
28
29-record(core_search_conf, {search_dir,
30			   extra_search_dir,
31			   cerl,
32			   file,
33			   run_by_ts}).
34
35-export([all/0, suite/0]).
36
37-export([search_for_core_files/1, core_files/1]).
38
39-include_lib("common_test/include/ct.hrl").
40
41suite() ->
42    [{ct_hooks,[ts_install_cth]},
43     {timetrap, {minutes, 10}}].
44
45all() ->
46    [core_files].
47
48core_files(Config) when is_list(Config) ->
49    case os:type() of
50	{win32, _} ->
51            win32_search(true, os:getenv("OTP_DAILY_BUILD_TOP_DIR"));
52	{unix, darwin} ->
53	    core_file_search(
54	      core_search_conf(true,
55			       os:getenv("OTP_DAILY_BUILD_TOP_DIR"),
56			       "/cores"));
57	_ ->
58	    core_file_search(
59	      core_search_conf(true,
60			       os:getenv("OTP_DAILY_BUILD_TOP_DIR")))
61    end.
62
63search_for_core_files(Dir) ->
64    case os:type() of
65	{win32, _} ->
66            win32_search(false, Dir);
67	{unix, darwin} ->
68	    core_file_search(core_search_conf(false, Dir, "/cores"));
69	_ ->
70	    core_file_search(core_search_conf(false, Dir))
71    end.
72
73find_cerl(false) ->
74    case os:getenv("ERL_TOP") of
75	false -> false;
76	ETop ->
77	    Cerl = filename:join([ETop, "bin", "cerl"]),
78	    case filelib:is_regular(Cerl) of
79		true -> Cerl;
80		_ -> false
81	    end
82    end;
83find_cerl(DBTop) ->
84    case catch filelib:wildcard(filename:join([DBTop,
85					       "otp_src_*",
86					       "bin",
87					       "cerl"])) of
88	[Cerl | _ ] ->
89	    case filelib:is_regular(Cerl) of
90		true -> Cerl;
91		_ -> find_cerl(false)
92	    end;
93	_ ->
94	    find_cerl(false)
95    end.
96
97is_dir(false) ->
98    false;
99is_dir(Dir) ->
100    filelib:is_dir(Dir).
101
102core_search_conf(RunByTS, DBTop) ->
103    core_search_conf(RunByTS, DBTop, false).
104
105core_search_conf(RunByTS, DBTop, XDir) ->
106    SearchDir = search_dir(DBTop),
107    XSearchDir = case is_dir(XDir) of
108		     false ->
109			 false;
110		     true ->
111			 case SearchDir == XDir of
112			     true -> false;
113			     _ -> XDir
114			 end
115		 end,
116    #core_search_conf{search_dir = SearchDir,
117		      extra_search_dir = XSearchDir,
118		      cerl = find_cerl(DBTop),
119		      file = os:find_executable("file"),
120		      run_by_ts = RunByTS}.
121
122search_dir(DBTop) ->
123    case is_dir(DBTop) of
124        false ->
125            case code:which(test_server) of
126                non_existing ->
127                    {ok, CWD} = file:get_cwd(),
128                    CWD;
129                TS ->
130                    filename:dirname(filename:dirname(TS))
131            end;
132        true ->
133            DBTop
134    end.
135
136file_inspect(#core_search_conf{file = File}, Core) ->
137    FRes0 = os:cmd(File ++ " " ++ Core),
138    FRes = case string:split(FRes0, Core) of
139	       [S1] -> S1;
140	       [S1,S2] -> lists:flatten(S1 ++ " " ++ S2)
141	   end,
142    case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of
143	match ->
144	    not_a_core;
145	nomatch ->
146	    probably_a_core
147    end.
148
149mk_readable(F) ->
150    try
151	{ok, Old} = file:read_file_info(F),
152	file:write_file_info(F, Old#file_info{mode = 8#00444})
153    catch
154	_:_ -> io:format("Failed to \"chmod\" core file ~p\n", [F])
155    end.
156
157ignore_core(C) ->
158    filelib:is_regular(filename:join([filename:dirname(C),
159				      "ignore_core_files"])).
160
161core_cand(#core_search_conf{file = false}, C, Cs) ->
162    %% Guess that it is a core file; make it readable by anyone and save it
163    mk_readable(C),
164    [C|Cs];
165core_cand(Conf, C, Cs) ->
166    case file_inspect(Conf, C) of
167	not_a_core -> Cs;
168	_ ->
169	    %% Probably a core file; make it readable by anyone and save it
170	    mk_readable(C),
171	    case ignore_core(C) of
172		true -> [{ignore, C}|Cs];
173		_ -> [C|Cs]
174	    end
175    end.
176
177time_fstr() ->
178    "(~w-~.2.0w-~.2.0w ~w.~.2.0w:~.2.0w)".
179mod_time_list(F) ->
180    case catch filelib:last_modified(F) of
181	{{Y,Mo,D},{H,Mi,S}} ->
182	    [Y,Mo,D,H,Mi,S];
183	_ ->
184	    [0,0,0,0,0,0]
185    end.
186
187dump_core(#core_search_conf{ cerl = false }, _) ->
188    ok;
189dump_core(_, {ignore, _Core}) ->
190    ok;
191dump_core(#core_search_conf{ cerl = Cerl }, Core) ->
192    Dump = case erlang:system_info(build_type) of
193               opt ->
194                   os:cmd(Cerl ++ " -dump " ++ Core);
195               Type ->
196		   os:cmd(lists:concat([Cerl," -",Type," -dump ",Core]))
197           end,
198    ct:log("~ts~n~n~ts",[Core,Dump]).
199
200format_core(Conf, {ignore, Core}) ->
201    format_core(Conf, Core, "[ignored] ");
202format_core(Conf, Core) ->
203    format_core(Conf, Core, ""),
204
205    %% Try print (log dir) name of offending application
206    CoreDir = filename:dirname(Core),
207    lists:foreach(fun(TestDir) ->
208			  case filelib:is_dir(filename:join(CoreDir,TestDir)) of
209			      true ->
210				  io:format("  from ~s~n", [TestDir]);
211			      false ->
212				  no
213			  end
214		  end,
215		  filelib:wildcard("*.logs", CoreDir)).
216
217format_core(#core_search_conf{file = false}, Core, Ignore) ->
218    io:format("  ~s~s " ++ time_fstr() ++ "~s~n",
219	      [Ignore, Core] ++ mod_time_list(Core));
220format_core(#core_search_conf{file = File}, Core, Ignore) ->
221    FRes = string:trim(os:cmd(File ++ " " ++ Core)),
222    case catch re:run(FRes, Core, [caseless,{capture,none}]) of
223	match ->
224	    io:format("  ~s~s " ++ time_fstr() ++ "~n",
225		      [Ignore, FRes] ++ mod_time_list(Core));
226	_ ->
227	    io:format("  ~s~s: ~s " ++ time_fstr() ++ "~n",
228		      [Ignore, Core, FRes] ++ mod_time_list(Core))
229    end.
230
231core_file_search(#core_search_conf{search_dir = Base,
232				   extra_search_dir = XBase,
233				   cerl = Cerl,
234				   run_by_ts = RunByTS} = Conf) ->
235    case {Cerl,erlang:system_info(build_type)} of
236	{false,_} -> ok;
237	{_,opt} ->
238	    catch io:format("A cerl script that probably can be used for "
239			    "inspection of emulator cores:~n  ~s~n",
240			    [Cerl]);
241	{_,Type} ->
242	    catch io:format("A cerl script that probably can be used for "
243			    "inspection of emulator cores:~n  ~s -emu_type ~p~n",
244			    [Cerl,Type])
245    end,
246
247    case os:getenv("DOCKER_BUILD_INFO") of
248        false -> ok;
249        Info ->
250            io:format(Info)
251    end,
252
253    io:format("Searching for core-files in: ~s~s~n",
254	      [case XBase of
255		   false -> "";
256		   _ -> XBase ++ " and "
257	       end,
258	       Base]),
259    Filter = fun (Core, Cores) ->
260		     case filelib:is_regular(Core) of
261			 true ->
262			     case filename:basename(Core) of
263				 "core" ->
264				     core_cand(Conf, Core, Cores);
265				 "core." ++ _ ->
266				     core_cand(Conf, Core, Cores);
267				 "vgcore." ++ _ -> % valgrind
268				     core_cand(Conf, Core, Cores);
269				 Bin when is_binary(Bin) -> %Icky filename; ignore
270				     Cores;
271				 BName ->
272				     case lists:suffix(".core", BName) of
273					 true -> core_cand(Conf, Core, Cores);
274					 _ -> Cores
275				     end
276			     end;
277			 _ ->
278			     Cores
279		     end
280	     end,
281    case case XBase of
282	     false -> [];
283	     _ -> filelib:fold_files(XBase, "core", true, Filter, [])
284	 end ++ filelib:fold_files(Base, "core", true, Filter, []) of
285	[] ->
286	    io:format("No core-files found.~n", []),
287	    ok;
288	Cores ->
289	    io:format("Found core files:~n",[]),
290	    lists:foreach(fun (C) -> format_core(Conf, C) end, Cores),
291	    {ICores, FCores} = lists:foldl(fun ({ignore, IC}, {ICs, FCs}) ->
292						   {[" "++IC|ICs], FCs};
293					       (FC, {ICs, FCs}) ->
294						   {ICs, [" "++FC|FCs]}
295					   end,
296					   {[],[]},
297					   Cores),
298	    ICoresComment =
299		"Core-files marked with [ignored] were found in directories~n"
300		"containing an ignore_core_files file, i.e., the testcase~n"
301		"writer has decided that core-files dumped there should be~n"
302		"ignored. This testcase won't fail on ignored core-files~n"
303		"found.~n",
304	    Res = lists:flatten([case FCores of
305				     [] ->
306					 [];
307				     _ ->
308					 ["Core-files found:",
309					  lists:reverse(FCores)]
310				 end,
311				 case {FCores, ICores} of
312				     {[], []} -> [];
313				     {_, []} -> [];
314				     {[], _} -> [];
315				     _ -> " "
316				 end,
317				 case ICores of
318				     [] -> [];
319				     _ ->
320					 io:format(ICoresComment, []),
321					 ["Ignored core-files found:",
322					  lists:reverse(ICores)]
323				 end]),
324
325	    lists:foreach(fun(C) -> dump_core(Conf,C) end, Cores),
326	    case {RunByTS, ICores, FCores} of
327		{true, [], []} -> ok;
328		{true, _, []} -> {comment, Res};
329		{true, _, _} -> ct:fail(Res);
330		_ -> Res
331	    end
332    end.
333
334win32_search(RunByTS, DBTop) ->
335    case os:getenv("WSLENV") of
336        false when RunByTS ->
337            {skipped, "No idea searching for core-files on old windows"};
338        false ->
339            io:format("No idea searching for core-files on old windows");
340        _ ->
341            win32_search_2(RunByTS, DBTop)
342    end.
343
344win32_search_2(true, DBTop0) ->
345    DBTop = search_dir(DBTop0),
346    Dir = "c:/ldisk/daily_build",
347    io:format("Find and move 'dmp' files in: ~s to ~s~n",[Dir, DBTop]),
348    case filelib:wildcard("*.dmp", Dir) of
349        [] -> ok;
350        Dumps ->
351            %% We move the "daily" dmp files to this test-run
352            Str = lists:flatten(["Core-files found:", lists:join($\s, lists:reverse(Dumps))]),
353            Rename = fun(File) ->
354                             FP = filename:join(Dir, File),
355                             _ = file:rename(FP, filename:join(DBTop, File))
356                     end,
357            [Rename(File) || File <- Dumps],
358            ct:fail(Str)
359    end;
360win32_search_2(false, _DBTop0) ->
361    DBTop = search_dir("c:/ldisk/daily_build"),
362    io:format("Search for 'dmp' files in: ~s~n",[DBTop]),
363    case filelib:wildcard("*.dmp", DBTop) of
364        [] -> "Core-files found: Ignored core-files found:";
365        Dumps ->
366            io:format("The dmp files must be removed manually\n", []),
367            lists:flatten(["Core-files found:", lists:join($\s, lists:reverse(Dumps))])
368    end.
369