1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1998-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%%%------------------------------------------------------------------- 22%%% Purpose: Test server support functions. 23%%%------------------------------------------------------------------- 24-module(test_server_sup). 25-export([timetrap/2, timetrap/3, timetrap/4, 26 timetrap_cancel/1, capture_get/1, messages_get/1, 27 timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0, 28 cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0, 29 get_username/0, get_os_family/0, 30 hostatom/0, hostatom/1, hoststr/0, hoststr/1, 31 framework_call/2,framework_call/3,framework_call/4, 32 format_loc/1, 33 util_start/0, util_stop/0, unique_name/0, 34 call_trace/1, 35 appup_test/1]). 36-include("test_server_internal.hrl"). 37-define(crash_dump_tar,"crash_dumps.tar.gz"). 38-define(src_listing_ext, ".src.html"). 39-record(util_state, {starter, latest_name}). 40 41%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 42%% timetrap(Timeout,Scale,Pid) -> Handle 43%% Handle = term() 44%% 45%% Creates a time trap, that will kill the given process if the 46%% trap is not cancelled with timetrap_cancel/1, within Timeout 47%% milliseconds. 48%% Scale says if the time should be scaled up to compensate for 49%% delays during the test (e.g. if cover is running). 50 51timetrap(Timeout0, Pid) -> 52 timetrap(Timeout0, Timeout0, true, Pid). 53 54timetrap(Timeout0, Scale, Pid) -> 55 timetrap(Timeout0, Timeout0, Scale, Pid). 56 57timetrap(Timeout0, ReportTVal, Scale, Pid) -> 58 process_flag(priority, max), 59 ct_util:mark_process(), 60 Timeout = if not Scale -> Timeout0; 61 true -> test_server:timetrap_scale_factor() * Timeout0 62 end, 63 TruncTO = trunc(Timeout), 64 receive 65 after TruncTO -> 66 kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) 67 end. 68 69kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) -> 70 case is_process_alive(Pid) of 71 true -> 72 TimeToReport = if Timeout0 == ReportTVal -> TruncTO; 73 true -> ReportTVal end, 74 MFLs = test_server:get_loc(Pid), 75 Mon = erlang:monitor(process, Pid), 76 Trap = {timetrap_timeout,TimeToReport,MFLs}, 77 exit(Pid, Trap), 78 receive 79 {'DOWN', Mon, process, Pid, _} -> 80 ok 81 after 10000 -> 82 %% Pid is probably trapping exits, hit it harder... 83 catch error_logger:warning_msg( 84 "Testcase process ~w not " 85 "responding to timetrap " 86 "timeout:~n" 87 " ~tp.~n" 88 "Killing testcase...~n", 89 [Pid, Trap]), 90 exit(Pid, kill) 91 end; 92 false -> 93 ok 94 end. 95 96 97%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 98%% timetrap_cancel(Handle) -> ok 99%% Handle = term() 100%% 101%% Cancels a time trap. 102timetrap_cancel(Handle) -> 103 unlink(Handle), 104 MonRef = erlang:monitor(process, Handle), 105 exit(Handle, kill), 106 receive {'DOWN',MonRef,_,_,_} -> ok 107 after 108 2000 -> 109 erlang:demonitor(MonRef, [flush]), 110 ok 111 end. 112 113capture_get(Msgs) -> 114 receive 115 {captured,Msg} -> 116 capture_get([Msg|Msgs]) 117 after 0 -> 118 lists:reverse(Msgs) 119 end. 120 121messages_get(Msgs) -> 122 receive 123 Msg -> 124 messages_get([Msg|Msgs]) 125 after 0 -> 126 lists:reverse(Msgs) 127 end. 128 129timecall(M, F, A) -> 130 {Elapsed, Val} = timer:tc(M, F, A), 131 {Elapsed / 1000000, Val}. 132 133 134call_crash(Time,Crash,M,F,A) -> 135 OldTrapExit = process_flag(trap_exit,true), 136 Pid = spawn_link(M,F,A), 137 Answer = 138 receive 139 {'EXIT',Crash} -> 140 ok; 141 {'EXIT',Pid,Crash} -> 142 ok; 143 {'EXIT',_Reason} when Crash==any -> 144 ok; 145 {'EXIT',Pid,_Reason} when Crash==any -> 146 ok; 147 {'EXIT',Reason} -> 148 test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.", 149 [Crash, Reason]), 150 exit({wrong_crash_reason,Reason}); 151 {'EXIT',Pid,Reason} -> 152 test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.", 153 [Crash, Reason]), 154 exit({wrong_crash_reason,Reason}); 155 {'EXIT',OtherPid,Reason} when OldTrapExit == false -> 156 exit({'EXIT',OtherPid,Reason}) 157 after do_trunc(Time) -> 158 exit(call_crash_timeout) 159 end, 160 process_flag(trap_exit,OldTrapExit), 161 Answer. 162 163do_trunc(infinity) -> infinity; 164do_trunc(T) -> trunc(T). 165 166 167%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 168%% app_test/2 169%% 170%% Checks one applications .app file for obvious errors. 171%% Checks.. 172%% * .. required fields 173%% * .. that all modules specified actually exists 174%% * .. that all requires applications exists 175%% * .. that no module included in the application has export_all 176%% * .. that all modules in the ebin/ dir is included 177%% (This only produce a warning, as all modules does not 178%% have to be included (If the `pedantic' option isn't used)) 179app_test(Application, Mode) -> 180 case is_app(Application) of 181 {ok, AppFile} -> 182 do_app_tests(AppFile, Application, Mode); 183 Error -> 184 ct:fail(Error) 185 end. 186 187is_app(Application) -> 188 case file:consult(filename:join([code:lib_dir(Application),"ebin", 189 atom_to_list(Application)++".app"])) of 190 {ok, [{application, Application, AppFile}] } -> 191 {ok, AppFile}; 192 _ -> 193 test_server:format(minor, 194 "Application (.app) file not found, " 195 "or it has very bad syntax.~n"), 196 {error, not_an_application} 197 end. 198 199 200do_app_tests(AppFile, AppName, Mode) -> 201 DictList= 202 [ 203 {missing_fields, []}, 204 {missing_mods, []}, 205 {superfluous_mods_in_ebin, []}, 206 {export_all_mods, []}, 207 {missing_apps, []} 208 ], 209 fill_dictionary(DictList), 210 211 %% An appfile must (?) have some fields.. 212 check_fields([description, modules, registered, applications], AppFile), 213 214 %% Check for missing and extra modules. 215 {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile), 216 EBinList=lists:sort(get_ebin_modnames(AppName)), 217 {Missing, Extra} = common(lists:sort(Mods), EBinList), 218 put(superfluous_mods_in_ebin, Extra), 219 put(missing_mods, Missing), 220 221 %% Check that no modules in the application has export_all. 222 app_check_export_all(Mods), 223 224 %% Check that all specified applications exists. 225 {value, {applications, Apps}}= 226 lists:keysearch(applications, 1, AppFile), 227 check_apps(Apps), 228 229 A=check_dict(missing_fields, "Inconsistent app file, " 230 "missing fields"), 231 B=check_dict(missing_mods, "Inconsistent app file, " 232 "missing modules"), 233 C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, " 234 "Modules not included in app file.", Mode), 235 D=check_dict(export_all_mods, "Inconsistent app file, " 236 "Modules have `export_all'."), 237 E=check_dict(missing_apps, "Inconsistent app file, " 238 "missing applications."), 239 240 erase_dictionary(DictList), 241 case A+B+C+D+E of 242 5 -> 243 ok; 244 NotFive -> 245 ct:fail(NotFive) 246 end. 247 248app_check_export_all([]) -> 249 ok; 250app_check_export_all([Mod|Mods]) -> 251 case catch apply(Mod, module_info, [compile]) of 252 {'EXIT', {undef,_}} -> 253 app_check_export_all(Mods); 254 COpts -> 255 case lists:keysearch(options, 1, COpts) of 256 false -> 257 app_check_export_all(Mods); 258 {value, {options, List}} -> 259 case lists:member(export_all, List) of 260 true -> 261 put(export_all_mods, [Mod|get(export_all_mods)]), 262 app_check_export_all(Mods); 263 false -> 264 app_check_export_all(Mods) 265 end 266 end 267 end. 268 269%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 270%% appup_test/1 271%% 272%% Checks one applications .appup file for obvious errors. 273%% Checks.. 274%% * .. syntax 275%% * .. that version in app file matches appup file version 276%% * .. validity of appup instructions 277%% 278%% For library application this function checks that the proper 279%% 'restart_application' upgrade and downgrade clauses exist. 280appup_test(Application) -> 281 case is_app(Application) of 282 {ok, AppFile} -> 283 case is_appup(Application, proplists:get_value(vsn, AppFile)) of 284 {ok, Up, Down} -> 285 StartMod = proplists:get_value(mod, AppFile), 286 Modules = proplists:get_value(modules, AppFile), 287 do_appup_tests(StartMod, Application, Up, Down, Modules); 288 Error -> 289 ct:fail(Error) 290 end; 291 Error -> 292 ct:fail(Error) 293 end. 294 295is_appup(Application, Version) -> 296 AppupFile = atom_to_list(Application) ++ ".appup", 297 AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]), 298 case file:consult(AppupPath) of 299 {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) -> 300 {ok, Up, Down}; 301 _ -> 302 test_server:format( 303 minor, 304 "Application upgrade (.appup) file not found, " 305 "or it has very bad syntax.~n"), 306 {error, appup_not_readable} 307 end. 308 309do_appup_tests(undefined, Application, Up, Down, _Modules) -> 310 %% library application 311 case Up of 312 [{<<".*">>, [{restart_application, Application}]}] -> 313 case Down of 314 [{<<".*">>, [{restart_application, Application}]}] -> 315 ok; 316 _ -> 317 test_server:format( 318 minor, 319 "Library application needs restart_application " 320 "downgrade instruction.~n"), 321 {error, library_downgrade_instruction_malformed} 322 end; 323 _ -> 324 test_server:format( 325 minor, 326 "Library application needs restart_application " 327 "upgrade instruction.~n"), 328 {error, library_upgrade_instruction_malformed} 329 end; 330do_appup_tests(_, _Application, Up, Down, Modules) -> 331 %% normal application 332 case check_appup_clauses_plausible(Up, up, Modules) of 333 ok -> 334 case check_appup_clauses_plausible(Down, down, Modules) of 335 ok -> 336 test_server:format(minor, "OK~n"); 337 Error -> 338 test_server:format(minor, "ERROR ~tp~n", [Error]), 339 ct:fail(Error) 340 end; 341 Error -> 342 test_server:format(minor, "ERROR ~tp~n", [Error]), 343 ct:fail(Error) 344 end. 345 346check_appup_clauses_plausible([], _Direction, _Modules) -> 347 ok; 348check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules) 349 when is_binary(Re) -> 350 case re:compile(Re,[unicode]) of 351 {ok, _} -> 352 case check_appup_instructions(Instrs, Direction, Modules) of 353 ok -> 354 check_appup_clauses_plausible(Rest, Direction, Modules); 355 Error -> 356 Error 357 end; 358 {error, Error} -> 359 {error, {version_regex_malformed, Re, Error}} 360 end; 361check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules) 362 when is_list(V) -> 363 case check_appup_instructions(Instrs, Direction, Modules) of 364 ok -> 365 check_appup_clauses_plausible(Rest, Direction, Modules); 366 Error -> 367 Error 368 end; 369check_appup_clauses_plausible(Clause, _Direction, _Modules) -> 370 {error, {clause_malformed, Clause}}. 371 372check_appup_instructions(Instrs, Direction, Modules) -> 373 case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of 374 {_Good, []} -> 375 ok; 376 {_, Bad} -> 377 {error, {bad_instructions, Bad}} 378 end. 379 380check_instructions(_, [], _, Good, Bad, _) -> 381 {lists:reverse(Good), lists:reverse(Bad)}; 382check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) -> 383 case catch check_instruction(UpDown, Instr, All, Modules) of 384 ok -> 385 check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules); 386 {error, Reason} -> 387 NewBad = [{Instr, Reason} | Bad], 388 check_instructions(UpDown, Rest, All, Good, NewBad, Modules) 389 end. 390 391check_instruction(up, {add_module, Module}, _, Modules) -> 392 %% A new module is added 393 check_module(Module, Modules); 394check_instruction(down, {add_module, Module}, _, Modules) -> 395 %% An old module is re-added 396 case (catch check_module(Module, Modules)) of 397 {error, {unknown_module, Module, Modules}} -> ok; 398 ok -> throw({error, {existing_readded_module, Module}}) 399 end; 400check_instruction(_, {load_module, Module}, _, Modules) -> 401 check_module(Module, Modules); 402check_instruction(_, {load_module, Module, DepMods}, _, Modules) -> 403 check_module(Module, Modules), 404 check_depend(DepMods); 405check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) -> 406 check_module(Module, Modules), 407 check_depend(DepMods), 408 check_purge(Pre), 409 check_purge(Post); 410check_instruction(up, {delete_module, Module}, _, Modules) -> 411 case (catch check_module(Module, Modules)) of 412 {error, {unknown_module, Module, Modules}} -> 413 ok; 414 ok -> 415 throw({error,{existing_module_deleted, Module}}) 416 end; 417check_instruction(down, {delete_module, Module}, _, Modules) -> 418 check_module(Module, Modules); 419check_instruction(_, {update, Module}, _, Modules) -> 420 check_module(Module, Modules); 421check_instruction(_, {update, Module, supervisor}, _, Modules) -> 422 check_module(Module, Modules); 423check_instruction(_, {update, Module, DepMods}, _, Modules) 424 when is_list(DepMods) -> 425 check_module(Module, Modules); 426check_instruction(_, {update, Module, Change}, _, Modules) -> 427 check_module(Module, Modules), 428 check_change(Change); 429check_instruction(_, {update, Module, Change, DepMods}, _, Modules) -> 430 check_module(Module, Modules), 431 check_change(Change), 432 check_depend(DepMods); 433check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) -> 434 check_module(Module, Modules), 435 check_change(Change), 436 check_purge(Pre), 437 check_purge(Post), 438 check_depend(DepMods); 439check_instruction(_, 440 {update, Module, Timeout, Change, Pre, Post, DepMods}, 441 _, 442 Modules) -> 443 check_module(Module, Modules), 444 check_timeout(Timeout), 445 check_change(Change), 446 check_purge(Pre), 447 check_purge(Post), 448 check_depend(DepMods); 449check_instruction(_, 450 {update, Module, ModType, Timeout, Change, Pre, Post, DepMods}, 451 _, 452 Modules) -> 453 check_module(Module, Modules), 454 check_mod_type(ModType), 455 check_timeout(Timeout), 456 check_change(Change), 457 check_purge(Pre), 458 check_purge(Post), 459 check_depend(DepMods); 460check_instruction(_, {restart_application, Application}, _, _) -> 461 check_application(Application); 462check_instruction(_, {remove_application, Application}, _, _) -> 463 check_application(Application); 464check_instruction(_, {add_application, Application}, _, _) -> 465 check_application(Application); 466check_instruction(_, {add_application, Application, Type}, _, _) -> 467 check_application(Application), 468 check_restart_type(Type); 469check_instruction(_, Instr, _, _) -> 470 throw({error, {low_level_or_invalid_instruction, Instr}}). 471 472check_module(Module, Modules) -> 473 case {is_atom(Module), lists:member(Module, Modules)} of 474 {true, true} -> ok; 475 {true, false} -> throw({error, {unknown_module, Module}}); 476 {false, _} -> throw({error, {bad_module, Module}}) 477 end. 478 479check_application(App) -> 480 case is_atom(App) of 481 true -> ok; 482 false -> throw({error, {bad_application, App}}) 483 end. 484 485check_depend(Dep) when is_list(Dep) -> ok; 486check_depend(Dep) -> throw({error, {bad_depend, Dep}}). 487 488check_restart_type(permanent) -> ok; 489check_restart_type(transient) -> ok; 490check_restart_type(temporary) -> ok; 491check_restart_type(load) -> ok; 492check_restart_type(none) -> ok; 493check_restart_type(Type) -> throw({error, {bad_restart_type, Type}}). 494 495check_timeout(T) when is_integer(T), T > 0 -> ok; 496check_timeout(default) -> ok; 497check_timeout(infinity) -> ok; 498check_timeout(T) -> throw({error, {bad_timeout, T}}). 499 500check_mod_type(static) -> ok; 501check_mod_type(dynamic) -> ok; 502check_mod_type(Type) -> throw({error, {bad_mod_type, Type}}). 503 504check_purge(soft_purge) -> ok; 505check_purge(brutal_purge) -> ok; 506check_purge(Purge) -> throw({error, {bad_purge, Purge}}). 507 508check_change(soft) -> ok; 509check_change({advanced, _}) -> ok; 510check_change(Change) -> throw({error, {bad_change, Change}}). 511 512%% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1}, 513%% NotInL2 is the elements of L1 which don't occurr in L2, 514%% NotInL1 is the elements of L2 which don't ocurr in L1. 515 516common(L1, L2) -> 517 common(L1, L2, [], []). 518 519common([X|Rest1], [X|Rest2], A1, A2) -> 520 common(Rest1, Rest2, A1, A2); 521common([X|Rest1], [Y|Rest2], A1, A2) when X < Y -> 522 common(Rest1, [Y|Rest2], [X|A1], A2); 523common([X|Rest1], [Y|Rest2], A1, A2) -> 524 common([X|Rest1], Rest2, A1, [Y|A2]); 525common([], L, A1, A2) -> 526 {A1, L++A2}; 527common(L, [], A1, A2) -> 528 {L++A1, A2}. 529 530check_apps([]) -> 531 ok; 532check_apps([App|Apps]) -> 533 case is_app(App) of 534 {ok, _AppFile} -> 535 ok; 536 {error, _} -> 537 put(missing_apps, [App|get(missing_apps)]) 538 end, 539 check_apps(Apps). 540 541check_fields([], _AppFile) -> 542 ok; 543check_fields([L|Ls], AppFile) -> 544 check_field(L, AppFile), 545 check_fields(Ls, AppFile). 546 547check_field(FieldName, AppFile) -> 548 case lists:keymember(FieldName, 1, AppFile) of 549 true -> 550 ok; 551 false -> 552 put(missing_fields, [FieldName|get(missing_fields)]), 553 ok 554 end. 555 556check_dict(Dict, Reason) -> 557 case get(Dict) of 558 [] -> 559 1; % All ok. 560 List -> 561 io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]), 562 0 563 end. 564 565check_dict_tolerant(Dict, Reason, Mode) -> 566 case get(Dict) of 567 [] -> 568 1; % All ok. 569 List -> 570 io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]), 571 case Mode of 572 pedantic -> 573 0; 574 _ -> 575 1 576 end 577 end. 578 579get_ebin_modnames(AppName) -> 580 Wc=filename:join([code:lib_dir(AppName),"ebin", 581 "*"++code:objfile_extension()]), 582 TheFun=fun(X, Acc) -> 583 [list_to_atom(filename:rootname( 584 filename:basename(X)))|Acc] end, 585 _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)). 586 587%% 588%% This function removes any erl_crash_dump* files found in the 589%% test server directory. Done only once when the test server 590%% is started. 591%% 592cleanup_crash_dumps() -> 593 Dir = crash_dump_dir(), 594 Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), 595 delete_files(Dumps). 596 597crash_dump_dir() -> 598 %% If no framework is known, then we use current working directory 599 %% - in most cases that will be the same as the default log 600 %% directory. 601 {ok,Dir} = test_server_sup:framework_call(get_log_dir,[],file:get_cwd()), 602 Dir. 603 604tar_crash_dumps() -> 605 Dir = crash_dump_dir(), 606 case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of 607 [] -> {error,no_crash_dumps}; 608 Dumps -> 609 TarFileName = filename:join(Dir,?crash_dump_tar), 610 {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]), 611 lists:foreach( 612 fun(File) -> 613 ok = erl_tar:add(Tar,File,filename:basename(File),[]) 614 end, 615 Dumps), 616 ok = erl_tar:close(Tar), 617 delete_files(Dumps), 618 {ok,TarFileName} 619 end. 620 621 622check_new_crash_dumps() -> 623 Dir = crash_dump_dir(), 624 Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")), 625 case length(Dumps) of 626 0 -> 627 ok; 628 Num -> 629 test_server_ctrl:format(minor, 630 "Found ~w crash dumps:~n", [Num]), 631 append_files_to_logfile(Dumps), 632 delete_files(Dumps) 633 end. 634 635append_files_to_logfile([]) -> ok; 636append_files_to_logfile([File|Files]) -> 637 NodeName=from($., File), 638 test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]), 639 Fd=get(test_server_minor_fd), 640 case file:read_file(File) of 641 {ok, Bin} -> 642 case file:write(Fd, Bin) of 643 ok -> 644 ok; 645 {error,Error} -> 646 %% Write failed. The following io:format/3 will probably also 647 %% fail, but in that case it will throw an exception so that 648 %% we will be aware of the problem. 649 io:format(Fd, "Unable to write the crash dump " 650 "to this file: ~tp~n", [file:format_error(Error)]) 651 end; 652 _Error -> 653 io:format(Fd, "Failed to read: ~ts\n", [File]) 654 end, 655 append_files_to_logfile(Files). 656 657delete_files([]) -> ok; 658delete_files([File|Files]) -> 659 io:format("Deleting file: ~ts~n", [File]), 660 case file:delete(File) of 661 {error, _} -> 662 case file:rename(File, File++".old") of 663 {error, Error} -> 664 io:format("Could neither delete nor rename file " 665 "~ts: ~ts.~n", [File, Error]); 666 _ -> 667 ok 668 end; 669 _ -> 670 ok 671 end, 672 delete_files(Files). 673 674 675%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 676%% erase_dictionary(Vars) -> ok 677%% Vars = [atom(),...] 678%% 679%% Takes a list of dictionary keys, KeyVals, erases 680%% each key and returns ok. 681erase_dictionary([{Var, _Val}|Vars]) -> 682 erase(Var), 683 erase_dictionary(Vars); 684erase_dictionary([]) -> 685 ok. 686 687%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 688%% fill_dictionary(KeyVals) -> void() 689%% KeyVals = [{atom(),term()},...] 690%% 691%% Takes each Key-Value pair, and inserts it in the process dictionary. 692fill_dictionary([{Var,Val}|Vars]) -> 693 put(Var,Val), 694 fill_dictionary(Vars); 695fill_dictionary([]) -> 696 []. 697 698 699 700%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 701%% get_username() -> UserName 702%% 703%% Returns the current user 704get_username() -> 705 getenv_any(["USER","USERNAME"]). 706 707getenv_any([Key|Rest]) -> 708 case catch os:getenv(Key) of 709 String when is_list(String) -> String; 710 false -> getenv_any(Rest) 711 end; 712getenv_any([]) -> "". 713 714 715%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 716%% get_os_family() -> OsFamily 717%% 718%% Returns the OS family 719get_os_family() -> 720 {OsFamily,_OsName} = os:type(), 721 OsFamily. 722 723 724%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 725%% hostatom()/hostatom(Node) -> Host; atom() 726%% hoststr() | hoststr(Node) -> Host; string() 727%% 728%% Returns the OS family 729hostatom() -> 730 hostatom(node()). 731hostatom(Node) -> 732 list_to_atom(hoststr(Node)). 733hoststr() -> 734 hoststr(node()). 735hoststr(Node) when is_atom(Node) -> 736 hoststr(atom_to_list(Node)); 737hoststr(Node) when is_list(Node) -> 738 from($@, Node). 739 740from(H, [H | T]) -> T; 741from(H, [_ | T]) -> from(H, T); 742from(_H, []) -> []. 743 744 745%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 746%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn 747%% 748%% Calls the given Func in Callback 749framework_call(Func,Args) -> 750 framework_call(Func,Args,ok). 751framework_call(Func,Args,DefaultReturn) -> 752 CB = os:getenv("TEST_SERVER_FRAMEWORK"), 753 framework_call(CB,Func,Args,DefaultReturn). 754framework_call(FW,_Func,_Args,DefaultReturn) 755 when FW =:= false; FW =:= "undefined" -> 756 DefaultReturn; 757framework_call(Callback,Func,Args,DefaultReturn) -> 758 Mod = list_to_atom(Callback), 759 _ = case code:is_loaded(Mod) of 760 false -> code:load_file(Mod); 761 _ -> ok 762 end, 763 case erlang:function_exported(Mod,Func,length(Args)) of 764 true -> 765 EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end, 766 SetTcState = case Func of 767 end_tc -> true; 768 init_tc -> true; 769 _ -> false 770 end, 771 case SetTcState of 772 true -> 773 test_server:set_tc_state({framework,{Mod,Func,Args}}); 774 false -> 775 ok 776 end, 777 ct_util:mark_process(), 778 try apply(Mod,Func,Args) of 779 Result -> 780 Result 781 catch 782 exit:Why -> 783 EH(Why); 784 error:Why:Stacktrace -> 785 EH({Why,Stacktrace}); 786 throw:Why -> 787 EH(Why) 788 end; 789 false -> 790 DefaultReturn 791 end. 792 793 794%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 795%% format_loc(Loc) -> string() 796%% 797%% Formats the printout of the line of code read from 798%% process dictionary (test_server_loc). Adds link to 799%% correct line in source code. 800format_loc([{Mod,Func,Line}]) -> 801 [format_loc1({Mod,Func,Line})]; 802format_loc([{Mod,Func,Line}|Rest]) -> 803 ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; 804format_loc([{Mod,LineOrFunc}]) -> 805 format_loc({Mod,LineOrFunc}); 806format_loc({Mod,Func}) when is_atom(Func) -> 807 io_lib:format("{~w,~tw}",[Mod,Func]); 808format_loc(Loc) -> 809 io_lib:format("~tp",[Loc]). 810 811format_loc1([{Mod,Func,Line}]) -> 812 [" ",format_loc1({Mod,Func,Line}),"]"]; 813format_loc1([{Mod,Func,Line}|Rest]) -> 814 [" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)]; 815format_loc1({Mod,Func,Line}) -> 816 ModStr = atom_to_list(Mod), 817 case {lists:member(no_src, get(test_server_logopts)), 818 lists:reverse(ModStr)} of 819 {false,[$E,$T,$I,$U,$S,$_|_]} -> 820 Link = if is_integer(Line) -> 821 integer_to_list(Line); 822 Line == last_expr -> 823 list_to_atom(atom_to_list(Func)++"-last_expr"); 824 is_atom(Line) -> 825 atom_to_list(Line); 826 true -> 827 Line 828 end, 829 io_lib:format("{~w,~tw,<a href=\"~ts~ts#~ts\">~tw</a>}", 830 [Mod,Func, 831 test_server_ctrl:uri_encode(downcase(ModStr)), 832 ?src_listing_ext,Link,Line]); 833 _ -> 834 io_lib:format("{~w,~tw,~tw}",[Mod,Func,Line]) 835 end. 836 837downcase(S) -> downcase(S, []). 838downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z -> 839 downcase(Rest, [Uc-$A+$a|Result]); 840downcase([C|Rest], Result) -> 841 downcase(Rest, [C|Result]); 842downcase([], Result) -> 843 lists:reverse(Result). 844 845%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 846%% util_start() -> ok 847%% 848%% Start local utility process 849util_start() -> 850 Starter = self(), 851 case whereis(?MODULE) of 852 undefined -> 853 spawn_link(fun() -> 854 register(?MODULE, self()), 855 put(app, common_test), 856 util_loop(#util_state{starter=Starter}) 857 end), 858 ok; 859 _Pid -> 860 ok 861 end. 862 863%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 864%% util_stop() -> ok 865%% 866%% Stop local utility process 867util_stop() -> 868 try (?MODULE ! {self(),stop}) of 869 _ -> 870 receive {?MODULE,stopped} -> ok 871 after 5000 -> exit(whereis(?MODULE), kill) 872 end 873 catch 874 _:_ -> 875 ok 876 end. 877 878%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 879%% unique_name() -> string() 880%% 881unique_name() -> 882 ?MODULE ! {self(),unique_name}, 883 receive {?MODULE,Name} -> Name 884 after 5000 -> exit({?MODULE,no_util_process}) 885 end. 886 887%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 888%% util_loop(State) -> ok 889%% 890util_loop(State) -> 891 receive 892 {From,unique_name} -> 893 Nr = erlang:unique_integer([positive]), 894 Name = integer_to_list(Nr), 895 if Name == State#util_state.latest_name -> 896 timer:sleep(1), 897 self() ! {From,unique_name}, 898 util_loop(State); 899 true -> 900 From ! {?MODULE,Name}, 901 util_loop(State#util_state{latest_name = Name}) 902 end; 903 {From,stop} -> 904 catch unlink(State#util_state.starter), 905 From ! {?MODULE,stopped}, 906 ok 907 end. 908 909%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 910%% call_trace(TraceSpecFile) -> ok 911%% 912%% Read terms on format {m,Mod} | {f,Mod,Func} 913%% from TraceSpecFile and enable call trace for 914%% specified functions. 915call_trace(TraceSpec) -> 916 case catch try_call_trace(TraceSpec) of 917 {'EXIT',Reason} -> 918 erlang:display(Reason), 919 exit(Reason); 920 Ok -> 921 Ok 922 end. 923 924try_call_trace(TraceSpec) -> 925 case file:consult(TraceSpec) of 926 {ok,Terms} -> 927 dbg:tracer(), 928 %% dbg:p(self(), [p, m, sos, call]), 929 dbg:p(self(), [sos, call]), 930 lists:foreach(fun({m,M}) -> 931 case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of 932 {error,What} -> exit({error,{tracing_failed,What}}); 933 _ -> ok 934 end; 935 ({f,M,F}) -> 936 case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of 937 {error,What} -> exit({error,{tracing_failed,What}}); 938 _ -> ok 939 end; 940 (Huh) -> 941 exit({error,{unrecognized_trace_term,Huh}}) 942 end, Terms), 943 ok; 944 {_,Error} -> 945 exit({error,{tracing_failed,TraceSpec,Error}}) 946 end. 947 948