1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 2008-2013. All Rights Reserved.
    5: %%
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %%
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %%
   17: %% %CopyrightEnd%
   18: %%
   19: 
   20: -module(z_SUITE).
   21: 
   22: %%
   23: %% This suite expects to be run as the last suite of all suites.
   24: %%
   25: 
   26: %-define(line_trace, 1).
   27: 
   28: -include_lib("kernel/include/file.hrl").
   29: 	    
   30: -record(core_search_conf, {search_dir,
   31: 			   extra_search_dir,
   32: 			   cerl,
   33: 			   file,
   34: 			   run_by_ts}).
   35: 
   36: -define(DEFAULT_TIMEOUT, ?t:minutes(5)).
   37: 
   38: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   39: 	 init_per_group/2,end_per_group/2, 
   40: 	 init_per_testcase/2, end_per_testcase/2]).
   41: 
   42: -export([search_for_core_files/1, core_files/1]).
   43: 
   44: -include_lib("common_test/include/ct.hrl").
   45:     
   46: 
   47: init_per_testcase(Case, Config) ->
   48:     Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
   49:     [{testcase, Case}, {watchdog, Dog} |Config].
   50: 
   51: end_per_testcase(_Case, Config) ->
   52:     Dog = ?config(watchdog, Config),
   53:     ?t:timetrap_cancel(Dog),
   54:     ok.
   55: 
   56: suite() -> [{ct_hooks,[ts_install_cth]}].
   57: 
   58: all() -> 
   59:     [core_files].
   60: 
   61: groups() -> 
   62:     [].
   63: 
   64: init_per_suite(Config) ->
   65:     Config.
   66: 
   67: end_per_suite(_Config) ->
   68:     ok.
   69: 
   70: init_per_group(_GroupName, Config) ->
   71:     Config.
   72: 
   73: end_per_group(_GroupName, Config) ->
   74:     Config.
   75: 
   76: 
   77: 
   78: core_files(doc) ->
   79:     [];
   80: core_files(suite) ->
   81:     [];
   82: core_files(Config) when is_list(Config) ->
   83:     case os:type() of
   84: 	{win32, _} ->
   85: 	    {skipped, "No idea searching for core-files on windows"};
   86: 	{unix, darwin} ->
   87: 	    core_file_search(
   88: 	      core_search_conf(true,
   89: 			       os:getenv("OTP_DAILY_BUILD_TOP_DIR"),
   90: 			       "/cores"));
   91: 	_ ->
   92: 	    core_file_search(
   93: 	      core_search_conf(true,
   94: 			       os:getenv("OTP_DAILY_BUILD_TOP_DIR")))
   95:     end.
   96: 
   97: search_for_core_files(Dir) ->
   98:     case os:type() of
   99: 	{win32, _} ->
  100: 	    io:format("No idea searching for core-files on windows");
  101: 	{unix, darwin} ->
  102: 	    core_file_search(core_search_conf(false, Dir, "/cores"));
  103: 	_ ->
  104: 	    core_file_search(core_search_conf(false, Dir))
  105:     end.
  106:     
  107: find_cerl(false) ->
  108:     case os:getenv("ERL_TOP") of
  109: 	false -> false;
  110: 	ETop ->
  111: 	    Cerl = filename:join([ETop, "bin", "cerl"]),
  112: 	    case filelib:is_regular(Cerl) of
  113: 		true -> Cerl;
  114: 		_ -> false
  115: 	    end
  116:     end;
  117: find_cerl(DBTop) ->
  118:     case catch filelib:wildcard(filename:join([DBTop,
  119: 					       "otp_src_R*",
  120: 					       "bin",
  121: 					       "cerl"])) of
  122: 	[Cerl | _ ] ->
  123: 	    case filelib:is_regular(Cerl) of
  124: 		true -> Cerl;
  125: 		_ -> false
  126: 	    end;
  127: 	_ ->
  128: 	    false
  129:     end.
  130: 
  131: is_dir(false) ->
  132:     false;
  133: is_dir(Dir) ->
  134:     filelib:is_dir(Dir).
  135: 
  136: core_search_conf(RunByTS, DBTop) ->
  137:     core_search_conf(RunByTS, DBTop, false).
  138: 
  139: core_search_conf(RunByTS, DBTop, XDir) ->
  140:     SearchDir = case is_dir(DBTop) of
  141: 		    false ->
  142: 			case code:which(test_server) of
  143: 			    non_existing ->
  144: 				{ok, CWD} = file:get_cwd(),
  145: 				CWD;
  146: 			    TS ->
  147: 				filename:dirname(filename:dirname(TS))
  148: 			end;
  149: 		    true ->
  150: 			DBTop
  151: 		end,
  152:     XSearchDir = case is_dir(XDir) of
  153: 		     false ->
  154: 			 false;
  155: 		     true ->
  156: 			 case SearchDir == XDir of
  157: 			     true -> false;
  158: 			     _ -> XDir
  159: 			 end
  160: 		 end,
  161:     #core_search_conf{search_dir = SearchDir,
  162: 		      extra_search_dir = XSearchDir,
  163: 		      cerl = find_cerl(DBTop),
  164: 		      file = os:find_executable("file"),
  165: 		      run_by_ts = RunByTS}.
  166: 
  167: file_inspect(#core_search_conf{file = File}, Core) ->
  168:     FRes0 = os:cmd(File ++ " " ++ Core),
  169:     FRes = case string:str(FRes0, Core) of
  170: 	       0 ->
  171: 		   FRes0;
  172: 	       S ->
  173: 		   L = length(FRes0),
  174: 		   E = length(Core),
  175: 		   case S of
  176: 		       1 ->
  177: 			   lists:sublist(FRes0, E+1, L+1);
  178: 		       _ ->
  179: 			   lists:sublist(FRes0, 1, S-1)
  180: 			       ++
  181: 			       " "
  182: 			       ++
  183: 			       lists:sublist(FRes0, E+1, L+1)
  184: 		   end
  185: 	   end,
  186:     case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of
  187: 	match ->
  188: 	    not_a_core;
  189: 	nomatch ->
  190: 	    probably_a_core
  191:     end.
  192: 
  193: mk_readable(F) ->    
  194:     try
  195: 	{ok, Old} = file:read_file_info(F),
  196: 	file:write_file_info(F, Old#file_info{mode = 8#00444})
  197:     catch	
  198: 	_:_ -> io:format("Failed to \"chmod\" core file ~p\n", [F])
  199:     end.
  200: 
  201: ignore_core(C) ->
  202:     filelib:is_regular(filename:join([filename:dirname(C),
  203: 				      "ignore_core_files"])).
  204: 
  205: core_cand(#core_search_conf{file = false}, C, Cs) ->
  206:     %% Guess that it is a core file; make it readable by anyone and save it
  207:     mk_readable(C),
  208:     [C|Cs];
  209: core_cand(Conf, C, Cs) ->
  210:     case file_inspect(Conf, C) of
  211: 	not_a_core -> Cs;
  212: 	_ ->
  213: 	    %% Probably a core file; make it readable by anyone and save it
  214: 	    mk_readable(C),
  215: 	    case ignore_core(C) of
  216: 		true -> [{ignore, C}|Cs];
  217: 		_ -> [C|Cs]
  218: 	    end
  219:     end.
  220: 
  221: time_fstr() ->
  222:     "(~w-~.2.0w-~.2.0w ~w.~.2.0w:~.2.0w)".
  223: mod_time_list(F) ->
  224:     case catch filelib:last_modified(F) of
  225: 	{{Y,Mo,D},{H,Mi,S}} ->
  226: 	    [Y,Mo,D,H,Mi,S];
  227: 	_ ->
  228: 	    [0,0,0,0,0,0]
  229:     end.
  230: 
  231: str_strip(S) ->
  232:     string:strip(string:strip(string:strip(S), both, $\n), both, $\r).
  233: 
  234: dump_core(#core_search_conf{ cerl = false }, _) ->
  235:     ok;
  236: dump_core(_, {ignore, _Core}) ->
  237:     ok;
  238: dump_core(#core_search_conf{ cerl = Cerl }, Core) ->
  239:     Dump = case test_server:is_debug() of
  240: 	       true ->
  241: 		   os:cmd(Cerl ++ " -debug -dump " ++ Core);
  242: 	       _ ->
  243: 		   os:cmd(Cerl ++ " -dump " ++ Core)
  244: 	   end,
  245:     ct:log("~s~n~n~s",[Core,Dump]).
  246: 
  247: 
  248: format_core(Conf, {ignore, Core}) ->
  249:     format_core(Conf, Core, "[ignored] ");
  250: format_core(Conf, Core) ->
  251:     format_core(Conf, Core, "").
  252: 
  253: format_core(#core_search_conf{file = false}, Core, Ignore) ->
  254:     io:format("  ~s~s " ++ time_fstr() ++ "~s~n",
  255: 	      [Ignore, Core] ++ mod_time_list(Core));
  256: format_core(#core_search_conf{file = File}, Core, Ignore) ->
  257:     FRes = str_strip(os:cmd(File ++ " " ++ Core)),
  258:     case catch re:run(FRes, Core, [caseless,{capture,none}]) of
  259: 	match ->
  260: 	    io:format("  ~s~s " ++ time_fstr() ++ "~n",
  261: 		      [Ignore, FRes] ++ mod_time_list(Core));
  262: 	_ ->
  263: 	    io:format("  ~s~s: ~s " ++ time_fstr() ++ "~n",
  264: 		      [Ignore, Core, FRes] ++ mod_time_list(Core))
  265:     end.
  266: 
  267: core_file_search(#core_search_conf{search_dir = Base,
  268: 				   extra_search_dir = XBase,
  269: 				   cerl = Cerl,
  270: 				   run_by_ts = RunByTS} = Conf) ->
  271:     case {Cerl,test_server:is_debug()} of
  272: 	{false,_} -> ok;
  273: 	{_,true} ->
  274: 	    catch io:format("A cerl script that probably can be used for "
  275: 			    "inspection of emulator cores:~n  ~s -debug~n",
  276: 			    [Cerl]);
  277: 	_ ->
  278: 	    catch io:format("A cerl script that probably can be used for "
  279: 			    "inspection of emulator cores:~n  ~s~n",
  280: 			    [Cerl])
  281:     end,
  282:     io:format("Searching for core-files in: ~s~s~n",
  283: 	      [case XBase of
  284: 		   false -> "";
  285: 		   _ -> XBase ++ " and "
  286: 	       end,
  287: 	       Base]),
  288:     Filter = fun (Core, Cores) ->
  289: 		     case filelib:is_regular(Core) of
  290: 			 true ->
  291: 			     case filename:basename(Core) of
  292: 				 "core" ->
  293: 				     core_cand(Conf, Core, Cores);
  294: 				 "core." ++ _ ->
  295: 				     core_cand(Conf, Core, Cores);
  296: 				 Bin when is_binary(Bin) -> %Icky filename; ignore
  297: 				     Cores;
  298: 				 BName ->
  299: 				     case lists:suffix(".core", BName) of
  300: 					 true -> core_cand(Conf, Core, Cores);
  301: 					 _ -> Cores
  302: 				     end
  303: 			     end;
  304: 			 _ ->
  305: 			     Cores
  306: 		     end
  307: 	     end,
  308:     case case XBase of
  309: 	     false -> [];
  310: 	     _ -> filelib:fold_files(XBase, "core", true, Filter, [])
  311: 	 end ++ filelib:fold_files(Base, "core", true, Filter, []) of
  312: 	[] ->
  313: 	    io:format("No core-files found.~n", []),
  314: 	    ok;
  315: 	Cores ->
  316: 	    io:format("Found core files:~n",[]),
  317: 	    lists:foreach(fun (C) -> format_core(Conf, C) end, Cores),
  318: 	    {ICores, FCores} = lists:foldl(fun ({ignore, IC}, {ICs, FCs}) ->
  319: 						   {[" "++IC|ICs], FCs};
  320: 					       (FC, {ICs, FCs}) ->
  321: 						   {ICs, [" "++FC|FCs]}
  322: 					   end,
  323: 					   {[],[]},
  324: 					   Cores),
  325: 	    ICoresComment =
  326: 		"Core-files marked with [ignored] were found in directories~n"
  327: 		"containing an ignore_core_files file, i.e., the testcase~n"
  328: 		"writer has decided that core-files dumped there should be~n"
  329: 		"ignored. This testcase won't fail on ignored core-files~n"
  330: 		"found.~n",
  331: 	    Res = lists:flatten([case FCores of
  332: 				     [] ->
  333: 					 [];
  334: 				     _ ->
  335: 					 ["Core-files found:",
  336: 					  lists:reverse(FCores)]
  337: 				 end,
  338: 				 case {FCores, ICores} of
  339: 				     {[], []} -> [];
  340: 				     {_, []} -> [];
  341: 				     {[], _} -> [];
  342: 				     _ -> " "
  343: 				 end,
  344: 				 case ICores of
  345: 				     [] -> [];
  346: 				     _ ->
  347: 					 io:format(ICoresComment, []),
  348: 					 ["Ignored core-files found:",
  349: 					  lists:reverse(ICores)]
  350: 				 end]),
  351: 
  352: 	    lists:foreach(fun(C) -> dump_core(Conf,C) end, Cores),
  353: 	    case {RunByTS, ICores, FCores} of
  354: 		{true, [], []} -> ok;
  355: 		{true, _, []} -> {comment, Res};
  356: 		{true, _, _} -> ?t:fail(Res);
  357: 		_ -> Res
  358: 	    end
  359:     end.