diff options
Diffstat (limited to 'lib')
131 files changed, 1423 insertions, 776 deletions
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 69e371a30f..fd7fa07b81 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -872,8 +872,8 @@ fail(Reason) -> try exit({test_case_failed,Reason}) catch - Class:R -> - case erlang:get_stacktrace() of + Class:R:S -> + case S of [{?MODULE,fail,1,_}|Stk] -> ok; Stk -> ok end, @@ -894,8 +894,8 @@ fail(Format, Args) -> try exit({test_case_failed,lists:flatten(Str)}) catch - Class:R -> - case erlang:get_stacktrace() of + Class:R:S -> + case S of [{?MODULE,fail,2,_}|Stk] -> ok; Stk -> ok end, diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index f0592a40be..bb33f0243b 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -233,8 +233,7 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> Rest ++ [{NewId, call_init}, {NewId,NextFun}]} end, call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks) - catch Error:Reason -> - Trace = erlang:get_stacktrace(), + catch Error:Reason:Trace -> ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp", [Error,{Reason,Trace}]), call([], {fail,"Failed to start CTH" @@ -422,8 +421,7 @@ catch_apply(M,F,A, Default, Fallback) -> catch_apply(M,F,A) -> try erlang:apply(M,F,A) - catch _:Reason -> - Trace = erlang:get_stacktrace(), + catch _:Reason:Trace -> ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp", [error,{Reason,Trace}]), throw({error_in_cth_call, diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 8c401cf3f5..afc5fee4f7 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -442,11 +442,9 @@ script_start2(Opts = #opts{vts = undefined, TestSpecData -> execute_all_specs(TestSpecData, Opts, Args, []) catch - throw:{error,Reason} -> - StackTrace = erlang:get_stacktrace(), + throw:{error,Reason}:StackTrace -> {error,{invalid_testspec,{Reason,StackTrace}}}; - _:Reason -> - StackTrace = erlang:get_stacktrace(), + _:Reason:StackTrace -> {error,{invalid_testspec,{Reason,StackTrace}}} end; [] -> @@ -1211,11 +1209,9 @@ run_spec_file(Relaxed, TestSpecData -> run_all_specs(TestSpecData, Opts, StartOpts, []) catch - throw:{error,CTReason} -> - StackTrace = erlang:get_stacktrace(), + throw:{error,CTReason}:StackTrace -> exit({error,{invalid_testspec,{CTReason,StackTrace}}}); - _:CTReason -> - StackTrace = erlang:get_stacktrace(), + _:CTReason:StackTrace -> exit({error,{invalid_testspec,{CTReason,StackTrace}}}) end. diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 10a06d5c88..e904bb1e7c 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -209,11 +209,10 @@ do_start(Parent, Mode, LogDir, Verbosity) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} catch - _:CTHReason -> + _:CTHReason:StackTrace -> ErrorInfo = if is_atom(CTHReason) -> io_lib:format("{~tp,~tp}", - [CTHReason, - erlang:get_stacktrace()]); + [CTHReason, StackTrace]); true -> CTHReason end, diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 7250041e13..9469619aa9 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -1340,13 +1340,12 @@ do_init_per_testcase(Mod, Args) -> {skip,Reason}; exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped -> {skip,Reason}; - throw:Other -> - set_loc(erlang:get_stacktrace()), + throw:Other:Stk -> + set_loc(Stk), Line = get_loc(), print_init_conf_result(Line,"thrown",Other), {skip,{failed,{Mod,init_per_testcase,Other}}}; - _:Reason0 -> - Stk = erlang:get_stacktrace(), + _:Reason0:Stk -> Reason = {Reason0,Stk}, set_loc(Stk), Line = get_loc(), @@ -1395,20 +1394,19 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> _ -> ok catch - throw:Other -> + throw:Other:Stk -> Comment0 = case read_comment() of "" -> ""; Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>", "<br />") end, - set_loc(erlang:get_stacktrace()), + set_loc(Stk), comment(io_lib:format("~ts<font color=\"red\">" "WARNING: ~w thrown!" "</font>\n",[Comment0,EndFunc])), print_end_tc_warning(EndFunc,Other,"thrown",get_loc()), {failed,{Mod,end_per_testcase,Other}}; - Class:Reason -> - Stk = erlang:get_stacktrace(), + Class:Reason:Stk -> set_loc(Stk), Why = case Class of exit -> {'EXIT',Reason}; @@ -1550,8 +1548,7 @@ ts_tc(M, F, A) -> throw:{skipped, Reason} -> {skip, Reason}; exit:{skip, Reason} -> {skip, Reason}; exit:{skipped, Reason} -> {skip, Reason}; - Type:Reason -> - Stk = erlang:get_stacktrace(), + Type:Reason:Stk -> set_loc(Stk), case Type of throw -> @@ -1740,8 +1737,8 @@ fail(Reason) -> try exit({suite_failed,Reason}) catch - Class:R -> - case erlang:get_stacktrace() of + Class:R:Stacktrace -> + case Stacktrace of [{?MODULE,fail,1,_}|Stk] -> ok; Stk -> ok end, @@ -1763,8 +1760,8 @@ fail() -> try exit(suite_failed) catch - Class:R -> - case erlang:get_stacktrace() of + Class:R:Stacktrace -> + case Stacktrace of [{?MODULE,fail,0,_}|Stk] -> ok; Stk -> ok end, @@ -2043,15 +2040,15 @@ call_user_timetrap(Func, Sup) when is_function(Func) -> try Func() of Result -> Sup ! {self(),Result} - catch _:Error -> - exit({Error,erlang:get_stacktrace()}) + catch _:Error:Stk -> + exit({Error,Stk}) end; call_user_timetrap({M,F,A}, Sup) -> try apply(M,F,A) of Result -> Sup ! {self(),Result} - catch _:Error -> - exit({Error,erlang:get_stacktrace()}) + catch _:Error:Stk -> + exit({Error,Stk}) end. save_user_timetrap(TCPid, UserTTSup, StartTime) -> diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index 6ddbf1ad27..139621141d 100644 --- a/lib/common_test/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl @@ -781,8 +781,8 @@ framework_call(Callback,Func,Args,DefaultReturn) -> catch exit:Why -> EH(Why); - error:Why -> - EH({Why,erlang:get_stacktrace()}); + error:Why:Stacktrace -> + EH({Why,Stacktrace}); throw:Why -> EH(Why) end; diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index 63bf9be134..975f6cafcb 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -231,8 +231,7 @@ data_for_channel(CM, Ch, Data, State) -> {ok, NewState} end catch - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> error_logger:error_report([{?MODULE, data_for_channel}, {request, Data}, {buffer, State#session.buffer}, diff --git a/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl index 993452500e..041c13cdbd 100644 --- a/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl +++ b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl @@ -77,7 +77,7 @@ all() -> 'fail_αβ_4'(_Config) -> ct:log("This is test case ~tw",[?FUNCTION_NAME]), - S = try throw(ok) catch throw:ok -> erlang:get_stacktrace() end, + S = try throw(ok) catch throw:ok:Stacktrace -> Stacktrace end, erlang:raise(error,{error,testcase,?FUNCTION_NAME},S), ok. diff --git a/lib/common_test/test_server/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl index 5d325b1115..35a5ec916c 100644 --- a/lib/common_test/test_server/ts_install_cth.erl +++ b/lib/common_test/test_server/ts_install_cth.erl @@ -108,8 +108,7 @@ pre_init_per_suite(_Suite,Config,State) -> {add_node_name(Config, State), State} catch error:{badmatch,{error,enoent}} -> {add_node_name(Config, State), State}; - Error:Reason -> - Stack = erlang:get_stacktrace(), + Error:Reason:Stack -> ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), {{fail,{?MODULE,{Error,Reason, Stack}}},State} end. diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 9543aa1355..47a2be8ab5 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -36,13 +36,11 @@ module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> function({function,Name,Arity,CLabel,Is0}, Blockify) -> try %% Collect basic blocks and optimize them. - Is2 = case Blockify of - true -> - Is1 = blockify(Is0), - embed_lines(Is1); - false -> - Is0 + Is1 = case Blockify of + false -> Is0; + true -> blockify(Is0) end, + Is2 = embed_lines(Is1), Is3 = local_cse(Is2), Is4 = beam_utils:anno_defs(Is3), Is5 = move_allocates(Is4), @@ -139,6 +137,11 @@ embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) -> embed_lines([{block,B1},{line,_}=Line|T], Acc) -> B = {block,[{set,[],[],Line}|B1]}, embed_lines([B|T], Acc); +embed_lines([{block,B2},{block,B1}|T], Acc) -> + %% This can only happen when beam_block is run for + %% the second time. + B = {block,B1++B2}, + embed_lines([B|T], Acc); embed_lines([I|Is], Acc) -> embed_lines(Is, [I|Acc]); embed_lines([], Acc) -> Acc. @@ -206,7 +209,7 @@ move_allocates([]) -> []. move_allocates_1([{'%anno',_}|Is], Acc) -> move_allocates_1(Is, Acc); -move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) -> +move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info0}}|Acc]=Acc0) -> case alloc_may_pass(I) of false -> move_allocates_1(Is, [I|Acc0]); @@ -215,6 +218,7 @@ move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) -> not_possible -> move_allocates_1(Is, [I|Acc0]); Live when is_integer(Live) -> + Info = safe_info(Info0), A = {set,[],[],{alloc,Live,Info}}, move_allocates_1(Is, [A,I|Acc]) end @@ -230,6 +234,13 @@ alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. +safe_info({nozero,Stack,Heap,_}) -> + %% nozero is not safe if the allocation instruction is moved + %% upwards past an instruction that may throw an exception + %% (such as element/2). + {zero,Stack,Heap,[]}; +safe_info(Info) -> Info. + %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. @@ -620,7 +631,13 @@ cse_find(Expr, Es) -> end. cse_expr({set,[D],Ss,{bif,N,_}}) -> - {ok,D,{{bif,N},Ss}}; + case D of + {fr,_} -> + %% There are too many things that can go wrong. + none; + _ -> + {ok,D,{{bif,N},Ss}} + end; cse_expr({set,[D],Ss,{alloc,_,{gc_bif,N,_}}}) -> {ok,D,{{gc_bif,N},Ss}}; cse_expr({set,[D],Ss,put_list}) -> diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index e094c2c320..7ddf9fa2e2 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -24,7 +24,7 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [foldl/3,reverse/1,filter/2]). +-import(lists, [foldl/3,reverse/1]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -303,8 +303,21 @@ maybe_remove_lines(Fs, Opts) -> end. remove_lines([{function,N,A,Lbl,Is0}|T]) -> - Is = filter(fun({line,_}) -> false; - (_) -> true - end, Is0), + Is = remove_lines_fun(Is0), [{function,N,A,Lbl,Is}|remove_lines(T)]; remove_lines([]) -> []. + +remove_lines_fun([{line,_}|Is]) -> + remove_lines_fun(Is); +remove_lines_fun([{block,Bl0}|Is]) -> + Bl = remove_lines_block(Bl0), + [{block,Bl}|remove_lines_fun(Is)]; +remove_lines_fun([I|Is]) -> + [I|remove_lines_fun(Is)]; +remove_lines_fun([]) -> []. + +remove_lines_block([{set,_,_,{line,_}}|Is]) -> + remove_lines_block(Is); +remove_lines_block([I|Is]) -> + [I|remove_lines_block(Is)]; +remove_lines_block([]) -> []. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 4045ab6dc5..c60211f516 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -73,7 +73,8 @@ norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> {put_map,F,Op,S,D,R,{list,Puts}}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; -norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}. +norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}; +norm({set,[],[],{line,_}=Line}) -> Line. norm_allocate({_Zero,nostack,Nh,[]}, Regs) -> [{test_heap,Nh,Regs}]; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index d041f18806..52dd89b5bb 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -50,8 +50,9 @@ split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); -split_block([{set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) -> - split_block(Is, [], [{bif,raise,Fail,As,R}|make_block(Bl, Acc)]); +split_block([{set,[],[],{line,_}=Line}, + {set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) -> + split_block(Is, [], [{bif,raise,Fail,As,R},Line|make_block(Bl, Acc)]); split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); @@ -61,8 +62,6 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], make_block(Bl, Acc)]); split_block([{set,[R],[],{try_catch,Op,L}}|Is], Bl, Acc) -> split_block(Is, [], [{Op,R,L}|make_block(Bl, Acc)]); -split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> - split_block(Is, [], [Line|make_block(Bl, Acc)]); split_block([I|Is], Bl, Acc) -> split_block(Is, [I|Bl], Acc); split_block([], Bl, Acc) -> make_block(Bl, Acc). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 4dcce30583..a57dbbbc2f 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -440,8 +440,11 @@ check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> case member(R, Ss) of true -> {used,St}; false -> + %% If the exception is taken, the stack may + %% be scanned. Therefore the register is not + %% guaranteed to be killed. if - R =:= Dst -> {killed,St}; + R =:= Dst -> {not_used,St}; true -> not_used(check_liveness(R, Is, St)) end end @@ -735,8 +738,8 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> end end. -check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) -> - check_liveness_block_3(R, Lbl, St); +check_liveness_block_2(R, {gc_bif,Op,{f,Lbl}}, Ss, St) -> + check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St); check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) -> Arity = length(Ss), case erl_internal:comp_op(Op, Arity) orelse @@ -744,16 +747,23 @@ check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) -> true -> {killed,St}; false -> - check_liveness_block_3(R, Lbl, St) + check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St) end; check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) -> - check_liveness_block_3(R, Lbl, St); + check_liveness_block_3(R, Lbl, {unsafe,0}, St); check_liveness_block_2(_, _, _, St) -> {killed,St}. -check_liveness_block_3(_, 0, St) -> +check_liveness_block_3({x,_}, 0, _FA, St) -> {killed,St}; -check_liveness_block_3(R, Lbl, St0) -> +check_liveness_block_3({y,_}, 0, {F,A}, St) -> + %% If the exception is thrown, the stack may be scanned, + %% thus implicitly using the y register. + case erl_bifs:is_safe(erlang, F, A) of + true -> {killed,St}; + false -> {used,St} + end; +check_liveness_block_3(R, Lbl, _FA, St0) -> check_liveness_at(R, Lbl, St0). index_labels_1([{label,Lbl}|Is0], Acc) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 7e5d86c177..9de773542e 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1349,7 +1349,12 @@ branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) Vst = branch_state(L, Vst1), branch_arities(T, Tuple, Vst#vst{current=St}). -branch_state(0, #vst{}=Vst) -> Vst; +branch_state(0, #vst{}=Vst) -> + %% If the instruction fails, the stack may be scanned + %% looking for a catch tag. Therefore the Y registers + %% must be initialized at this point. + verify_y_init(Vst), + Vst; branch_state(L, #vst{current=St,branched=B}=Vst) -> Vst#vst{ branched=case gb_trees:is_defined(L, B) of diff --git a/lib/debugger/src/dbg_debugged.erl b/lib/debugger/src/dbg_debugged.erl index e142af4ae0..8b64a60a9c 100644 --- a/lib/debugger/src/dbg_debugged.erl +++ b/lib/debugger/src/dbg_debugged.erl @@ -31,32 +31,25 @@ %% Called via the error handler. %%-------------------------------------------------------------------- eval(Mod, Func, Args) -> - SaveStacktrace = erlang:get_stacktrace(), Meta = dbg_ieval:eval(Mod, Func, Args), Mref = erlang:monitor(process, Meta), - msg_loop(Meta, Mref, SaveStacktrace). + msg_loop(Meta, Mref). %%==================================================================== %% Internal functions %%==================================================================== -msg_loop(Meta, Mref, SaveStacktrace) -> +msg_loop(Meta, Mref) -> receive %% Evaluated function has returned a value {sys, Meta, {ready, Val}} -> erlang:demonitor(Mref, [flush]), - - %% Restore original stacktrace and return the value - try erlang:raise(throw, stack, SaveStacktrace) - catch - throw:stack -> - case Val of - {dbg_apply,M,F,A} -> - apply(M, F, A); - _ -> - Val - end + case Val of + {dbg_apply,M,F,A} -> + apply(M, F, A); + _ -> + Val end; %% Evaluated function raised an (uncaught) exception @@ -74,32 +67,25 @@ msg_loop(Meta, Mref, SaveStacktrace) -> Meta ! {self(), rec_acked}, ok end, - msg_loop(Meta, Mref, SaveStacktrace); + msg_loop(Meta, Mref); %% Meta needs something evaluated within context of real process {sys, Meta, {command,Command}} -> Reply = handle_command(Command), Meta ! {sys, self(), Reply}, - msg_loop(Meta, Mref, SaveStacktrace); + msg_loop(Meta, Mref); %% Meta has terminated %% Must be due to int:stop() (or -heaven forbid- a debugger bug) {'DOWN', Mref, _, _, Reason} -> - - %% Restore original stacktrace and return a dummy value - try erlang:raise(throw, stack, SaveStacktrace) - catch - throw:stack -> - {interpreter_terminated, Reason} - end + {interpreter_terminated, Reason} end. handle_command(Command) -> try reply(Command) - catch Class:Reason -> - Stacktrace = stacktrace_f(erlang:get_stacktrace()), - {exception,{Class,Reason,Stacktrace}} + catch Class:Reason:Stacktrace -> + {exception,{Class,Reason,stacktrace_f(Stacktrace)}} end. reply({apply,M,F,As}) -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 8009d62629..b0db8228e5 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -924,8 +924,7 @@ expr({dbg,Line,raise,As0}, Bs0, #ieval{level=Le}=Ieval0) -> trace(return, {Le,Error}), {value,Error,Bs} catch - _:_ -> - Stk = erlang:get_stacktrace(), %Possibly truncated. + _:_:Stk -> %Possibly truncated. StkFun = fun(_) -> Stk end, do_exception(Class, Reason, StkFun, Bs, Ieval) end; diff --git a/lib/debugger/src/dbg_wx_mon.erl b/lib/debugger/src/dbg_wx_mon.erl index a32a6894b8..00aee62a87 100644 --- a/lib/debugger/src/dbg_wx_mon.erl +++ b/lib/debugger/src/dbg_wx_mon.erl @@ -119,9 +119,9 @@ init(CallingPid, Mode, SFile) -> init2(CallingPid, Mode, SFile, GS) catch exit:stop -> stop; - Error:Reason -> + Error:Reason:Stacktrace -> io:format("~p: Crashed {~p,~p} in~n ~p", - [?MODULE, Error, Reason, erlang:get_stacktrace()]) + [?MODULE, Error, Reason, Stacktrace]) end end. diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index b1e0e03b4c..505d53005f 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -95,9 +95,9 @@ start(Pid, Env, Parent, TraceWin, BackTrace, Strings) -> catch _:stop -> exit(stop); - E:R -> + E:R:S -> io:format("TraceWin Crashed ~p~n",[E]), - io:format(" ~p in ~p~n",[R, erlang:get_stacktrace()]), + io:format(" ~p in ~p~n",[R, S]), exit(R) end; error -> diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index 80c10183cf..f21eaed087 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -41,8 +41,8 @@ start() -> Ret catch throw:{dialyzer_cl_parse_error, Msg} -> {error, Msg}; - _:R -> - Msg = io_lib:format("~tp\n~tp\n", [R, erlang:get_stacktrace()]), + _:R:S -> + Msg = io_lib:format("~tp\n~tp\n", [R, S]), {error, lists:flatten(Msg)} end. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 384912f983..6bd3c2f9a6 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -299,7 +299,7 @@ traverse(Tree, Map, State) -> match_fail -> t_none(); raise -> t_none(); bs_init_writable -> t_from_term(<<>>); - build_stacktrace -> t_list(); + build_stacktrace -> erl_bif_types:type(erlang, build_stacktrace, 0); Other -> erlang:error({'Unsupported primop', Other}) end, {State, Map, Type}; @@ -1236,6 +1236,13 @@ handle_tuple(Tree, Map, State) -> State2 = state__add_warning(State1, ?WARN_OPAQUE, Tree, Msg), {State2, Map1, t_none()}; + {error, record, ErrorPat, ErrorType, _} -> + Msg = {record_match, + [format_patterns(ErrorPat), + format_type(ErrorType, State1)]}, + State2 = state__add_warning(State1, ?WARN_MATCHING, + Tree, Msg), + {State2, Map1, t_none()}; {Map2, ETypes} -> {State1, Map2, t_tuple(ETypes)} end diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index b1f6a54503..dede475f98 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -418,7 +418,11 @@ traverse(Tree, DefinedVars, State) -> match_fail -> throw(error); raise -> throw(error); bs_init_writable -> {State, t_from_term(<<>>)}; - build_stacktrace -> {State, t_list()}; + build_stacktrace -> + V = mk_var(Tree), + Type = erl_bif_types:type(erlang, build_stacktrace, 0), + State1 = state__store_conj(V, sub, Type, State), + {State1, V}; Other -> erlang:error({'Unsupported primop', Other}) end; 'receive' -> @@ -1896,9 +1900,8 @@ solver(Solver, SolveFun) -> ?debug("Solver ~w returned unexpected result:\n ~P\n", [Solver, _R, 60]), throw(error) - catch E:R -> - io:format("Solver ~w failed: ~w:~p\n ~tp\n", - [Solver, E, R, erlang:get_stacktrace()]), + catch E:R:S -> + io:format("Solver ~w failed: ~w:~p\n ~tp\n", [Solver, E, R, S]), throw(error) end. diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl index 16b9c8a94a..9d3d9ce438 100644 --- a/lib/dialyzer/src/typer.erl +++ b/lib/dialyzer/src/typer.erl @@ -164,9 +164,9 @@ get_type_info(#analysis{callgraph = CallGraph, CodeServer), Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt} catch - error:What -> + error:What:Stacktrace -> fatal_error(io_lib:format("Analysis failed with message: ~tp", - [{What, erlang:get_stacktrace()}])); + [{What, Stacktrace}])); throw:{dialyzer_succ_typing_error, Msg} -> fatal_error(io_lib:format("Analysis failed with message: ~ts", [Msg])) end. diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl index b16075763f..12f6532c0c 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl @@ -539,7 +539,7 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv try apply(Mod, Fun, Args) of X -> {ok, X} catch - X:Y -> {X, Y} + X:Y:S -> {{X, Y}, S} end, case Result of {ok, Z} -> @@ -551,15 +551,15 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv false -> false end; - Exception when is_function(FalsePositiveMFAs) -> + {Exception, S2} when is_function(FalsePositiveMFAs) -> case FalsePositiveMFAs(MFA, Args, Exception) of true -> true; false -> - error(Exception, erlang:get_stacktrace()) + error(Exception, S2) end; - Exception -> - error(Exception, erlang:get_stacktrace()) + {Exception, S3} -> + error(Exception, S3) end end). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl index 1677b4efb8..529f9fba72 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl @@ -533,7 +533,7 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv try apply(Mod,Fun,Args) of X -> {ok, X} catch - X:Y -> {X, Y} + X:Y:S -> {{X, Y}, S} end, case Result of {ok, Z} -> @@ -545,15 +545,15 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv false -> false end; - Exception when is_function(FalsePositiveMFAs) -> + {Exception, S2} when is_function(FalsePositiveMFAs) -> case FalsePositiveMFAs(MFA, Args, Exception) of true -> true; false -> - error(Exception, erlang:get_stacktrace()) + error(Exception, S2) end; - Exception -> - error(Exception, erlang:get_stacktrace()) + {Exception, S3} -> + error(Exception, S3) end end). diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl index 8fe43163f6..ea92613781 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl @@ -174,7 +174,7 @@ validate_error(Error, Name, Ar) -> -endif. validate_error_1(Error, Name, Ar) -> {{'_',Name,Ar}, - {internal_error,'_',{Error,erlang:get_stacktrace()}}}. + {internal_error,'_',{Error,[]}}}. -record(st, %Emulation state {x=init_regs(0, term), %x register info. diff --git a/lib/dialyzer/test/small_SUITE_data/results/record_match b/lib/dialyzer/test/small_SUITE_data/results/record_match new file mode 100644 index 0000000000..a0dd6f560a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/record_match @@ -0,0 +1,3 @@ + +record_match.erl:16: Function select/0 has no local return +record_match.erl:17: Matching of pattern {'b_literal', 'undefined'} tagged with a record name violates the declared type of #b_local{} | #b_remote{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/stacktrace b/lib/dialyzer/test/small_SUITE_data/results/stacktrace new file mode 100644 index 0000000000..fd60881953 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/stacktrace @@ -0,0 +1,5 @@ + +stacktrace.erl:11: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] +stacktrace.erl:19: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] +stacktrace.erl:44: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] +stacktrace.erl:53: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] diff --git a/lib/dialyzer/test/small_SUITE_data/src/record_match.erl b/lib/dialyzer/test/small_SUITE_data/src/record_match.erl new file mode 100644 index 0000000000..8e9b91937f --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/record_match.erl @@ -0,0 +1,17 @@ +-module(record_match). + +-export([select/0]). + +-record(b_literal, {val}). +-record(b_remote, {mod,name,arity}). +-record(b_local, {name,arity}). + +-type b_remote() :: #b_remote{}. +-type b_local() :: #b_local{}. + +-type argument() :: b_remote() | b_local(). + +-record(b_set, {args=[] :: [argument()]}). + +select() -> + #b_set{args=[#b_remote{},#b_literal{}]}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl new file mode 100644 index 0000000000..de79e710e9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl @@ -0,0 +1,73 @@ +-module(stacktrace). + +%% Check the stacktrace variable introduced in Erlang/OTP 21.0 + +-export([t1/0, t2/0, t3/0, t4/0, s1/0, s2/0, s3/0, s4/0]). + +t1() -> + try foo:bar() + catch + E:P:S -> + {a,b} = S, % can never match + {E, P} + end. + +t2() -> + try foo:bar() + catch + E:P:S -> + [a,b] = S, % can never match + {E, P} + end. + +t3() -> + try foo:bar() + catch + E:P:S -> + [{m,f,[],[]}] = S, + {E, P} + end. + +t4() -> + try foo:bar() + catch + E:P:S -> + [{m,f,1,[{file,"tjo"},{line,95}]}] = S, + {E, P} + end. + +s1() -> + try foo:bar() + catch + E:P -> + S = erlang:get_stacktrace(), + {a,b} = S, % can never match + {E, P} + end. + +s2() -> + try foo:bar() + catch + E:P -> + S = erlang:get_stacktrace(), + [a,b] = S, % can never match + {E, P} + end. + +s3() -> + try foo:bar() + catch + E:P -> + S = erlang:get_stacktrace(), + [{m,f,[],[]}] = S, + {E, P} + end. + +s4() -> + try foo:bar() + catch + E:P -> + S = erlang:get_stacktrace(), + [{m,f,1,[{file,"tjo"},{line,95}]}] = S, + {E, P} + end. diff --git a/lib/et/src/et_wx_contents_viewer.erl b/lib/et/src/et_wx_contents_viewer.erl index bca517317e..7ca41da3e8 100644 --- a/lib/et/src/et_wx_contents_viewer.erl +++ b/lib/et/src/et_wx_contents_viewer.erl @@ -93,8 +93,8 @@ start_link(Options) -> end, {ok, Pid} catch - error:Reason -> - {error, {'EXIT', Reason, erlang:get_stacktrace()}} + error:Reason:Stacktrace -> + {error, {'EXIT', Reason, Stacktrace}} end; {error, Reason} -> {error, Reason} diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index d1bd160ea1..771541354c 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -202,13 +202,13 @@ format_exception_test_() -> "\nymmud:rorre"++_, lists:reverse(lists:flatten( format_exception(try erlang:error(dummy) - catch C:R -> {C, R, erlang:get_stacktrace()} + catch C:R:S -> {C, R, S} end)))), ?_assertMatch( "\nymmud:rorre"++_, lists:reverse(lists:flatten( format_exception(try erlang:error(dummy, [a]) - catch C:R -> {C, R, erlang:get_stacktrace()} + catch C:R:S -> {C, R, S} end))))]. -endif. diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index e652c5b2f6..75aa05c543 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -137,8 +137,7 @@ call(F, As, St) when is_atom(F) -> try apply(St#state.callback, F, As) of Substate -> St#state{state = Substate} catch - Class:Term -> - Trace = erlang:get_stacktrace(), + Class:Term:Trace -> if F =/= terminate -> call(terminate, [{error, {Class, Term, Trace}}, St#state.state], St); diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index e075005238..96bdcf88b6 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -628,7 +628,7 @@ io_request({put_chars, M, F, As}, Buf) -> try apply(M, F, As) of Chars -> {ok, [Chars | Buf]} catch - C:T -> {{error, {C,T,erlang:get_stacktrace()}}, Buf} + C:T:S -> {{error, {C,T,S}}, Buf} end; io_request({put_chars, _Enc, Chars}, Buf) -> io_request({put_chars, Chars}, Buf); diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index 6036537178..6fe85ae70a 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -39,11 +39,11 @@ %% somewhat, but you can't have everything.) Note that we assume that %% this particular module is the boundary between eunit and user code. -get_stacktrace() -> - get_stacktrace([]). +get_stacktrace(Trace) -> + get_stacktrace(Trace, []). -get_stacktrace(Ts) -> - eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). +get_stacktrace(Trace, Ts) -> + eunit_lib:uniq(prune_trace(Trace, Ts)). -dialyzer({no_match, prune_trace/2}). prune_trace([{eunit_data, _, _} | Rest], Tail) -> @@ -75,8 +75,8 @@ run_testfun(F) -> {eunit_internal, Term} -> %% Internally generated: re-throw Term (lose the trace) throw(Term); - Class:Reason -> - {error, {Class, Reason, get_stacktrace()}} + Class:Reason:Trace -> + {error, {Class, Reason, Trace}} end. @@ -272,7 +272,7 @@ mf_wrapper(M, F) -> fun () -> try M:F() catch - error:undef -> + error:undef:Trace -> %% Check if it was M:F/0 that was undefined case erlang:module_loaded(M) of false -> @@ -282,14 +282,14 @@ mf_wrapper(M, F) -> false -> fail({no_such_function, {M,F,0}}); true -> - rethrow(error, undef, [{M,F,0}]) + rethrow(error, undef, Trace, [{M,F,0}]) end end end end. -rethrow(Class, Reason, Trace) -> - erlang:raise(Class, Reason, get_stacktrace(Trace)). +rethrow(Class, Reason, Trace, Ts) -> + erlang:raise(Class, Reason, get_stacktrace(Trace, Ts)). fail(Term) -> throw({eunit_internal, Term}). @@ -332,12 +332,14 @@ enter_context(Setup, Cleanup, Instantiate, Callback) -> T -> case eunit_lib:is_not_test(T) of true -> - catch throw(error), % generate a stack trace + {_, Stacktrace} = + erlang:process_info(self(), + current_stacktrace), {module,M} = erlang:fun_info(Instantiate, module), {name,N} = erlang:fun_info(Instantiate, name), {arity,A} = erlang:fun_info(Instantiate, arity), context_error({bad_instantiator, {{M,N,A},T}}, - error, badarg); + error, Stacktrace, badarg); false -> ok end, @@ -346,21 +348,22 @@ enter_context(Setup, Cleanup, Instantiate, Callback) -> %% Always run cleanup; client may be an idiot try Cleanup(R) catch - Class:Term -> - context_error(cleanup_failed, Class, Term) + Class:Term:Trace -> + context_error(cleanup_failed, + Class, Trace, Term) end end catch - Class:Term -> - context_error(instantiation_failed, Class, Term) + Class:Term:Trace -> + context_error(instantiation_failed, Class, Trace, Term) end catch - Class:Term -> - context_error(setup_failed, Class, Term) + Class:Term:Trace -> + context_error(setup_failed, Class, Trace, Term) end. -context_error(Type, Class, Term) -> - throw({context_error, Type, {Class, Term, get_stacktrace()}}). +context_error(Type, Class, Trace, Term) -> + throw({context_error, Type, {Class, Term, get_stacktrace(Trace)}}). %% This generates single setup/cleanup functions from a list of tuples %% on the form {Tag, Setup, Cleanup}, where the setup function always @@ -378,8 +381,8 @@ multi_setup([{Tag, S, C} | Es], CleanupPrev) -> try C(R) of _ -> CleanupPrev(Rs) catch - Class:Term -> - throw({Tag, {Class, Term, get_stacktrace()}}) + Class:Term:Trace -> + throw({Tag, {Class, Term, Trace}}) end end, {SetupRest, CleanupAll} = multi_setup(Es, Cleanup), @@ -388,9 +391,9 @@ multi_setup([{Tag, S, C} | Es], CleanupPrev) -> R -> SetupRest([R|Rs]) catch - Class:Term -> + Class:Term:Trace -> CleanupPrev(Rs), - throw({Tag, {Class, Term, get_stacktrace()}}) + throw({Tag, {Class, Term, Trace}}) end end, CleanupAll}; diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 5fda857bf1..bfffb8db41 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -585,6 +585,13 @@ type(erlang, float, 1, Xs, Opaques) -> %% Guard bif, needs to be here. type(erlang, floor, 1, Xs, Opaques) -> strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques); +%% Primop, needs to be somewhere. +type(erlang, build_stacktrace, 0, _, _Opaques) -> + t_list(t_tuple([t_module(), + t_atom(), + t_sup([t_arity(),t_list()]), + t_list(t_sup([t_tuple([t_atom('file'),t_string()]), + t_tuple([t_atom('line'),t_pos_integer()])]))])); %% Guard bif, needs to be here. type(erlang, hd, 1, Xs, Opaques) -> strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques); @@ -2336,6 +2343,9 @@ arg_types(erlang, float, 1) -> %% Guard bif, needs to be here. arg_types(erlang, floor, 1) -> [t_number()]; +%% Primop, needs to be somewhere. +arg_types(erlang, build_stacktrace, 0) -> + []; %% Guard bif, needs to be here. arg_types(erlang, hd, 1) -> [t_cons()]; diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 1482f4f922..e398b4f0aa 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -711,9 +711,9 @@ do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) -> %% can retry requests in the pipeline. do_handle_info({'EXIT', _, _}, State) -> {noreply, State#state{status = close}}. - + call(Msg, Pid) -> - try gen_server:call(Pid, Msg) + try gen_server:call(Pid, Msg, infinity) catch exit:{noproc, _} -> {error, closed}; @@ -1685,9 +1685,8 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> insert_session(Session2, ProfileName); error:badarg -> {stop, normal}; - T:E -> + T:E:Stacktrace -> %% Unexpected this must be an error! - Stacktrace = erlang:get_stacktrace(), error_logger:error_msg("Failed updating session: " "~n ProfileName: ~p" "~n SessionId: ~p" diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 6b9053fda6..57ce162922 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -84,14 +84,14 @@ traverse_modules(ModData,[Module|Rest]) -> {proceed, NewData} -> traverse_modules(ModData#mod{data = NewData}, Rest) catch - T:E -> + T:E:Stacktrace -> String = lists:flatten( io_lib:format("module traverse failed: ~p:do => " "~n Error Type: ~p" "~n Error: ~p" "~n Stack trace: ~p", - [Module, T, E, ?STACK()])), + [Module, T, E, Stacktrace])), httpd_util:error_log(ModData#mod.config_db, String), send_status(ModData, 500, none), done diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index fdf4cc6e07..e24a4a8694 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,13 +18,13 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.4.3">>, [{load_module, httpd_esi, + {<<"6.4.5">>, [{load_module, httpc_handler, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.4.3">>, [{load_module, httpd_esi, + {<<"6.4.5">>, [{load_module, httpc_handler, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} diff --git a/lib/inets/src/inets_app/inets_internal.hrl b/lib/inets/src/inets_app/inets_internal.hrl index 079b415b56..e0f59bba5f 100644 --- a/lib/inets/src/inets_app/inets_internal.hrl +++ b/lib/inets/src/inets_app/inets_internal.hrl @@ -22,8 +22,6 @@ -ifndef(inets_internal_hrl). -define(inets_internal_hrl, true). --define(STACK(), erlang:get_stacktrace()). - %% Various trace macros -define(report(Severity, Label, Service, Content), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0533b9ab70..4bb449408f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -50,6 +50,7 @@ all() -> [ {group, http}, {group, sim_http}, + {group, http_internal}, {group, https}, {group, sim_https}, {group, misc} @@ -62,6 +63,7 @@ groups() -> %% and it shall be the last test case in the suite otherwise cookie %% will fail. {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]}, + {http_internal, [], real_requests_esi()}, {https, [], real_requests()}, {sim_https, [], only_simulated()}, {misc, [], misc()} @@ -97,6 +99,9 @@ real_requests()-> invalid_body ]. +real_requests_esi() -> + [slow_connection]. + only_simulated() -> [ cookie, @@ -1245,7 +1250,25 @@ stream_fun_server_close(Config) when is_list(Config) -> after 13000 -> ct:fail(did_not_receive_close) end. - + +%%-------------------------------------------------------------------- +slow_connection() -> + [{doc, "Test that a request on a slow keep-alive connection won't crash the httpc_manager"}]. +slow_connection(Config) when is_list(Config) -> + BodyFun = fun(0) -> eof; + (LenLeft) -> timer:sleep(1000), + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + Request = {url(group_name(Config), "/httpc_SUITE:esi_post", Config), + [{"content-length", "100"}], + "text/plain", + {BodyFun, 100}}, + {ok, _} = httpc:request(post, Request, [], []), + %% Second request causes a crash if gen_server timeout is not set to infinity + %% in httpc_handler. + {ok, _} = httpc:request(post, Request, [], []). + + %%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -1339,6 +1362,8 @@ url(https, End, Config) -> ?TLS_URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; url(sim_http, End, Config) -> url(http, End, Config); +url(http_internal, End, Config) -> + url(http, End, Config); url(sim_https, End, Config) -> url(https, End, Config). url(http, UserInfo, End, Config) -> @@ -1385,7 +1410,17 @@ server_config(http, Config) -> {mime_type, "text/plain"}, {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} ]; - +server_config(http_internal, Config) -> + ServerRoot = proplists:get_value(server_root, Config), + [{port, 0}, + {server_name,"httpc_test"}, + {server_root, ServerRoot}, + {document_root, proplists:get_value(doc_root, Config)}, + {bind_address, any}, + {ipfamily, inet_version()}, + {mime_type, "text/plain"}, + {erl_script_alias, {"", [httpc_SUITE]}} + ]; server_config(https, Config) -> [{socket_type, {essl, ssl_config(Config)}} | server_config(http, Config)]; server_config(sim_https, Config) -> @@ -1393,6 +1428,9 @@ server_config(sim_https, Config) -> server_config(_, _) -> []. +esi_post(Sid, _Env, _Input) -> + mod_esi:deliver(Sid, ["OK"]). + start_apps(https) -> inets_test_lib:start_apps([crypto, public_key, ssl]); start_apps(sim_https) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 05cf4f6cc3..dccdbfa94a 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.4.5 +INETS_VSN = 6.4.6 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index d7f224c38e..65fe9b9c07 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 5.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add <c>os:cmd/2</c> that takes an options map as the + second argument.</p> + <p> + Add <c>max_size</c> as an option to <c>os:cmd/2</c> that + control the maximum size of the result that + <c>os:cmd/2</c> will return.</p> + <p> + Own Id: OTP-14823</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 5.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index c27182ff0b..ef416ed233 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -103,7 +103,7 @@ </desc> </datatype> <datatype> - <name name="command_input"/> + <name name="os_command"/> <desc> <p>All characters needs to be valid characters on the specific OS using @@ -116,19 +116,31 @@ </p> </desc> </datatype> + <datatype> + <name name="os_command_opts"/> + <desc> + <p>Options for <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso></p> + <taglist> + <tag><c>max_size</c></tag> + <item> + <p>The maximum size of the data returned by the <c>os:cmd</c> call. + See the <seealso marker="#cmd/2"><c>os:cmd/2</c></seealso> + documentation for more details.</p> + </item> + </taglist> + </desc> + </datatype> </datatypes> - + <funcs> <func> <name name="cmd" arity="1"/> + <name name="cmd" arity="2"/> <fsummary>Execute a command in a shell of the target OS.</fsummary> <desc> <p>Executes <c><anno>Command</anno></c> in a command shell of the - target OS, - captures the standard output of the command, and returns this - result as a string. This function is a replacement of - the previous function <c>unix:cmd/1</c>; they are equivalent on a - Unix platform.</p> + target OS, captures the standard output of the command, + and returns this result as a string.</p> <warning><p>Previous implementation used to allow all characters as long as they were integer values greater than or equal to zero. This sometimes lead to unwanted results since null characters @@ -142,6 +154,21 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> called from another program (for example, <c>os:cmd/1</c>) can differ, compared with the standard output of the command when called directly from an OS command shell.</p> + <p><c>os:cmd/2</c> was added in kernel-5.5 (OTP-20.2.1). It makes it + possible to pass an options map as the second argument in order to + control the behaviour of <c>os:cmd</c>. The possible options are: + </p> + <taglist> + <tag><c>max_size</c></tag> + <item> + <p>The maximum size of the data returned by the <c>os:cmd</c> call. + This option is a safety feature that should be used when the command + executed can return a very large, possibly infinite, result.</p> + <code type="none"> +> os:cmd("cat /dev/zero", #{ max_size => 20 }). +[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]</code> + </item> + </taglist> </desc> </func> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 418b0c50e1..f5a890cb95 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -340,8 +340,7 @@ handle_call(all_loaded, _From, S) -> {reply,all_loaded(Db),S}; handle_call({get_object_code,Mod}, _From, St) when is_atom(Mod) -> - Path = St#state.path, - case mod_to_bin(Path, Mod) of + case get_object_code(St, Mod) of {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; Error -> {reply,Error,St} end; @@ -1182,19 +1181,28 @@ load_file(Mod, From, St0) -> end, handle_pending_on_load(Action, Mod, From, St0). -load_file_1(Mod, From, #state{path=Path}=St) -> - case mod_to_bin(Path, Mod) of +load_file_1(Mod, From, St) -> + case get_object_code(St, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> try_load_module_1(File, Mod, Binary, From, St) end. -mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), +get_object_code(#state{path=Path}, Mod) when is_atom(Mod) -> + ModStr = atom_to_list(Mod), + case erl_prim_loader:is_basename(ModStr) of + true -> + mod_to_bin(Path, Mod, ModStr ++ objfile_extension()); + false -> + error + end. + +mod_to_bin([Dir|Tail], Mod, ModFile) -> + File = filename:append(Dir, ModFile), case erl_prim_loader:get_file(File) of error -> - mod_to_bin(Tail, Mod); + mod_to_bin(Tail, Mod, ModFile); {ok,Bin,_} -> case filename:pathtype(File) of absolute -> @@ -1203,10 +1211,9 @@ mod_to_bin([Dir|Tail], Mod) -> {Mod,Bin,absname(File)} end end; -mod_to_bin([], Mod) -> +mod_to_bin([], Mod, ModFile) -> %% At last, try also erl_prim_loader's own method - File = to_list(Mod) ++ objfile_extension(), - case erl_prim_loader:get_file(File) of + case erl_prim_loader:get_file(ModFile) of error -> error; % No more alternatives ! {ok,Bin,FName} -> diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index fb9f7fd7eb..5ea0ca991f 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -539,8 +539,8 @@ do_setnode(#hs_data{other_node = Node, socket = Socket, "no table space left for node ~w ** ~n", [Node]), ?shutdown(Node); - error:Other -> - exit({Other, erlang:get_stacktrace()}) + error:Other:Stacktrace -> + exit({Other, Stacktrace}) end; _ -> error_msg("** Distribution connection error, " diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index 59ca8e690d..a9582c6225 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -106,8 +106,8 @@ crash(M, F, A) -> crash(Tuple) -> try erlang:error(undef) catch - error:undef -> - Stk = [Tuple|tl(erlang:get_stacktrace())], + error:undef:Stacktrace -> + Stk = [Tuple|tl(Stacktrace)], erlang:raise(error, undef, Stk) end. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index d05199897f..c2df1ee288 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1382,8 +1382,8 @@ eval_stream2({ok,Form,EndLine}, Fd, H, Last, E, Bs0) -> try erl_eval:exprs(Form, Bs0) of {value,V,Bs} -> eval_stream(Fd, H, EndLine, {V}, E, Bs) - catch Class:Reason -> - Error = {EndLine,?MODULE,{Class,Reason,erlang:get_stacktrace()}}, + catch Class:Reason:StackTrace -> + Error = {EndLine,?MODULE,{Class,Reason,StackTrace}}, eval_stream(Fd, H, EndLine, Last, [Error|E], Bs0) end; eval_stream2({error,What,EndLine}, Fd, H, Last, E, Bs) -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index fbc046c8f9..1e9db80058 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -21,11 +21,11 @@ %% Provides a common operating system interface. --export([type/0, version/0, cmd/1, find_executable/1, find_executable/2]). +-export([type/0, version/0, cmd/1, cmd/2, find_executable/1, find_executable/2]). -include("file.hrl"). --export_type([env_var_name/0, env_var_value/0, env_var_name_value/0, command_input/0]). +-export_type([env_var_name/0, env_var_value/0, env_var_name_value/0]). -export([getenv/0, getenv/1, getenv/2, putenv/2, unsetenv/1]). @@ -35,14 +35,17 @@ perf_counter/1, set_env_var/2, set_signal/2, system_time/0, system_time/1, timestamp/0, unset_env_var/1]). +-type os_command() :: atom() | io_lib:chars(). +-type os_command_opts() :: #{ max_size => non_neg_integer() | infinity }. + +-export_type([os_command/0, os_command_opts/0]). + -type env_var_name() :: nonempty_string(). -type env_var_value() :: string(). -type env_var_name_value() :: nonempty_string(). --type command_input() :: atom() | io_lib:chars(). - -spec list_env_vars() -> [{env_var_name(), env_var_value()}]. list_env_vars() -> erlang:nif_error(undef). @@ -260,14 +263,20 @@ extensions() -> %% Executes the given command in the default shell for the operating system. -spec cmd(Command) -> string() when - Command :: os:command_input(). + Command :: os_command(). cmd(Cmd) -> + cmd(Cmd, #{ }). + +-spec cmd(Command, Options) -> string() when + Command :: os_command(), + Options :: os_command_opts(). +cmd(Cmd, Opts) -> {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), validate(Cmd)), Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, stream, in, hide | SpawnOpts]), MonRef = erlang:monitor(port, Port), true = port_command(Port, SpawnInput), - Bytes = get_data(Port, MonRef, Eot, []), + Bytes = get_data(Port, MonRef, Eot, [], 0, maps:get(max_size, Opts, infinity)), demonitor(MonRef, [flush]), String = unicode:characters_to_list(Bytes), if %% Convert to unicode list if possible otherwise return bytes @@ -332,12 +341,13 @@ validate2([List|Rest]) when is_list(List) -> validate2(List), validate2(Rest). -get_data(Port, MonRef, Eot, Sofar) -> +get_data(Port, MonRef, Eot, Sofar, Size, Max) -> receive {Port, {data, Bytes}} -> - case eot(Bytes, Eot) of + case eot(Bytes, Eot, Size, Max) of more -> - get_data(Port, MonRef, Eot, [Sofar,Bytes]); + get_data(Port, MonRef, Eot, [Sofar, Bytes], + Size + byte_size(Bytes), Max); Last -> catch port_close(Port), flush_until_down(Port, MonRef), @@ -348,13 +358,16 @@ get_data(Port, MonRef, Eot, Sofar) -> iolist_to_binary(Sofar) end. -eot(_Bs, <<>>) -> +eot(_Bs, <<>>, _Size, _Max) -> more; -eot(Bs, Eot) -> +eot(Bs, Eot, Size, Max) -> case binary:match(Bs, Eot) of - nomatch -> more; - {Pos, _} -> - binary:part(Bs,{0, Pos}) + nomatch when Size + byte_size(Bs) < Max -> + more; + {Pos, _} when Size + Pos < Max -> + binary:part(Bs,{0, Pos}); + _ -> + binary:part(Bs,{0, Max - Size}) end. %% When port_close returns we know that all the diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 569753155f..902196def2 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -931,37 +931,34 @@ purge_stacktrace(Config) when is_list(Config) -> code:purge(code_b_test), try code_b_test:call(fun(b) -> ok end, a) catch - error:function_clause -> + error:function_clause:Stacktrace -> code:load_file(code_b_test), - case erlang:get_stacktrace() of + case Stacktrace of [{?MODULE,_,[a],_}, {code_b_test,call,2,_}, {?MODULE,purge_stacktrace,1,_}|_] -> - false = code:purge(code_b_test), - [] = erlang:get_stacktrace() + false = code:purge(code_b_test) end end, try code_b_test:call(nofun, 2) catch - error:function_clause -> + error:function_clause:Stacktrace2 -> code:load_file(code_b_test), - case erlang:get_stacktrace() of + case Stacktrace2 of [{code_b_test,call,[nofun,2],_}, {?MODULE,purge_stacktrace,1,_}|_] -> - false = code:purge(code_b_test), - [] = erlang:get_stacktrace() + false = code:purge(code_b_test) end end, Args = [erlang,error,[badarg]], try code_b_test:call(erlang, error, [badarg,Args]) catch - error:badarg -> + error:badarg:Stacktrace3 -> code:load_file(code_b_test), - case erlang:get_stacktrace() of + case Stacktrace3 of [{code_b_test,call,Args,_}, {?MODULE,purge_stacktrace,1,_}|_] -> - false = code:purge(code_b_test), - [] = erlang:get_stacktrace() + false = code:purge(code_b_test) end end, ok. diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index bbfaa9d147..073b391288 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -459,9 +459,9 @@ run_remote_test([FuncStr, TestNodeStr | Args]) -> 1 end catch - C:E -> + C:E:S -> io:format("Node ~p got EXCEPTION ~p:~p\nat ~p\n", - [node(), C, E, erlang:get_stacktrace()]), + [node(), C, E, S]), 2 end, io:format("Node ~p doing halt(~p).\n",[node(), Status]), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 0cb8087a76..9a77454432 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -399,11 +399,11 @@ read_write_0(Str, {Func, ReadFun}, Options) -> io:format("~p:~p: ~p ERROR: ~ts vs~n ~w~n - ~p~n", [?MODULE, Line, Func, Str, ReadBytes, Options]), exit({error, ?LINE}); - error:What -> + error:What:Stacktrace -> io:format("~p:??: ~p ERROR: ~p from~n ~w~n ~p~n", [?MODULE, Func, What, Str, Options]), - io:format("\t~p~n", [erlang:get_stacktrace()]), + io:format("\t~p~n", [Stacktrace]), exit({error, ?LINE}) end. diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index 620ab235a0..9dde00652c 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -1038,8 +1038,7 @@ do_from_other_process(Fun) -> Result -> Parent ! {Ref,Result} catch - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> Parent ! {Ref,Class,Reason,Stacktrace} end end), @@ -1617,8 +1616,7 @@ s_start(Socket, Timeout, Parent) -> try s_loop(Socket, Timeout, Parent, Handler, gb_trees:empty()) catch - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> io:format(?MODULE_STRING":socket exception ~w:~w at~n" "~p.~n", [Class,Reason,Stacktrace]), erlang:raise(Class, Reason, Stacktrace) diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 12d22519ce..0fe44e8a88 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -605,9 +605,9 @@ ok({ok,V}) -> V; ok(NotOk) -> try throw(not_ok) catch - Thrown -> + throw:Thrown:Stacktrace -> erlang:raise( - error, {Thrown, NotOk}, tl(erlang:get_stacktrace())) + error, {Thrown, NotOk}, tl(Stacktrace)) end. get_localaddr() -> diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 96e495505a..6a50239c2a 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -755,9 +755,9 @@ ok({ok,V}) -> V; ok(NotOk) -> try throw(not_ok) catch - Thrown -> + throw:Thrown:Stacktrace -> erlang:raise( - error, {Thrown, NotOk}, tl(erlang:get_stacktrace())) + error, {Thrown, NotOk}, tl(Stacktrace)) end. diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 6691ad9c06..2a5b8d0044 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -217,10 +217,10 @@ proxy_start(TC, {NS,P}) -> spawn_link( fun () -> try proxy_start(TC, NS, P, Parent, Tag) - catch C:X -> + catch C:X:Stacktrace -> io:format( "~w: ~w:~p ~p~n", - [self(),C,X,erlang:get_stacktrace()]) + [self(),C,X,Stacktrace]) end end), receive {started,Tag,Port} -> diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 8056321448..4369b1b0f9 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -26,7 +26,8 @@ null_in_command/1, space_in_name/1, bad_command/1, find_executable/1, unix_comment_in_command/1, deep_list_command/1, large_output_command/1, background_command/0, background_command/1, - message_leak/1, close_stdin/0, close_stdin/1, perf_counter_api/1]). + message_leak/1, close_stdin/0, close_stdin/1, max_size_command/1, + perf_counter_api/1]). -include_lib("common_test/include/ct.hrl"). @@ -39,7 +40,7 @@ all() -> space_in_name, bad_command, find_executable, unix_comment_in_command, deep_list_command, large_output_command, background_command, message_leak, - close_stdin, perf_counter_api]. + close_stdin, max_size_command, perf_counter_api]. groups() -> []. @@ -322,6 +323,19 @@ close_stdin(Config) -> "-1" = os:cmd(Fds). +max_size_command(_Config) -> + + Res20 = os:cmd("cat /dev/zero", #{ max_size => 20 }), + 20 = length(Res20), + + Res0 = os:cmd("cat /dev/zero", #{ max_size => 0 }), + 0 = length(Res0), + + Res32768 = os:cmd("cat /dev/zero", #{ max_size => 32768 }), + 32768 = length(Res32768), + + ResHello = os:cmd("echo hello", #{ max_size => 20 }), + 6 = length(ResHello). %% Test that the os:perf_counter api works as expected perf_counter_api(_Config) -> diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 106bda01ca..91261e1d55 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 5.4.1 +KERNEL_VSN = 5.4.2 diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 95f7d4afc1..6d87544bd2 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -177,8 +177,8 @@ %% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index da7e662288..e36222d098 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -47,6 +47,10 @@ -define(catch_val(Var), (try ?ets_lookup_element(mnesia_gvar, Var, 2) catch error:_ -> {'EXIT', {badarg, []}} end)). +-define(catch_val_and_stack(Var), + (try ?ets_lookup_element(mnesia_gvar, Var, 2) + catch error:_:_Stacktrace -> {'EXIT', _Stacktrace} end)). + %% It's important that counter is first, since we compare tid's -record(tid, diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 34f16f178b..9dda340333 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -90,9 +90,9 @@ iterate(Mod, Fun, Opaque, Acc) -> catch throw:Err -> close_read(R2), Err; - _:Reason -> + _:Reason:Stacktrace -> close_read(R2), - {error, {Reason, erlang:get_stacktrace()}} + {error, {Reason, Stacktrace}} end catch throw:{error,_} = Err -> Err @@ -198,9 +198,9 @@ do_read_schema_section(R) -> try {R3, RawSchema} = safe_apply(R2, read, [R2#restore.bup_data]), do_read_schema_section(R3, verify_header(RawSchema), []) - catch T:E -> + catch T:E:S -> close_read(R2), - erlang:raise(T,E,erlang:get_stacktrace()) + erlang:raise(T,E,S) end. do_read_schema_section(R, {ok, B, C, []}, Acc) -> diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 8112378ffd..8290237908 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -1269,9 +1269,9 @@ system_code_change(Cp, _Module, _OldVsn, _Extra) -> %%%%%%%%%%%%%%%%%%%%%%%%%% +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); - _VaLuE_ -> _VaLuE_ + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); + Value -> Value end. - diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 77013489b3..77e67a59db 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -185,9 +185,10 @@ max_loaders() -> worker_res }). +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl index f0ed7aef4a..31bcc1451f 100644 --- a/lib/mnesia/src/mnesia_dumper.erl +++ b/lib/mnesia/src/mnesia_dumper.erl @@ -191,8 +191,7 @@ do_perform_dump(Cont, InPlace, InitBy, Regulator, OldVersion) -> try insert_recs(Recs, InPlace, InitBy, Regulator, OldVersion) of Version -> do_perform_dump(C2, InPlace, InitBy, Regulator, Version) - catch _:R when R =/= fatal -> - ST = erlang:get_stacktrace(), + catch _:R:ST when R =/= fatal -> Reason = {"Transaction log dump error: ~tp~n", [{R, ST}]}, close_files(InPlace, {error, Reason}, InitBy), exit(Reason) @@ -325,8 +324,7 @@ perform_update(Tid, SchemaOps, _DumperMode, _UseDir) -> ?eval_debug_fun({?MODULE, post_dump}, [InitBy]), close_files(InPlace, ok, InitBy), ok - catch _:Reason when Reason =/= fatal -> - ST = erlang:get_stacktrace(), + catch _:Reason:ST when Reason =/= fatal -> Error = {error, {"Schema update error", {Reason, ST}}}, close_files(InPlace, Error, InitBy), fatal("Schema update error ~tp ~tp", [{Reason,ST}, SchemaOps]) @@ -1471,8 +1469,9 @@ regulate(RegulatorPid) -> {regulated, RegulatorPid} -> ok end. +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index c39f30e140..63fb4981fe 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -1157,9 +1157,10 @@ remove_node(Node, Cs) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Helpers +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 53fdd76de8..56f6926df0 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -116,7 +116,7 @@ lock_table/1, mkcore/1, not_active_here/1, - other_val/1, + other_val/2, overload_read/0, overload_read/1, overload_set/2, @@ -435,8 +435,8 @@ validate_record(Tab, Obj) -> %% val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> other_val(Var, Stacktrace); _VaLuE_ -> _VaLuE_ end. @@ -446,9 +446,9 @@ set(Var, Val) -> unset(Var) -> ?ets_delete(mnesia_gvar, Var). -other_val(Var) -> +other_val(Var, Stacktrace) -> case other_val_1(Var) of - error -> pr_other(Var); + error -> pr_other(Var, Stacktrace); Val -> Val end. @@ -460,8 +460,8 @@ other_val_1(Var) -> _ -> error end. --spec pr_other(_) -> no_return(). -pr_other(Var) -> +-spec pr_other(_, _) -> no_return(). +pr_other(Var, Stacktrace) -> Why = case is_running() of no -> {node_not_running, node()}; @@ -469,7 +469,7 @@ pr_other(Var) -> end, verbose("~p (~tp) val(mnesia_gvar, ~tw) -> ~p ~tp ~n", [self(), process_info(self(), registered_name), - Var, Why, erlang:get_stacktrace()]), + Var, Why, Stacktrace]), mnesia:abort(Why). %% Some functions for list valued variables diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index 4c6336cb73..bbceb9ba66 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -34,9 +34,10 @@ -include("mnesia.hrl"). +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. @@ -535,7 +536,7 @@ init_table(Tab, _, Fun, _DetsInfo,_) -> try true = ets:init_table(Tab, Fun), ok - catch _:Else -> {Else, erlang:get_stacktrace()} + catch _:Else:Stacktrace -> {Else, Stacktrace} end. @@ -777,9 +778,9 @@ do_send_table(Pid, Tab, Storage, RemoteS) -> throw:receiver_died -> cleanup_tab_copier(Pid, Storage, Tab), ok; - error:Reason -> %% Prepare failed + error:Reason:Stacktrace -> %% Prepare failed cleanup_tab_copier(Pid, Storage, Tab), - {error, {tab_copier, Tab, {Reason, erlang:get_stacktrace()}}} + {error, {tab_copier, Tab, {Reason, Stacktrace}}} after unlink(whereis(mnesia_tm)) end. diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 073b48abc0..710bf38cb5 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -97,10 +97,11 @@ init(Parent) -> end, loop(#state{supervisor = Parent}). +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); - _VaLuE_ -> _VaLuE_ + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); + Value -> Value end. reply(From, R) -> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index d792070332..475bf3c327 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -177,10 +177,10 @@ disconnect(Node) -> log_decision(D) -> cast({log_decision, D}). +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _Reason} -> - mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 71952af31c..de6c3fb4ee 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -181,9 +181,10 @@ exit_on_error({error, Reason}) -> exit_on_error(GoodRes) -> GoodRes. +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); Value -> Value end. @@ -2695,10 +2696,10 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) -> Objs -> mnesia_lib:db_fixtable(Storage, Tab, false), {true, Objs, mandatory} - catch _:Reason -> + catch _:Reason:Stacktrace -> mnesia_lib:db_fixtable(Storage, Tab, false), mnesia_lib:important("Transform function failed: '~tp' in '~tp'", - [Reason, erlang:get_stacktrace()]), + [Reason, Stacktrace]), exit({"Bad transform function", Tab, Fun, node(), Reason}) end end; diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index ebf580d09e..eaebdf6d02 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -121,10 +121,11 @@ init(Parent) -> proc_lib:init_ack(Parent, {ok, self()}), doit_loop(#state{supervisor = Parent}). +%% Local function in order to avoid external function call val(Var) -> - case ?catch_val(Var) of - {'EXIT', _} -> mnesia_lib:other_val(Var); - _VaLuE_ -> _VaLuE_ + case ?catch_val_and_stack(Var) of + {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace); + Value -> Value end. reply({From,Ref}, R) -> @@ -597,9 +598,9 @@ recover_coordinator(Tid, Etabs) -> false -> %% When killed before store havn't been copied to ok %% to the new nested trans store. end - catch _:Reason -> + catch _:Reason:Stacktrace -> dbg_out("Recovery of coordinator ~p failed: ~tp~n", - [Tid, {Reason, erlang:get_stacktrace()}]), + [Tid, {Reason, Stacktrace}]), Protocol = asym_trans, tell_outcome(Tid, Protocol, node(), CheckNodes, TellNodes) end, @@ -825,8 +826,7 @@ execute_transaction(Fun, Args, Factor, Retries, Type) -> catch throw:Value -> %% User called throw Reason = {aborted, {throw, Value}}, return_abort(Fun, Args, Reason); - error:Reason -> - ST = erlang:get_stacktrace(), + error:Reason:ST -> check_exit(Fun, Args, Factor, Retries, {Reason,ST}, Type); _:Reason -> check_exit(Fun, Args, Factor, Retries, Reason, Type) @@ -1796,14 +1796,13 @@ do_update(Tid, Storage, [Op | Ops], OldRes) -> try do_update_op(Tid, Storage, Op) of ok -> do_update(Tid, Storage, Ops, OldRes); NewRes -> do_update(Tid, Storage, Ops, NewRes) - catch _:Reason -> + catch _:Reason:ST -> %% This may only happen when we recently have %% deleted our local replica, changed storage_type %% or transformed table %% BUGBUG: Updates may be lost if storage_type is changed. %% Determine actual storage type and try again. %% BUGBUG: Updates may be lost if table is transformed. - ST = erlang:get_stacktrace(), verbose("do_update in ~w failed: ~tp -> {'EXIT', ~tp}~n", [Tid, Op, {Reason, ST}]), do_update(Tid, Storage, Ops, OldRes) @@ -1914,11 +1913,10 @@ commit_clear([H|R], Tid, Storage, Tab, K, Obj) do_snmp(_, []) -> ok; do_snmp(Tid, [Head|Tail]) -> try mnesia_snmp_hook:update(Head) - catch _:Reason -> + catch _:Reason:ST -> %% This should only happen when we recently have %% deleted our local replica or recently deattached %% the snmp table - ST = erlang:get_stacktrace(), verbose("do_snmp in ~w failed: ~tp -> {'EXIT', ~tp}~n", [Tid, Head, {Reason, ST}]) end, diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl index 78dbe7ffde..db0e7beac6 100644 --- a/lib/mnesia/test/mnesia_test_lib.erl +++ b/lib/mnesia/test/mnesia_test_lib.erl @@ -470,9 +470,9 @@ get_suite(Mod, {group, Suite}) -> {_, _, TCList} = lists:keyfind(Suite, 1, Groups), TCList catch - _:Reason -> + _:Reason:Stacktrace -> io:format("Not implemented ~p ~p (~p ~p)~n", - [Mod,Suite,Reason, erlang:get_stacktrace()]), + [Mod,Suite,Reason,Stacktrace]), 'NYI' end; get_suite(Mod, all) -> diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl index ba7eb10ea2..90a3c686b0 100644 --- a/lib/mnesia/test/mnesia_test_lib.hrl +++ b/lib/mnesia/test/mnesia_test_lib.hrl @@ -55,25 +55,25 @@ ?error("Not Matching Actual result was:~n ~p~n",[_AR_0]), {fail,_AR_0} catch - exit:{aborted, _ER_1} when + exit:{aborted, _ER_1}:Stacktrace when element(1, _ER_1) =:= node_not_running; element(1, _ER_1) =:= bad_commit; element(1, _ER_1) =:= cyclic -> %% Need to re-raise these to restart transaction - erlang:raise(exit, {aborted, _ER_1}, erlang:get_stacktrace()); - exit:_AR_1 -> + erlang:raise(exit, {aborted, _ER_1}, Stacktrace); + exit:_AR_1:Stacktrace -> case fun(_AR_EXIT_) -> {'EXIT', _AR_EXIT_} end(_AR_1) of _AR_2 = ExpectedRes -> ?verbose("ok, ~n Result as expected:~p~n",[_AR_2]), {success,_AR_2}; _AR_2 -> ?error("Not Matching Actual result was:~n ~p~n ~p~n", - [_AR_2, erlang:get_stacktrace()]), + [_AR_2, Stacktrace]), {fail,_AR_2} end; - _T1_:_AR_1 -> + _T1_:_AR_1:Stacktrace -> ?error("Not Matching Actual result was:~n ~p~n ~p~n", - [{_T1_,_AR_1}, erlang:get_stacktrace()]), + [{_T1_,_AR_1}, Stacktrace]), {fail,{_T1_,_AR_1}} end end()). diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 7f4b3dd484..e0f319b6cc 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -79,8 +79,8 @@ init([Notebook, Parent, Config]) -> max = #{} } } - catch _:Err -> - io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]), + catch _:Err:Stacktrace -> + io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, Stacktrace]), {stop, Err} end. diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 5adfadb16e..eddb9327f3 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -86,8 +86,8 @@ init([Notebook, Parent, Config]) -> secs=maps:get(secs, Config, ?DISP_SECONDS)} }, {Panel, State0} - catch _:Err -> - io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]), + catch _:Err:Stacktrace -> + io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, Stacktrace]), {stop, Err} end. diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl index fbcf6d7fe9..ff8c40ce77 100644 --- a/lib/observer/src/observer_traceoptions_wx.erl +++ b/lib/observer/src/observer_traceoptions_wx.erl @@ -536,7 +536,7 @@ ms_from_string(Str) -> {error, List} -> throw([[Error, $\n] || {_, Error} <- List]) end catch error:_Reason -> - %% io:format("Bad term: ~ts~n ~tp in ~tp~n", [Str, _Reason, erlang:get_stacktrace()]), + %% io:format("Bad term: ~ts~n ~tp in ~tp~n", [Str, _Reason, Stacktrace]), throw("Invalid term") end. diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index 91d6cd49a6..53e8124aaa 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -56,8 +56,7 @@ return_error(Line, Message) -> yeccpars0(Tokens, Tzr, State, States, Vstack) -> try yeccpars1(Tokens, Tzr, State, States, Vstack) catch - error: Error -> - Stacktrace = erlang:get_stacktrace(), + error: Error: Stacktrace -> try yecc_error_type(Error, Stacktrace) of Desc -> erlang:raise(error, {yecc_bug, ?CODE_VERSION, Desc}, diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl index 6f6f66d56c..45d91a83a3 100644 --- a/lib/parsetools/src/yeccparser.erl +++ b/lib/parsetools/src/yeccparser.erl @@ -72,8 +72,7 @@ return_error(Line, Message) -> yeccpars0(Tokens, Tzr, State, States, Vstack) -> try yeccpars1(Tokens, Tzr, State, States, Vstack) catch - error: Error -> - Stacktrace = erlang:get_stacktrace(), + error: Error: Stacktrace -> try yecc_error_type(Error, Stacktrace) of Desc -> erlang:raise(error, {yecc_bug, ?CODE_VERSION, Desc}, @@ -167,21 +166,20 @@ yecctoken_location(Token) -> end. -compile({nowarn_unused_function, yecctoken2string/1}). -yecctoken2string({atom, _, A}) -> io_lib:write(A); +yecctoken2string({atom, _, A}) -> io_lib:write_atom(A); yecctoken2string({integer,_,N}) -> io_lib:write(N); yecctoken2string({float,_,F}) -> io_lib:write(F); yecctoken2string({char,_,C}) -> io_lib:write_char(C); yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); yecctoken2string({string,_,S}) -> io_lib:write_string(S); yecctoken2string({reserved_symbol, _, A}) -> io_lib:write(A); -yecctoken2string({_Cat, _, Val}) -> io_lib:format("~p",[Val]); +yecctoken2string({_Cat, _, Val}) -> io_lib:format("~tp", [Val]); yecctoken2string({dot, _}) -> "'.'"; -yecctoken2string({'$end', _}) -> - []; +yecctoken2string({'$end', _}) -> []; yecctoken2string({Other, _}) when is_atom(Other) -> - io_lib:write(Other); + io_lib:write_atom(Other); yecctoken2string(Other) -> - io_lib:write(Other). + io_lib:format("~tp", [Other]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index a7166b91ed..2d3b15326b 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -1674,8 +1674,7 @@ format_error(Message) -> yeccpars0(Tokens, MFA) -> try yeccpars1(Tokens, MFA, 0, [], []) catch - error: Error -> - Stacktrace = erlang:get_stacktrace(), + error: Error : Stacktrace -> try yecc_error_type(Error, Stacktrace) of {syntax_error, Token} -> yeccerror(Token); diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl index 663144861f..335b40fa74 100644 --- a/lib/reltool/src/reltool_app_win.erl +++ b/lib/reltool/src/reltool_app_win.erl @@ -102,8 +102,8 @@ init(Parent, WxEnv, Xref, C, AppName) -> try do_init(Parent, WxEnv, Xref, C, AppName) catch - error:Reason -> - exit({Reason, erlang:get_stacktrace()}) + error:Reason:Stacktrace -> + exit({Reason, Stacktrace}) end. do_init(Parent, WxEnv, Xref, C, AppName) -> diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index dcd802a5de..8272d864c2 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -107,8 +107,8 @@ init(Parent, WxEnv, Xref, RelPid, C, ModName) -> try do_init(Parent, WxEnv, Xref, RelPid, C, ModName) catch - error:Reason -> - exit({Reason, erlang:get_stacktrace()}) + error:Reason:Stacktrace -> + exit({Reason, Stacktrace}) end. do_init(Parent, WxEnv, Xref, RelPid, C, ModName) -> diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index 853191c696..66ee1a3742 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -135,8 +135,8 @@ init([{parent,Parent}|_] = Options) -> catch throw:{error,Reason} -> proc_lib:init_ack(Parent,{error,Reason}); - error:Reason -> - exit({Reason, erlang:get_stacktrace()}) + error:Reason:Stacktrace -> + exit({Reason, Stacktrace}) end. do_init(Options) -> diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl index 92df270752..d87b1dc91f 100644 --- a/lib/reltool/src/reltool_sys_win.erl +++ b/lib/reltool/src/reltool_sys_win.erl @@ -135,9 +135,9 @@ init(Options) -> try do_init(Options) catch - error:Reason -> - io:format("~tp: ~tp~n",[Reason, erlang:get_stacktrace()]), - exit({Reason, erlang:get_stacktrace()}) + error:Reason:Stacktrace -> + io:format("~tp: ~tp~n",[Reason, Stacktrace]), + exit({Reason, Stacktrace}) end. do_init([{safe_config, Safe}, {parent, Parent} | Options]) -> diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 93e3e26fda..74300ba3fc 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -32,6 +32,23 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.12.4</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New family of <c>erts_alloc</c> strategies: Age Order + First Fit. Similar to "address order", but instead the + oldest possible carrier is always chosen for allocation.</p> + <p> + Own Id: OTP-14917 Aux Id: ERIERL-88 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.12.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 342363d08d..6c1a945484 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -265,7 +265,13 @@ strategy_str(aoff) -> strategy_str(aoffcbf) -> "Address order first fit carrier best fit"; strategy_str(aoffcaobf) -> - "Address order first fit carrier adress order best fit". + "Address order first fit carrier adress order best fit"; +strategy_str(ageffcaoff) -> + "Age order first fit carrier address order first fit"; +strategy_str(ageffcbf) -> + "Age order first fit carrier best fit"; +strategy_str(ageffcaobf) -> + "Age order first fit carrier adress order best fit". default_acul(A, S) -> case carrier_migration_support(S) of diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index a1edde8516..7ec3b38930 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -279,7 +279,7 @@ get_table_list(mnesia, Opts) -> end, [Tab|Acc] catch _:_What -> - %% io:format("Skipped ~p: ~p ~p ~n",[Id, _What, erlang:get_stacktrace()]), + %% io:format("Skipped ~p: ~p ~p ~n",[Id, _What, Stacktrace]), Acc end end, diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 119d7cc3d4..136ee55b54 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -488,10 +488,10 @@ to_fd(Fd) -> ok = file:write(Fd, io_lib:format(Format, Args)) end, - EmitChunk("{system_information_version, ~p}.~n" + EmitChunk("{system_information_version, ~w}.~n" "{system_information,[" - "{init_arguments,~p}," - "{code_paths,~p},", + "{init_arguments,~w}," + "{code_paths,~w},", [?REPORT_FILE_VSN, init:get_arguments(), code:get_path()]), @@ -499,12 +499,12 @@ to_fd(Fd) -> emit_code_info(EmitChunk), EmitChunk( "," %% Note the leading comma! - "{system_info,~p}," - "{erts_compile_info,~p}," - "{beam_dynamic_libraries,~p}," - "{environment_erts,~p}," - "{environment,~p}," - "{sanity_check,~p}" + "{system_info,~w}," + "{erts_compile_info,~w}," + "{beam_dynamic_libraries,~w}," + "{environment_erts,~w}," + "{environment,~w}," + "{sanity_check,~w}" "]}.~n", [erlang_system_info(), erlang:system_info(compile_info), @@ -533,11 +533,11 @@ emit_application_info(EmitChunk, Path) -> Description = proplists:get_value(description, Info, []), Version = proplists:get_value(vsn, Info, []), - EmitChunk("{application, {~p,[" - "{description,~p}," - "{vsn,~p}," - "{path,~p}," - "{runtime_dependencies,~p},", + EmitChunk("{application, {~w,[" + "{description,~w}," + "{vsn,~w}," + "{path,~w}," + "{runtime_dependencies,~w},", [App, Description, Version, Path, RtDeps]), emit_module_info_from_path(EmitChunk, Path), EmitChunk("]}}", []) @@ -545,7 +545,7 @@ emit_application_info(EmitChunk, Path) -> emit_code_path_info(EmitChunk, Path) -> EmitChunk("{code, [" - "{path, ~p},", [Path]), + "{path, ~w},", [Path]), emit_module_info_from_path(EmitChunk, Path), EmitChunk("]}", []). @@ -573,11 +573,11 @@ emit_module_info(EmitChunk, Beam) -> _ -> true end, - EmitChunk("{~p,[" - "{loaded,~p}," - "{native,~p}," - "{compiler,~p}," - "{md5,~p}" + EmitChunk("{~w,[" + "{loaded,~w}," + "{native,~w}," + "{compiler,~w}," + "{md5,~w}" "]}", [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]). diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index 872bd5db1d..0dc6a48570 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.12.3 +RUNTIME_TOOLS_VSN = 1.12.4 diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index 824820c214..edd2efdf05 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -2580,15 +2580,15 @@ check_gg_info(Node,OtherAlive,OtherDead,Synced,N) -> GGI = rpc:call(Node, global_group, info, []), GI = rpc:call(Node, global, info,[]), try do_check_gg_info(OtherAlive,OtherDead,Synced,GGI,GI) - catch _:E when N==0 -> + catch _:E:Stacktrace when N==0 -> ?t:format("~nERROR: check_gg_info failed for ~p:~n~p~n" "when GGI was: ~p~nand GI was: ~p~n", - [Node,{E,erlang:get_stacktrace()},GGI,GI]), + [Node,{E,Stacktrace},GGI,GI]), ?t:fail("check_gg_info failed"); - _:E -> + _:E:Stacktrace -> ?t:format("~nWARNING: check_gg_info failed for ~p:~n~p~n" "when GGI was: ~p~nand GI was: ~p~n", - [Node,{E,erlang:get_stacktrace()},GGI,GI]), + [Node,{E,Stacktrace},GGI,GI]), timer:sleep(1000), check_gg_info(Node,OtherAlive,OtherDead,Synced,N-1) end. diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 80b639155b..4f72114ae9 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -141,23 +141,25 @@ <tag><c>sslsocket() =</c></tag> <item><p>opaque()</p></item> - <tag><marker id="type-protocol"/><c> protocol_versions() =</c></tag> + <tag><marker id="type-protocol"/><c> protocol_version() =</c></tag> <item><p><c> ssl_tls_protocol() | dtls_protocol() </c></p></item> - <tag><marker id="type-protocol"/><c> ssl_tls_protocol() =</c></tag> <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> <tag><marker id="type-protocol"/><c> dtls_protocol() =</c></tag> <item><p><c>'dtlsv1' | 'dtlsv1.2'</c></p></item> <tag><c>ciphers() =</c></tag> - <item><p><c>= [ciphersuite()] | string()</c></p> - <p>According to old API.</p></item> + <item><p><c>= [ciphersuite()]</c></p> + <p>Tuples and string formats accepted by versions + before ssl-8.2.4 will be converted for backwards compatibility</p></item> <tag><c>ciphersuite() =</c></tag> - - <item><p><c>{key_exchange(), cipher(), MAC::hash()} | - {key_exchange(), cipher(), MAC::hash(), PRF::hash()}</c></p></item> + <item><p><c> + #{key_exchange := key_exchange(), + cipher := cipher(), + mac := MAC::hash() | aead, + prf := PRF::hash() | default_prf} </c></p></item> <tag><c>key_exchange()=</c></tag> <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk @@ -174,6 +176,12 @@ <tag><c>prf_random() =</c></tag> <item><p><c>client_random | server_random</c></p></item> + <tag><c>cipher_filters() =</c></tag> + <item><p><c> [{key_exchange | cipher | mac | prf, algo_filter()}])</c></p></item> + + <tag><c>algo_filter() =</c></tag> + <item><p>fun(key_exchange() | cipher() | hash() | aead | default_prf) -> true | false </p></item> + <tag><c>srp_param_type() =</c></tag> <item><p><c>srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | srp_8192</c></p></item> @@ -465,7 +473,8 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> with the selected CA as trusted anchor and the rest of the chain.</p></item> - <tag><c>{versions, [protocol_versions()]}</c></tag> + <tag><c>{versions, [protocol_version()]}</c></tag> + <item><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option <c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults @@ -838,23 +847,55 @@ fun(srp, Username :: string(), UserState :: term()) -> </section> <funcs> + + <func> + <name>append_cipher_suites(Deferred, Suites) -> ciphers() </name> + <fsummary></fsummary> + <type> + <v>Deferred = ciphers() | cipher_filters() </v> + <v>Suites = ciphers() </v> + </type> + <desc><p>Make <c>Deferred</c> suites become the least preferred + suites, that is put them at the end of the cipher suite list + <c>Suites</c> after removing them from <c>Suites</c> if + present. <c>Deferred</c> may be a list of cipher suits or a + list of filters in which case the filters are use on <c>Suites</c> to + extract the Deferred cipher list.</p> + </desc> + </func> + <func> <name>cipher_suites() -></name> - <name>cipher_suites(Type) -> ciphers()</name> - <name>cipher_suites(Type, protocol_version()) -> ciphers()</name> + <name>cipher_suites(Type) -> old_ciphers()</name> <fsummary>Returns a list of supported cipher suites.</fsummary> <type> <v>Type = erlang | openssl | all</v> </type> - <desc><p>Returns a list of supported cipher suites. + <desc> + <p>Returns a list of supported cipher suites. + This function will become deprecated in OTP 21, and replaced + by <seealso marker="#cipher_suites-2">ssl:cipher-suites/2</seealso> <c>cipher_suites()</c> is equivalent to <c>cipher_suites(erlang).</c> Type <c>openssl</c> is provided for backwards compatibility with the old SSL, which used OpenSSL. <c>cipher_suites(all)</c> returns all available cipher suites. The cipher suites not present in <c>cipher_suites(erlang)</c> but included in <c>cipher_suites(all)</c> are not used unless explicitly configured - by the user. If the version option is not specified, the highest supported - TLS version will be used to determine the supported cipher suites</p> + by the user.</p> + </desc> + </func> + + <func> + <name>cipher_suites(Supported, Version) -> ciphers()</name> + <fsummary>Returns a list of all default or + all supported cipher suites.</fsummary> + <type> + <v> Supported = default | all | anonymous </v> + <v> Version = protocol_version() </v> + </type> + <desc><p>Returns all default or all supported (except anonymous), + or all anonymous cipher suites for a + TLS version</p> </desc> </func> @@ -1019,6 +1060,21 @@ fun(srp, Username :: string(), UserState :: term()) -> </desc> </func> + <func> + <name>filter_cipher_suites(Suites, Filters) -> ciphers()</name> + <fsummary></fsummary> + <type> + <v> Suites = ciphers()</v> + <v> Filters = cipher_filters()</v> + </type> + <desc><p>Removes cipher suites if any of the filter functions + returns false for any part of the cipher suite. This function + also calls default filter functions to make sure the cipher + suites are supported by crypto. If no filter function is supplied for some + part the default behaviour is fun(Algorithm) -> true.</p> + </desc> + </func> + <func> <name>format_error(Reason) -> string()</name> <fsummary>Returns an error string.</fsummary> @@ -1116,6 +1172,22 @@ fun(srp, Username :: string(), UserState :: term()) -> <p>Returns the address and port number of the peer.</p> </desc> </func> + + <func> + <name>prepend_cipher_suites(Preferred, Suites) -> ciphers()</name> + <fsummary></fsummary> + <type> + <v>Preferred = ciphers() | cipher_filters() </v> + <v>Suites = ciphers() </v> + </type> + <desc><p>Make <c>Preferred</c> suites become the most preferred + suites that is put them at the head of the cipher suite list + <c>Suites</c> after removing them from <c>Suites</c> if + present. <c>Preferred</c> may be a list of cipher suits or a + list of filters in which case the filters are use on <c>Suites</c> to + extract the preferred cipher list. </p> + </desc> + </func> <func> <name>prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index c369c3c133..3ef33df719 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -153,7 +153,51 @@ ok</code> </section> </section> - <section> + <section> + <title>Customizing cipher suits</title> + + <p>Fetch default cipher suite list for an TLS/DTLS version. Change default + to all to get all possible cipher suites.</p> + <code type="erl">1> Default = ssl:cipher_suites(default, 'tlsv1.2'). + [#{cipher => aes_256_gcm,key_exchange => ecdhe_ecdsa, + mac => aead,prf => sha384}, ....] +</code> + + <p>In OTP 20 it is desirable to remove all cipher suites + that uses rsa kexchange (removed from default in 21) </p> + <code type="erl">2> NoRSA = + ssl:filter_cipher_suites(Default, + [{key_exchange, fun(rsa) -> false; + (_) -> true end}]). + [...] + </code> + + <p> Pick just a few suites </p> + <code type="erl"> 3> Suites = + ssl:filter_cipher_suites(Default, + [{key_exchange, fun(ecdh_ecdsa) -> true; + (_) -> false end}, + {cipher, fun(aes_128_cbc) ->true; + (_) ->false end}]). + [#{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa, + mac => sha256,prf => sha256}, + #{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa,mac => sha, + prf => default_prf}] + </code> + + <p> Make some particular suites the most preferred, or least + preferred by changing prepend to append.</p> + <code type="erl"> 4>ssl:prepend_cipher_suites(Suites, Default). + [#{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa, + mac => sha256,prf => sha256}, + #{cipher => aes_128_cbc,key_exchange => ecdh_ecdsa,mac => sha, + prf => default_prf}, + #{cipher => aes_256_cbc,key_exchange => ecdhe_ecdsa, + mac => sha384,prf => sha384}, ...] + </code> + </section> + + <section> <title>Using an Engine Stored Key</title> <p>Erlang ssl application is able to use private keys provided diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index 51ee8ec047..0f6344b6f7 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -21,7 +21,7 @@ -include("ssl_cipher.hrl"). --export([suites/1, all_suites/1, hmac_hash/3, ecc_curves/1, +-export([suites/1, all_suites/1, anonymous_suites/1,hmac_hash/3, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1, cookie_secret/0, cookie_timeout/0]). @@ -40,6 +40,12 @@ all_suites(Version) -> end, ssl_cipher:all_suites(corresponding_tls_version(Version))). +anonymous_suites(Version) -> + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + ssl_cipher:anonymous_suites(corresponding_tls_version(Version))). + hmac_hash(MacAlg, MacSecret, Value) -> tls_v1:hmac_hash(MacAlg, MacSecret, Value). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index a298012f26..0b035d31be 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -39,7 +39,9 @@ ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, cipher_suites/2, eccs/0, eccs/1, versions/0, +-export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2, + prepend_cipher_suites/2, append_cipher_suites/2, + eccs/0, eccs/1, versions/0, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc @@ -379,35 +381,91 @@ negotiated_protocol(#sslsocket{pid = Pid}) -> cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:old_erl_cipher_suite() | string()]. +-spec cipher_suites(erlang | openssl | all) -> + [ssl_cipher:old_erl_cipher_suite() | string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> - Version = tls_record:highest_protocol_version([]), - cipher_suites(erlang, Version); + [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default)]; + cipher_suites(openssl) -> - Version = tls_record:highest_protocol_version([]), - cipher_suites(openssl, Version); + [ssl_cipher:openssl_suite_name(Suite) || + Suite <- available_suites(default)]; + cipher_suites(all) -> - Version = tls_record:highest_protocol_version([]), - cipher_suites(all, Version). + [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all, tls_record:tls_version() | - dtls_record:dtls_version()) -> [ssl_cipher:old_erl_cipher_suite() | string()]. -%% Description: Returns all supported cipher suites. +-spec cipher_suites(default | all | anonymous, tls_record:tls_version() | dtls_record:dtls_version() | + tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Returns all default and all supported cipher suites for a +%% TLS/DTLS version %%-------------------------------------------------------------------- -cipher_suites(Type, Version) when Version == 'dtlsv1'; - Version == 'dtlsv1.2' -> - cipher_suites(Type, dtls_record:protocol_version(Version)); -cipher_suites(Type, Version) when is_atom(Version) -> - cipher_suites(Type, tls_record:protocol_version(Version)); -cipher_suites(erlang, Version) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default, Version)]; -cipher_suites(openssl, Version) -> - [ssl_cipher:openssl_suite_name(Suite) || Suite <- available_suites(default, Version)]; -cipher_suites(all, Version) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all, Version)]. +cipher_suites(Base, Version) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + cipher_suites(Base, tls_record:protocol_version(Version)); +cipher_suites(Base, Version) when Version == 'dtlsv1.2'; + Version == 'dtlsv1'-> + cipher_suites(Base, dtls_record:protocol_version(Version)); +cipher_suites(Base, Version) -> + [ssl_cipher:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. + +%%-------------------------------------------------------------------- +-spec filter_cipher_suites([ssl_cipher:erl_cipher_suite()], + [{key_exchange | cipher | mac | prf, fun()}] | []) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Removes cipher suites if any of the filter functions returns false +%% for any part of the cipher suite. This function also calls default filter functions +%% to make sure the cipher suite are supported by crypto. +%%-------------------------------------------------------------------- +filter_cipher_suites(Suites, Filters0) -> + #{key_exchange_filters := KexF, + cipher_filters := CipherF, + mac_filters := MacF, + prf_filters := PrfF} + = ssl_cipher:crypto_support_filters(), + Filters = #{key_exchange_filters => add_filter(proplists:get_value(key_exchange, Filters0), KexF), + cipher_filters => add_filter(proplists:get_value(cipher, Filters0), CipherF), + mac_filters => add_filter(proplists:get_value(mac, Filters0), MacF), + prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, + ssl_cipher:filter_suites(Suites, Filters). +%%-------------------------------------------------------------------- +-spec prepend_cipher_suites([ssl_cipher:erl_cipher_suite()] | + [{key_exchange | cipher | mac | prf, fun()}], + [ssl_cipher:erl_cipher_suite()]) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Make <Preferred> suites become the most prefered +%% suites that is put them at the head of the cipher suite list +%% and remove them from <Suites> if present. <Preferred> may be a +%% list of cipher suits or a list of filters in which case the +%% filters are use on Suites to extract the the preferred +%% cipher list. +%% -------------------------------------------------------------------- +prepend_cipher_suites([First | _] = Preferred, Suites0) when is_map(First) -> + Suites = Preferred ++ (Suites0 -- Preferred), + Suites; +prepend_cipher_suites(Filters, Suites) -> + Preferred = filter_cipher_suites(Suites, Filters), + Preferred ++ (Suites -- Preferred). +%%-------------------------------------------------------------------- +-spec append_cipher_suites(Deferred :: [ssl_cipher:erl_cipher_suite()] | + [{key_exchange | cipher | mac | prf, fun()}], + [ssl_cipher:erl_cipher_suite()]) -> + [ssl_cipher:erl_cipher_suite()]. +%% Description: Make <Deferred> suites suites become the +%% least prefered suites that is put them at the end of the cipher suite list +%% and removed them from <Suites> if present. +%% +%%-------------------------------------------------------------------- +append_cipher_suites([First | _] = Deferred, Suites0) when is_map(First)-> + Suites = (Suites0 -- Deferred) ++ Deferred, + Suites; +append_cipher_suites(Filters, Suites) -> + Deferred = filter_cipher_suites(Suites, Filters), + (Suites -- Deferred) ++ Deferred. %%-------------------------------------------------------------------- -spec eccs() -> tls_v1:curves(). @@ -661,14 +719,21 @@ tls_version({254, _} = Version) -> %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- - %% Possible filters out suites not supported by crypto -available_suites(default, Version) -> +available_suites(default) -> + Version = tls_record:highest_protocol_version([]), ssl_cipher:filter_suites(ssl_cipher:suites(Version)); - -available_suites(all, Version) -> +available_suites(all) -> + Version = tls_record:highest_protocol_version([]), ssl_cipher:filter_suites(ssl_cipher:all_suites(Version)). +supported_suites(default, Version) -> + ssl_cipher:suites(Version); +supported_suites(all, Version) -> + ssl_cipher:all_suites(Version); +supported_suites(anonymous, Version) -> + ssl_cipher:anonymous_suites(Version). + do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> tls_socket:listen(Transport, Port, Config); @@ -1178,17 +1243,21 @@ handle_cipher_option(Value, Version) when is_list(Value) -> binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); + default_binary_suites(Version); +binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) -> + Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], + binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - All = ssl_cipher:all_suites(tls_version(Version)), + All = ssl_cipher:all_suites(Version) ++ + ssl_cipher:anonymous_suites(Version), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); + default_binary_suites(Version); Ciphers -> Ciphers end; @@ -1201,6 +1270,9 @@ binary_cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). +default_binary_suites(Version) -> + ssl_cipher:filter_suites(ssl_cipher:suites(Version)). + tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, cipher => Cipher, @@ -1209,9 +1281,19 @@ tuple_to_map({Kex, Cipher, Mac}) -> tuple_to_map({Kex, Cipher, Mac, Prf}) -> #{key_exchange => Kex, cipher => Cipher, - mac => Mac, + mac => tuple_to_map_mac(Cipher, Mac), prf => Prf}. +%% Backwards compatible +tuple_to_map_mac(aes_128_gcm, _) -> + aead; +tuple_to_map_mac(aes_256_gcm, _) -> + aead; +tuple_to_map_mac(chacha20_poly1305, _) -> + aead; +tuple_to_map_mac(_, MAC) -> + MAC. + handle_eccs_option(Value, Version) when is_list(Value) -> {_Major, Minor} = tls_version(Version), try tls_v1:ecc_curves(Minor, Value) of @@ -1490,3 +1572,8 @@ reject_alpn_next_prot_options([Opt| AlpnNextOpts], Opts) -> false -> reject_alpn_next_prot_options(AlpnNextOpts, Opts) end. + +add_filter(undefined, Filters) -> + Filters; +add_filter(Filter, Filters) -> + [Filter | Filters]. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 7c5cff3665..1d645e5782 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -36,9 +36,11 @@ -export([security_parameters/2, security_parameters/3, suite_definition/1, erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, - suite/1, suites/1, all_suites/1, - ec_keyed_suites/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + suite/1, suites/1, all_suites/1, crypto_support_filters/0, + ec_keyed_suites/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, + srp_suites/0, srp_suites_anon/0, + rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, + filter/2, filter_suites/1, filter_suites/2, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1]). @@ -53,7 +55,7 @@ -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type erl_cipher_suite() :: #{key_exchange := key_algo(), cipher := cipher(), - mac := hash(), + mac := hash() | aead, prf := hash() | default_prf %% Old cipher suites, version dependent }. -type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 @@ -321,12 +323,12 @@ suites({_, Minor}) -> all_suites({3, _} = Version) -> suites(Version) ++ chacha_suites(Version) - ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) ++ des_suites(Version) ++ rsa_suites(Version); + all_suites(Version) -> dtls_v1:all_suites(Version). %%-------------------------------------------------------------------- @@ -350,12 +352,12 @@ chacha_suites(_) -> %% if explicitly set by user. Intended only for testing. %%-------------------------------------------------------------------- anonymous_suites({3, N}) -> - anonymous_suites(N); + srp_suites_anon() ++ anonymous_suites(N); anonymous_suites({254, _} = Version) -> - anonymous_suites(dtls_v1:corresponding_tls_version(Version)) - -- [?TLS_DH_anon_WITH_RC4_128_MD5]; + dtls_v1:anonymous_suites(Version); anonymous_suites(N) when N >= 3 -> + psk_suites_anon(N) ++ [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, ?TLS_DH_anon_WITH_AES_256_GCM_SHA384, ?TLS_DH_anon_WITH_AES_128_CBC_SHA256, @@ -364,20 +366,20 @@ anonymous_suites(N) ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA, ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, ?TLS_DH_anon_WITH_RC4_128_MD5]; - -anonymous_suites(2) -> +anonymous_suites(2 = N) -> + psk_suites_anon(N) ++ [?TLS_ECDH_anon_WITH_AES_128_CBC_SHA, ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA, ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, ?TLS_DH_anon_WITH_DES_CBC_SHA, ?TLS_DH_anon_WITH_RC4_128_MD5]; - anonymous_suites(N) when N == 0; N == 1 -> - [?TLS_DH_anon_WITH_RC4_128_MD5, - ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, - ?TLS_DH_anon_WITH_DES_CBC_SHA - ]. + psk_suites_anon(N) ++ + [?TLS_DH_anon_WITH_RC4_128_MD5, + ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, + ?TLS_DH_anon_WITH_DES_CBC_SHA + ]. %%-------------------------------------------------------------------- -spec psk_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. @@ -390,41 +392,52 @@ psk_suites({3, N}) -> psk_suites(N) when N >= 3 -> [ - ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, - ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256 + ] ++ psk_suites(0); +psk_suites(_) -> + [?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, + ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, + ?TLS_RSA_PSK_WITH_RC4_128_SHA]. + +%%-------------------------------------------------------------------- +-spec psk_suites_anon(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the anonymous PSK cipher suites, only supported +%% if explicitly set by user. +%%-------------------------------------------------------------------- +psk_suites_anon({3, N}) -> + psk_suites_anon(N); +psk_suites_anon(N) + when N >= 3 -> + [ + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_PSK_WITH_AES_256_GCM_SHA384, ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_PSK_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, ?TLS_PSK_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 - ] ++ psk_suites(0); -psk_suites(_) -> - [?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, - ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, + ] ++ psk_suites_anon(0); +psk_suites_anon(_) -> + [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, ?TLS_PSK_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, ?TLS_PSK_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_PSK_WITH_3DES_EDE_CBC_SHA, ?TLS_ECDHE_PSK_WITH_RC4_128_SHA, ?TLS_DHE_PSK_WITH_RC4_128_SHA, - ?TLS_RSA_PSK_WITH_RC4_128_SHA, ?TLS_PSK_WITH_RC4_128_SHA]. - %%-------------------------------------------------------------------- -spec srp_suites() -> [cipher_suite()]. %% @@ -432,15 +445,24 @@ psk_suites(_) -> %% if explicitly set by user. %%-------------------------------------------------------------------- srp_suites() -> - [?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, + [?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA, ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA, - ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. + +%%-------------------------------------------------------------------- +-spec srp_suites_anon() -> [cipher_suite()]. +%% +%% Description: Returns a list of the SRP anonymous cipher suites, only supported +%% if explicitly set by user. +%%-------------------------------------------------------------------- +srp_suites_anon() -> + [?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA, + ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA, + ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA]. + %%-------------------------------------------------------------------- -spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -750,32 +772,32 @@ suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => psk, @@ -1115,42 +1137,42 @@ suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_dss, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_dss, @@ -1160,74 +1182,74 @@ suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_dss, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_anon, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; %% RFC 5289 ECC AES-GCM Cipher Suites suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}; suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => dhe_rsa, cipher => chacha20_poly1305, - mac => null, + mac => aead, prf => sha256}. %%-------------------------------------------------------------------- @@ -1428,32 +1450,32 @@ suite(#{key_exchange := rsa_psk, %%% TLS 1.2 PSK Cipher Suites RFC 5487 suite(#{key_exchange := psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := rsa_psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := rsa_psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := psk, @@ -1739,119 +1761,119 @@ suite(#{key_exchange := ecdh_rsa, %% RFC 5288 AES-GCM Cipher Suites suite(#{key_exchange := rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dhe_dss, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dhe_dss, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_dss, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_dss, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := dh_anon, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := dh_anon, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites suite(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdh_ecdsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdh_ecdsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdhe_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdhe_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; suite(#{key_exchange := ecdh_rsa, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; suite(#{key_exchange := ecdh_rsa, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites suite(#{key_exchange := ecdhe_rsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; suite(#{key_exchange := ecdhe_ecdsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; suite(#{key_exchange := dhe_rsa, cipher := chacha20_poly1305, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. @@ -2011,9 +2033,9 @@ openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384. %%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite(). +-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite(). %% -%% Description: Return openssl cipher suite name. +%% Description: Return openssl cipher suite name if possible %%------------------------------------------------------------------- openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> "DHE-RSA-AES256-SHA"; @@ -2223,38 +2245,74 @@ filter(DerCert, Ciphers) -> {_, ecdsa} -> Ciphers1 -- rsa_signed_suites() end. - %%-------------------------------------------------------------------- --spec filter_suites([cipher_suite()]) -> [cipher_suite()]. +-spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) -> + [erl_cipher_suite()] | [cipher_suite()]. +%% +%% Description: Filter suites using supplied filter funs +%%------------------------------------------------------------------- +filter_suites(Suites, Filters) -> + ApplyFilters = fun(Suite) -> + filter_suite(Suite, Filters) + end, + lists:filter(ApplyFilters, Suites). + +filter_suite(#{key_exchange := KeyExchange, + cipher := Cipher, + mac := Hash, + prf := Prf}, + #{key_exchange_filters := KeyFilters, + cipher_filters := CipherFilters, + mac_filters := HashFilters, + prf_filters := PrfFilters}) -> + all_filters(KeyExchange, KeyFilters) andalso + all_filters(Cipher, CipherFilters) andalso + all_filters(Hash, HashFilters) andalso + all_filters(Prf, PrfFilters); +filter_suite(Suite, Filters) -> + filter_suite(suite_definition(Suite), Filters). + +%%-------------------------------------------------------------------- +-spec filter_suites([erl_cipher_suite()] | [cipher_suite()]) -> + [erl_cipher_suite()] | [cipher_suite()]. %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- -filter_suites(Suites = [Value|_]) when is_map(Value) -> - Algos = crypto:supports(), - Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun(#{key_exchange := KeyExchange, - cipher := Cipher, - mac := Hash, - prf := Prf}) -> - is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, Hashs) andalso - is_acceptable_prf(Prf, Hashs) - end, Suites); - filter_suites(Suites) -> + Filters = crypto_support_filters(), + filter_suites(Suites, Filters). + +all_filters(_, []) -> + true; +all_filters(Value, [Filter| Rest]) -> + case Filter(Value) of + true -> + all_filters(Value, Rest); + false -> + false + end. +crypto_support_filters() -> Algos = crypto:supports(), Hashs = proplists:get_value(hashs, Algos), - lists:filter(fun(Suite) -> - #{key_exchange := KeyExchange, - cipher := Cipher, - mac := Hash, - prf := Prf} = suite_definition(Suite), - is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso - is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso - is_acceptable_hash(Hash, Hashs) andalso - is_acceptable_prf(Prf, Hashs) - end, Suites). + #{key_exchange_filters => + [fun(KeyExchange) -> + is_acceptable_keyexchange(KeyExchange, + proplists:get_value(public_keys, Algos)) + end], + cipher_filters => + [fun(Cipher) -> + is_acceptable_cipher(Cipher, + proplists:get_value(ciphers, Algos)) + end], + mac_filters => + [fun(Hash) -> + is_acceptable_hash(Hash, Hashs) + end], + prf_filters => + [fun(Prf) -> + is_acceptable_prf(Prf, + proplists:get_value(hashs, Algos)) + end]}. is_acceptable_keyexchange(KeyExchange, _Algos) when KeyExchange == psk; KeyExchange == null -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index d046145dff..2031735a71 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1148,8 +1148,8 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, StateName, State); handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, _) -> - Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, {StateName, Msg}, State). + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, Msg}), + handle_own_alert(Alert, Version, StateName, State). handle_call({application_data, _Data}, _, _, _, _) -> %% In renegotiation priorities handshake, send data when handshake is finished diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index f13bd53a7c..2781203557 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -163,7 +163,8 @@ api_tests() -> server_name_indication_option, accept_pool, prf, - socket_options + socket_options, + cipher_suites ]. api_tests_tls() -> @@ -207,7 +208,7 @@ tls_cipher_tests() -> rc4_ecdsa_cipher_suites]. cipher_tests() -> - [cipher_suites, + [old_cipher_suites, cipher_suites_mix, ciphers_rsa_signed_certs, ciphers_rsa_signed_certs_openssl_names, @@ -704,8 +705,6 @@ secret_connection_info(Config) when is_list(Config) -> ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), - - Version = ssl_test_lib:protocol_version(Config), ssl_test_lib:check_result(Server, true, Client, true), @@ -1130,11 +1129,16 @@ fallback(Config) when is_list(Config) -> %%-------------------------------------------------------------------- cipher_format() -> - [{doc, "Test that cipher conversion from tuples to binarys works"}]. + [{doc, "Test that cipher conversion from maps | tuples | stings to binarys works"}]. cipher_format(Config) when is_list(Config) -> - {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), - ssl:close(Socket). - + {ok, Socket0} = ssl:listen(0, [{ciphers, ssl:cipher_suites(default, 'tlsv1.2')}]), + ssl:close(Socket0), + %% Legacy + {ok, Socket1} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket1), + {ok, Socket2} = ssl:listen(0, [{ciphers, ssl:cipher_suites(openssl)}]), + ssl:close(Socket2). + %%-------------------------------------------------------------------- peername() -> @@ -1285,20 +1289,76 @@ sockname_result(S) -> ssl:sockname(S). %%-------------------------------------------------------------------- + cipher_suites() -> - [{doc,"Test API function cipher_suites/0"}]. + [{doc,"Test API function cipher_suites/2, filter_cipher_suites/2" + " and prepend|append_cipher_suites/2"}]. cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuiteTLS1_0TLS1_1 = {rsa,'3des_ede_cbc',sha}, - MandatoryCipherSuiteTLS1_0TLS1_2 = {rsa,'aes_128_cbc',sha} , - [_|_] = Suites = ssl:cipher_suites(), - AllSuites = ssl:cipher_suites(all), - %% The mandantory suites will no longer be supported by default - %% due to security reasons - true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_1, AllSuites), - true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_2, AllSuites), + MandatoryCipherSuiteTLS1_0TLS1_1 = #{key_exchange => rsa, + cipher => '3des_ede_cbc', + mac => sha, + prf => default_prf}, + MandatoryCipherSuiteTLS1_0TLS1_2 = #{key_exchange =>rsa, + cipher => 'aes_128_cbc', + mac => sha, + prf => default_prf}, + Version = ssl_test_lib:protocol_version(Config), + All = [_|_] = ssl:cipher_suites(all, Version), + Default = [_|_] = ssl:cipher_suites(default, Version), + Anonymous = [_|_] = ssl:cipher_suites(anonymous, Version), + true = length(Default) < length(All), + Filters = [{key_exchange, + fun(dhe_rsa) -> + true; + (_) -> + false + end + }, + {cipher, + fun(aes_256_cbc) -> + true; + (_) -> + false + end + }, + {mac, + fun(sha) -> + true; + (_) -> + false + end + } + ], + Cipher = #{cipher => aes_256_cbc, + key_exchange => dhe_rsa, + mac => sha, + prf => default_prf}, + [Cipher] = ssl:filter_cipher_suites(All, Filters), + [Cipher | Rest0] = ssl:prepend_cipher_suites([Cipher], Default), + [Cipher | Rest0] = ssl:prepend_cipher_suites(Filters, Default), + true = lists:member(Cipher, Default), + false = lists:member(Cipher, Rest0), + [Cipher | Rest1] = lists:reverse(ssl:append_cipher_suites([Cipher], Default)), + [Cipher | Rest1] = lists:reverse(ssl:append_cipher_suites(Filters, Default)), + true = lists:member(Cipher, Default), + false = lists:member(Cipher, Rest1), + [] = lists:dropwhile(fun(X) -> not lists:member(X, Default) end, Anonymous), + [] = lists:dropwhile(fun(X) -> not lists:member(X, All) end, Anonymous), + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_1, All), + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_2, All). + +%%-------------------------------------------------------------------- + +old_cipher_suites() -> + [{doc,"Test API function cipher_suites/0"}]. + +old_cipher_suites(Config) when is_list(Config) -> + MandatoryCipherSuite = {rsa, '3des_ede_cbc', sha}, + [_|_] = Suites = ssl:cipher_suites(), Suites = ssl:cipher_suites(erlang), - [_|_] =ssl:cipher_suites(openssl). + [_|_] = ssl:cipher_suites(openssl), + true = lists:member(MandatoryCipherSuite, ssl:cipher_suites(all)). %%-------------------------------------------------------------------- cipher_suites_mix() -> @@ -3800,9 +3860,23 @@ rizzo() -> vunrable to Rizzo/Dungon attack"}]. rizzo(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}, + {cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), + run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_rizzo, []}). %%-------------------------------------------------------------------- @@ -3814,8 +3888,13 @@ no_rizzo_rc4(Config) when is_list(Config) -> Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), %% Test uses RSA certs - Ciphers = ssl_test_lib:rc4_suites(NVersion) -- [{ecdhe_ecdsa,rc4_128,sha}, - {ecdh_ecdsa,rc4_128,sha}], + Ciphers = ssl:filter_cipher_suites(ssl_test_lib:rc4_suites(NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3826,10 +3905,21 @@ rizzo_one_n_minus_one(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), - AllSuites = ssl_test_lib:available_suites(NVersion), - Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, NVersion), + [{key_exchange, + fun(Alg) when Alg == ecdh_rsa; Alg == ecdhe_rsa-> + true; + (_) -> + false + end}, + {cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, - {?MODULE, send_recv_result_active_rizzo, []}). + {?MODULE, send_recv_result_active_rizzo, []}). rizzo_zero_n() -> [{doc,"Test that the 0/n-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. @@ -3838,8 +3928,13 @@ rizzo_zero_n(Config) when is_list(Config) -> Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), NVersion = ssl_test_lib:protocol_version(Config, tuple), - AllSuites = ssl_test_lib:available_suites(NVersion), - Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, NVersion), + [{cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3847,9 +3942,16 @@ rizzo_disabled() -> [{doc,"Test that the mitigation of Rizzo/Dungon attack can be explicitly disabled"}]. rizzo_disabled(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, NVersion), + [{cipher, + fun(rc4_128) -> + false; + (_) -> + true + end}]), run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -4624,19 +4726,21 @@ rizzo_test(Cipher, Config, Version, Mfa) -> [{Cipher, Error}] end. -client_server_opts({KeyAlgo,_,_}, Config) +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == rsa orelse KeyAlgo == dhe_rsa orelse - KeyAlgo == ecdhe_rsa -> + KeyAlgo == ecdhe_rsa orelse + KeyAlgo == rsa_psk orelse + KeyAlgo == srp_rsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> {ssl_test_lib:ssl_options(client_dsa_opts, Config), ssl_test_lib:ssl_options(server_dsa_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_ecdsa orelse KeyAlgo == ecdhe_ecdsa -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_ecdsa orelse KeyAlgo == ecdhe_ecdsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdsa_opts, Config)}; -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> +client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_rsa -> {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7e983f5079..26ef311615 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1024,59 +1024,50 @@ string_regex_filter(Str, Search) when is_list(Str) -> string_regex_filter(_Str, _Search) -> false. -anonymous_suites({3,_ } = Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]; -anonymous_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version)), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. - -psk_suites({3,_ } = Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]; -psk_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version)), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. - -psk_anon_suites({3,_ } = Version) -> - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]; -psk_anon_suites(DTLSVersion) -> - Version = dtls_v1:corresponding_tls_version(DTLSVersion), - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite), - not ssl_cipher:is_stream_ciphersuite(tuple_to_map(Suite))]. +anonymous_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)],[]). +psk_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []). + +psk_anon_suites(Version) -> + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], + [{key_exchange, + fun(psk) -> + true; + (psk_dhe) -> + true; + (_) -> + false + end}]). + srp_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <- [{srp_anon,'3des_ede_cbc', sha}, - {srp_rsa, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_rsa, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}, - {srp_rsa, aes_256_cbc, sha}]])]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + [{key_exchange, + fun(srp_rsa) -> + true; + (_) -> + false + end}]). srp_anon_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <-[{srp_anon, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}]])]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], + []). srp_dss_suites() -> - [ssl_cipher:erl_suite_definition(Suite) || - Suite <- - ssl_cipher:filter_suites([tuple_to_map(S) || - S <- [{srp_dss, '3des_ede_cbc', sha}, - {srp_dss, aes_128_cbc, sha}, - {srp_dss, aes_256_cbc, sha}]])]. - + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <- ssl_cipher:srp_suites()], + [{key_exchange, + fun(srp_dss) -> + true; + (_) -> + false + end}]). chacha_suites(Version) -> [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + rc4_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:rc4_suites(Version))]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). des_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:des_suites(Version))]. + ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, @@ -1417,7 +1408,9 @@ filter_suites(Ciphers0, AtomVersion) -> Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:psk_suites_anon(Version) ++ ssl_cipher:srp_suites() + ++ ssl_cipher:srp_suites_anon() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), Supported2 = [ssl_cipher:erl_suite_definition(S) || S <- Supported1], diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml index ea23cca2ee..33f29f38da 100644 --- a/lib/stdlib/doc/src/assert_hrl.xml +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -93,7 +93,7 @@ erlc -DNOASSERT=true *.erl</code> <taglist> <tag><c>assert(BoolExpr)</c></tag> <item></item> - <tag><c>URKAassert(BoolExpr, Comment)</c></tag> + <tag><c>assert(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>true</c>.</p> diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl index 2fbaeba0b2..2ec89e7d8a 100644 --- a/lib/stdlib/include/assert.hrl +++ b/lib/stdlib/include/assert.hrl @@ -309,7 +309,7 @@ {unexpected_success, __V}]}) catch Class:Term -> ok; - __C:__T -> + __C:__T:__S -> erlang:error({assertException, [{module, ?MODULE}, {line, ?LINE}, @@ -318,8 +318,7 @@ "{ "++(??Class)++" , "++(??Term) ++" , [...] }"}, {unexpected_exception, - {__C, __T, - erlang:get_stacktrace()}}]}) + {__C, __T, __S}}]}) end end)()) end). @@ -338,7 +337,7 @@ {unexpected_success, __V}]}) catch Class:Term -> ok; - __C:__T -> + __C:__T:__S -> erlang:error({assertException, [{module, ?MODULE}, {line, ?LINE}, @@ -348,8 +347,7 @@ "{ "++(??Class)++" , "++(??Term) ++" , [...] }"}, {unexpected_exception, - {__C, __T, - erlang:get_stacktrace()}}]}) + {__C, __T, __S}}]}) end end)()) end). @@ -378,7 +376,7 @@ try (Expr) of _ -> ok catch - __C:__T -> + __C:__T:__S -> case __C of Class -> case __T of @@ -391,9 +389,7 @@ "{ "++(??Class)++" , " ++(??Term)++" , [...] }"}, {unexpected_exception, - {__C, __T, - erlang:get_stacktrace() - }}]}); + {__C, __T, __S}}]}); _ -> ok end; _ -> ok @@ -407,7 +403,7 @@ try (Expr) of _ -> ok catch - __C:__T -> + __C:__T:__S -> case __C of Class -> case __T of @@ -421,9 +417,7 @@ "{ "++(??Class)++" , " ++(??Term)++" , [...] }"}, {unexpected_exception, - {__C, __T, - erlang:get_stacktrace() - }}]}); + {__C, __T, __S}}]}); _ -> ok end; _ -> ok diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 9a447af5b7..3597e61c26 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1034,8 +1034,8 @@ appcall(App, M, F, Args) -> try apply(M, F, Args) catch - error:undef -> - case erlang:get_stacktrace() of + error:undef:S -> + case S of [{M,F,Args,_}|_] -> Arity = length(Args), io:format("Call to ~w:~w/~w in application ~w failed.\n", diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 4e3fe0e5c1..e1a36abc70 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1288,8 +1288,8 @@ init(Parent, Server) -> catch exit:normal -> exit(normal); - _:Bad -> - bug_found(no_name, Op, Bad, From), + _:Bad:Stacktrace -> + bug_found(no_name, Op, Bad, Stacktrace, From), exit(Bad) % give up end end. @@ -1371,8 +1371,8 @@ do_apply_op(Op, From, Head, N) -> catch exit:normal -> exit(normal); - _:Bad -> - bug_found(Head#head.name, Op, Bad, From), + _:Bad:Stacktrace -> + bug_found(Head#head.name, Op, Bad, Stacktrace, From), open_file_loop(Head, N) end. @@ -1581,7 +1581,7 @@ apply_op(Op, From, Head, N) -> ok end. -bug_found(Name, Op, Bad, From) -> +bug_found(Name, Op, Bad, Stacktrace, From) -> case dets_utils:debug_mode() of true -> %% If stream_op/5 found more requests, this is not @@ -1590,7 +1590,7 @@ bug_found(Name, Op, Bad, From) -> ("** dets: Bug was found when accessing table ~tw,~n" "** dets: operation was ~tp and reply was ~tw.~n" "** dets: Stacktrace: ~tw~n", - [Name, Op, Bad, erlang:get_stacktrace()]); + [Name, Op, Bad, Stacktrace]); false -> error_logger:format ("** dets: Bug was found when accessing table ~tw~n", diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 17f55ebdc2..4c8ea9e82b 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -377,7 +377,8 @@ corrupt_reason(Head, Reason0) -> no_disk_map -> Reason0; DM -> - ST = erlang:get_stacktrace(), + {current_stacktrace, ST} = + erlang:process_info(self(), current_stacktrace), PD = get(), {Reason0, ST, PD, DM} end, diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 132f8efbbe..beea9927d2 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -283,8 +283,7 @@ start(EscriptOptions) -> throw:Str -> io:format("escript: ~ts\n", [Str]), my_halt(127); - _:Reason -> - Stk = erlang:get_stacktrace(), + _:Reason:Stk -> io:format("escript: Internal error: ~tp\n", [Reason]), io:format("~tp\n", [Stk]), my_halt(127) @@ -759,8 +758,8 @@ run(Module, Args) -> Module:main(Args), my_halt(0) catch - Class:Reason -> - fatal(format_exception(Class, Reason)) + Class:Reason:StackTrace -> + fatal(format_exception(Class, Reason, StackTrace)) end. -spec interpret(_, _, _, _) -> no_return(). @@ -793,8 +792,8 @@ interpret(Forms, HasRecs, File, Args) -> end}), my_halt(0) catch - Class:Reason -> - fatal(format_exception(Class, Reason)) + Class:Reason:StackTrace -> + fatal(format_exception(Class, Reason, StackTrace)) end. report_errors(Errors) -> @@ -873,7 +872,7 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) -> {value,_V,Bs} = erl_eval:expr(E, Bs0, Lf, Ef, RBs1), eval_exprs(Es, Bs, Lf, Ef, RBs). -format_exception(Class, Reason) -> +format_exception(Class, Reason, StackTrace) -> Enc = encoding(), P = case Enc of latin1 -> "P"; @@ -882,7 +881,6 @@ format_exception(Class, Reason) -> PF = fun(Term, I) -> io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50]) end, - StackTrace = erlang:get_stacktrace(), StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc). @@ -916,8 +914,8 @@ hidden_apply(App, M, F, Args) -> try apply(fun() -> M end(), F, Args) catch - error:undef -> - case erlang:get_stacktrace() of + error:undef:StackTrace -> + case StackTrace of [{M,F,Args,_} | _] -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index adef1640be..039ab45868 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -882,10 +882,10 @@ tab2file(Tab, File, Options) -> _ = disk_log:close(Name), _ = file:delete(File), exit(ExReason); - error:ErReason -> + error:ErReason:StackTrace -> _ = disk_log:close(Name), _ = file:delete(File), - erlang:raise(error,ErReason,erlang:get_stacktrace()) + erlang:raise(error,ErReason,StackTrace) end catch throw:TReason2 -> @@ -1060,9 +1060,9 @@ file2tab(File, Opts) -> exit:ExReason -> ets:delete(Tab), exit(ExReason); - error:ErReason -> + error:ErReason:StackTrace -> ets:delete(Tab), - erlang:raise(error,ErReason,erlang:get_stacktrace()) + erlang:raise(error,ErReason,StackTrace) end after _ = disk_log:close(Name) diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 3aeaff8dc4..7f74e71136 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1314,9 +1314,9 @@ infun(W) -> {cont, W#w{in = NFun}, Objs}; Error -> error(Error, W1) - catch Class:Reason -> + catch Class:Reason:Stacktrace -> cleanup(W1), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end. outfun(A, #w{inout_value = Val} = W) when Val =/= no_value -> @@ -1336,9 +1336,9 @@ outfun(A, W) -> W#w{out = NF}; Error -> error(Error, W1) - catch Class:Reason -> + catch Class:Reason:Stacktrace -> cleanup(W1), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end. is_keypos(Keypos) when is_integer(Keypos), Keypos > 0 -> diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index ac172325b5..77a46419f6 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -109,7 +109,7 @@ -define( STACKTRACE(), - try throw(ok) catch _ -> erlang:get_stacktrace() end). + element(2, erlang:process_info(self(), current_stacktrace))). %%%========================================================================= %%% API @@ -369,7 +369,7 @@ init_it(Mod, Args) -> {ok, Mod:init(Args)} catch throw:R -> {ok, R}; - Class:R -> {'EXIT', Class, R, erlang:get_stacktrace()} + Class:R:S -> {'EXIT', Class, R, S} end. %%%======================================================================== @@ -634,7 +634,7 @@ try_dispatch(Mod, Func, Msg, State) -> catch throw:R -> {ok, R}; - error:undef = R when Func == handle_info -> + error:undef = R:Stacktrace when Func == handle_info -> case erlang:function_exported(Mod, handle_info, 2) of false -> error_logger:warning_msg("** Undefined handle_info in ~p~n" @@ -642,10 +642,10 @@ try_dispatch(Mod, Func, Msg, State) -> [Mod, Msg]), {ok, {noreply, State}}; true -> - {'EXIT', error, R, erlang:get_stacktrace()} + {'EXIT', error, R, Stacktrace} end; - Class:R -> - {'EXIT', Class, R, erlang:get_stacktrace()} + Class:R:Stacktrace -> + {'EXIT', Class, R, Stacktrace} end. try_handle_call(Mod, Msg, From, State) -> @@ -654,8 +654,8 @@ try_handle_call(Mod, Msg, From, State) -> catch throw:R -> {ok, R}; - Class:R -> - {'EXIT', Class, R, erlang:get_stacktrace()} + Class:R:Stacktrace -> + {'EXIT', Class, R, Stacktrace} end. try_terminate(Mod, Reason, State) -> @@ -666,8 +666,8 @@ try_terminate(Mod, Reason, State) -> catch throw:R -> {ok, R}; - Class:R -> - {'EXIT', Class, R, erlang:get_stacktrace()} + Class:R:Stacktrace -> + {'EXIT', Class, R, Stacktrace} end; false -> {ok, ok} diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 1a7736fc7e..f95b2ea9cd 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -365,7 +365,7 @@ event_type(Type) -> -define( STACKTRACE(), - try throw(ok) catch _ -> erlang:get_stacktrace() end). + element(2, erlang:process_info(self(), current_stacktrace))). -define(not_sys_debug, []). %% @@ -590,11 +590,11 @@ call_dirty(ServerRef, Request, Timeout, T) -> {ok,Reply} -> Reply catch - Class:Reason -> + Class:Reason:Stacktrace -> erlang:raise( Class, {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - erlang:get_stacktrace()) + Stacktrace) end. call_clean(ServerRef, Request, Timeout, T) -> @@ -608,9 +608,8 @@ call_clean(ServerRef, Request, Timeout, T) -> ServerRef, '$gen_call', Request, T) of Result -> {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason, - erlang:get_stacktrace()} + catch Class:Reason:Stacktrace -> + {Ref,Class,Reason,Stacktrace} end end), Mref = monitor(process, Pid), @@ -697,8 +696,7 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> catch Result -> init_result(Starter, Parent, ServerRef, Module, Result, Opts); - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> Name = gen:get_proc_name(ServerRef), gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -1584,8 +1582,8 @@ call_callback_mode(#state{module = Module} = S) -> catch CallbackMode -> callback_mode_result(S, CallbackMode); - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] + Class:Reason:Stacktrace -> + [Class,Reason,Stacktrace] end. callback_mode_result(S, CallbackMode) -> @@ -1638,8 +1636,8 @@ call_state_function( catch Result -> {Result,S}; - Class:Reason -> - [Class,Reason,erlang:get_stacktrace()] + Class:Reason:Stacktrace -> + [Class,Reason,Stacktrace] end. @@ -1827,8 +1825,7 @@ terminate( _ -> ok catch _ -> ok; - C:R -> - ST = erlang:get_stacktrace(), + C:R:ST -> error_info( C, R, ST, S, Q, format_status(terminate, get(), S)), diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 8e10cbe93b..1991585c13 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -231,8 +231,8 @@ init_p(Parent, Ancestors, Fun) when is_function(Fun) -> try Fun() catch - Class:Reason -> - exit_p(Class, Reason, erlang:get_stacktrace()) + Class:Reason:Stacktrace -> + exit_p(Class, Reason, Stacktrace) end. -spec init_p(pid(), [pid()], atom(), atom(), [term()]) -> term(). @@ -246,8 +246,8 @@ init_p_do_apply(M, F, A) -> try apply(M, F, A) catch - Class:Reason -> - exit_p(Class, Reason, erlang:get_stacktrace()) + Class:Reason:Stacktrace -> + exit_p(Class, Reason, Stacktrace) end. -spec wake_up(atom(), atom(), [term()]) -> term(). @@ -256,8 +256,8 @@ wake_up(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> try apply(M, F, A) catch - Class:Reason -> - exit_p(Class, Reason, erlang:get_stacktrace()) + Class:Reason:Stacktrace -> + exit_p(Class, Reason, Stacktrace) end. exit_p(Class, Reason, Stacktrace) -> diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f11f9d0a0b..3a66f6930b 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -301,11 +301,11 @@ eval(QH, Options) -> post_funs(Post) end end - catch Term -> - case erlang:get_stacktrace() of + catch throw:Term:Stacktrace -> + case Stacktrace of [?THROWN_ERROR | _] -> Term; - Stacktrace -> + _ -> erlang:raise(throw, Term, Stacktrace) end end @@ -359,11 +359,11 @@ fold(Fun, Acc0, QH, Options) -> post_funs(Post) end end - catch Term -> - case erlang:get_stacktrace() of + catch throw:Term:Stacktrace -> + case Stacktrace of [?THROWN_ERROR | _] -> Term; - Stacktrace -> + _ -> erlang:raise(throw, Term, Stacktrace) end end @@ -457,11 +457,11 @@ info(QH, Options) -> debug -> % Not documented. Intended for testing only. Info end - catch Term -> - case erlang:get_stacktrace() of + catch throw:Term:Stacktrace -> + case Stacktrace of [?THROWN_ERROR | _] -> Term; - Stacktrace -> + _ -> erlang:raise(throw, Term, Stacktrace) end end @@ -1056,9 +1056,9 @@ cursor_process(H, GUnique, GCache, TmpDir, SpawnOptions, MaxList, TmpUsage) -> Prep = prepare_qlc(H, not_a_list, GUnique, GCache, TmpDir, MaxList, TmpUsage), setup_qlc(Prep, Setup) - catch Class:Reason -> - Parent ! {self(), {caught, Class, Reason, - erlang:get_stacktrace()}}, + catch Class:Reason:Stacktrace -> + Parent ! {self(), + {caught, Class, Reason, Stacktrace}}, exit(normal) end, Parent ! {self(), ok}, @@ -1075,8 +1075,8 @@ parent_fun(Pid, Parent) -> {TPid, {parent_fun, Fun}} -> V = try {value, Fun()} - catch Class:Reason -> - {parent_fun_caught, Class, Reason, erlang:get_stacktrace()} + catch Class:Reason:Stacktrace -> + {parent_fun_caught, Class, Reason, Stacktrace} end, TPid ! {Parent, V}, parent_fun(Pid, Parent); @@ -1101,9 +1101,9 @@ reply(Parent, MonRef, Post, Cont) -> throw_error(Cont) end catch - Class:Reason -> + Class:Reason:Stacktrace -> post_funs(Post), - Message = {caught, Class, Reason, erlang:get_stacktrace()}, + Message = {caught, Class, Reason, Stacktrace}, Parent ! {self(), Message}, exit(normal) end, @@ -1392,9 +1392,8 @@ next_loop(Pid, L, N) when N =/= 0 -> {caught, throw, Error, [?THROWN_ERROR | _]} -> Error; {caught, Class, Reason, Stacktrace} -> - CurrentStacktrace = try erlang:error(foo) - catch error:_ -> erlang:get_stacktrace() - end, + {current_stacktrace, CurrentStacktrace} = + erlang:process_info(self(), current_stacktrace), erlang:raise(Class, Reason, Stacktrace ++ CurrentStacktrace); error -> erlang:error({qlc_cursor_pid_no_longer_exists, Pid}) @@ -2627,9 +2626,9 @@ table_handle(#qlc_table{trav_fun = TraverseFun, trav_MS = TravMS, Parent =:= self() -> try ParentFun() - catch Class:Reason -> + catch Class:Reason:Stacktrace -> post_funs(Post), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end; true -> case monitor_request(Parent, {parent_fun, ParentFun}) of @@ -3033,9 +3032,9 @@ file_sort_handle(H, Kp, SortOptions, TmpDir, Compressed, Post, LocalPost) -> {terms, BTerms} -> try {[binary_to_term(B) || B <- BTerms], Post, LocalPost} - catch Class:Reason -> + catch Class:Reason:Stacktrace -> post_funs(Post), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end end. @@ -3045,9 +3044,9 @@ do_sort(In, Out, Sort, SortOptions, Post) -> {error, Reason} -> throw_reason(Reason); Reply -> Reply end - catch Class:Term -> + catch Class:Term:Stacktrace -> post_funs(Post), - erlang:raise(Class, Term, erlang:get_stacktrace()) + erlang:raise(Class, Term, Stacktrace) end. do_sort(In, Out, sort, SortOptions) -> @@ -3797,9 +3796,9 @@ call(undefined, _Arg, Default, _Post) -> call(Fun, Arg, _Default, Post) -> try Fun(Arg) - catch Class:Reason -> + catch Class:Reason:Stacktrace -> post_funs(Post), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end. grd(undefined, _Arg) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index ad4984b64c..e4153e7899 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -645,8 +645,7 @@ eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W) -> catch exit:normal -> exit(normal); - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> M = {self(),Class,{Reason,Stacktrace}}, case do_catch(Class, Reason) of true -> @@ -807,8 +806,8 @@ restrict_handlers(RShMod, Shell, RT) -> -define(BAD_RETURN(M, F, V), try erlang:error(reason) - catch _:_ -> erlang:raise(exit, {restricted_shell_bad_return,V}, - [{M,F,3} | erlang:get_stacktrace()]) + catch _:_:S -> erlang:raise(exit, {restricted_shell_bad_return,V}, + [{M,F,3} | S]) end). local_allowed(F, As, RShMod, Bs, Shell, RT) when is_atom(F) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index 81f927f399..39be2abff6 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -457,8 +457,7 @@ do_zip(F, Files, Options) -> Out3 = Output({close, F}, Out2), {ok, Out3} catch - C:R -> - Stk = erlang:get_stacktrace(), + C:R:Stk -> zlib:close(Z), Output({close, F}, Out0), erlang:raise(C, R, Stk) diff --git a/lib/stdlib/test/array_SUITE.erl b/lib/stdlib/test/array_SUITE.erl index 5836f275ba..956582c4fd 100644 --- a/lib/stdlib/test/array_SUITE.erl +++ b/lib/stdlib/test/array_SUITE.erl @@ -141,10 +141,10 @@ t(What) -> io:format("Test ~p ~n",[T]), try ?MODULE:T([]) - catch _E:_R -> + catch _E:_R:_S -> Line = get(test_server_loc), io:format("Failed ~p:~p ~p ~p~n ~p~n", - [T,Line,_E,_R, erlang:get_stacktrace()]) + [T,Line,_E,_R,_S]) end end, What). @@ -161,8 +161,8 @@ extract_tests() -> end, [Call(Test) || Test <- Tests], io:format("Tests ~p~n", [Tests]) - catch _:Err -> - io:format("Error: ~p ~p~n", [Err, erlang:get_stacktrace()]) + catch _:Err:Stacktrace -> + io:format("Error: ~p ~p~n", [Err, Stacktrace]) end, file:close(In), file:close(Out). diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl index 1f2a9fda0b..9dc04f27a1 100644 --- a/lib/stdlib/test/error_logger_h_SUITE.erl +++ b/lib/stdlib/test/error_logger_h_SUITE.erl @@ -257,8 +257,7 @@ match_output([Item|T], Lines0, AtNode, Depth) -> Lines -> match_output(T, Lines, AtNode, Depth) catch - C:E -> - Stk = erlang:get_stacktrace(), + C:E:Stk -> io:format("ITEM: ~p", [Item]), io:format("LINES: ~p", [Lines0]), erlang:raise(C, E, Stk) diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 07c8b60cbd..0cfb1b5516 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -6023,17 +6023,23 @@ etsmem() -> end}, {Mem,AllTabs}. -verify_etsmem({MemInfo,AllTabs}) -> + +verify_etsmem(MI) -> wait_for_test_procs(), + verify_etsmem(MI, 1). + +verify_etsmem({MemInfo,AllTabs}, Try) -> case etsmem() of {MemInfo,_} -> io:format("Ets mem info: ~p", [MemInfo]), - case MemInfo of - {ErlMem,EtsAlloc} when ErlMem == notsup; EtsAlloc == undefined -> + case {MemInfo, Try} of + {{ErlMem,EtsAlloc},_} when ErlMem == notsup; EtsAlloc == undefined -> %% Use 'erl +Mea max' to do more complete memory leak testing. {comment,"Incomplete or no mem leak testing"}; - _ -> - ok + {_, 1} -> + ok; + _ -> + {comment, "Transient memory discrepancy"} end; {MemInfo2, AllTabs2} -> @@ -6041,7 +6047,15 @@ verify_etsmem({MemInfo,AllTabs}) -> io:format("Actual: ~p", [MemInfo2]), io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]), io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]), - ct:fail("Failed memory check") + case Try < 2 of + true -> + io:format("\nThis discrepancy could be caused by an " + "inconsistent memory \"snapshot\"" + "\nTry again...\n", []), + verify_etsmem({MemInfo, AllTabs}, Try+1); + false -> + ct:fail("Failed memory check") + end end. diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index c747db475a..7c8a386116 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -2040,9 +2040,9 @@ handle_event(Type, Event, State, Data) -> Result -> wrap_result(Result) catch - throw:Result -> + throw:Result:Stacktrace -> erlang:raise( - throw, wrap_result(Result), erlang:get_stacktrace()) + throw, wrap_result(Result), Stacktrace) end. unwrap_state([State]) -> diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 7686889360..fbdcb518b2 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -446,8 +446,8 @@ init_dont_hang(Config) when is_list(Config) -> StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000), StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000, []), ok - catch _:Error -> - io:format("Error ~p /= ~p ~n",[erlang:get_stacktrace(), StartLinkRes]), + catch _:Error:Stacktrace -> + io:format("Error ~p /= ~p ~n",[Stacktrace, StartLinkRes]), exit(Error) end. diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 3d3241b33d..15ae4fa2d7 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -82,9 +82,9 @@ test() -> try ok = ?MODULE:Test([]), io:format("~p: ok~n", [Test]) - catch _:Reason -> + catch _:Reason:Stacktrace -> io:format("Failed: ~p: ~p ~p~n", - [Test, Reason, erlang:get_stacktrace()]) + [Test, Reason, Stacktrace]) end end, Tests). @@ -98,8 +98,8 @@ seed(Config) when is_list(Config) -> Algs = algs(), Test = fun(Alg) -> try seed_1(Alg) - catch _:Reason -> - ct:fail({Alg, Reason, erlang:get_stacktrace()}) + catch _:Reason:Stacktrace -> + ct:fail({Alg, Reason, Stacktrace}) end end, [Test(Alg) || Alg <- Algs], @@ -722,12 +722,12 @@ uniform_real_conv_check(M, E, Gen) -> [["16#",integer_to_list(G,16),$\s]||G<-Gen]]), ct:fail({neq, FF, F}) catch - Error:Reason -> + Error:Reason:Stacktrace -> ct:pal( "~w:~p ~s: ~s~n", [Error, Reason, rand:float2str(F), [["16#",integer_to_list(G,16),$\s]||G<-Gen]]), - ct:fail({Error, Reason, F, erlang:get_stacktrace()}) + ct:fail({Error, Reason, F, Stacktrace}) end. diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index d02a6eac0a..c4a469c251 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -877,9 +877,9 @@ test_1(Line, Func, Str, Args, Exp) -> catch error:Exp -> ok; - error:Reason -> + error:Reason:Stacktrace -> io:format("~p:~p: Crash ~p ~p~n", - [?MODULE,Line, Reason, erlang:get_stacktrace()]), + [?MODULE,Line, Reason, Stacktrace]), exit({error, Func}) end. @@ -944,10 +944,10 @@ check_types(Line, Func, [Str|_], Res) -> io:format("Failed: ~p ~p: ~p ~p~n",[Line, Func, T1, T2]), io:format(" ~p => ~p~n", [Str, Res]), error; - _:Reason -> - io:format("Crash: ~p in~n ~p~n",[Reason, erlang:get_stacktrace()]), + _:Reason:Stacktrace -> + io:format("Crash: ~p in~n ~p~n",[Reason, Stacktrace]), io:format("Failed: ~p ~p: ~p => ~p~n", [Line, Func, Str, Res]), - exit({Reason, erlang:get_stacktrace()}) + exit({Reason, Stacktrace}) end. check_types_1(T, T) -> diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index 632d9ae6e6..40b1c260a5 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -136,10 +136,10 @@ verify_gc(Line0, N, Acc) -> io:format("Expected: ~p~n", [Res]), io:format("Got: ~w~n", [Other]), Acc+1; - Cl:R -> + Cl:R:Stacktrace -> io:format("~p: ~ts => |~tp|~n",[N, Line, Str]), io:format("Expected: ~p~n", [Res]), - erlang:raise(Cl,R,erlang:get_stacktrace()) + erlang:raise(Cl,R,Stacktrace) end. gc_test_data([[247]|Rest], Str, [First|GCs]) -> @@ -175,29 +175,29 @@ verify_nfd(Data0, LineNo, _Acc) -> C3GC = fetch(C1, fun unicode_util:nfd/1), C3GC = fetch(C2, fun unicode_util:nfd/1), C3GC = fetch(C3, fun unicode_util:nfd/1) - catch _Cl:{badmatch, Other} = _R-> + catch _Cl:{badmatch, Other} = _R: Stacktrace -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]), io:format("Expected: ~ts ~w~n", [C3GC, C3GC]), io:format("Got: ~ts ~w~n", [Other, Other]), - erlang:raise(_Cl,_R,erlang:get_stacktrace()); - Cl:R -> + erlang:raise(_Cl,_R,Stacktrace); + Cl:R:Stacktrace -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C3]), - erlang:raise(Cl,R,erlang:get_stacktrace()) + erlang:raise(Cl,R,Stacktrace) end, C5GC = fetch(C5, fun unicode_util:gc/1), try C5GC = fetch(C4, fun unicode_util:nfd/1), C5GC = fetch(C5, fun unicode_util:nfd/1) - catch _Cl2:{badmatch, Other2} = _R2-> + catch _Cl2:{badmatch, Other2} = _R2:Stacktrace2 -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]), io:format("Expected: ~ts ~w~n", [C5GC, C5GC]), io:format("Got: ~ts ~w~n", [Other2, Other2]), - erlang:raise(_Cl2,_R2,erlang:get_stacktrace()); - Cl2:R2 -> + erlang:raise(_Cl2,_R2,Stacktrace2); + Cl2:R2:Stacktrace2 -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C5]), - erlang:raise(Cl2,R2,erlang:get_stacktrace()) + erlang:raise(Cl2,R2,Stacktrace2) end, ok. @@ -218,29 +218,29 @@ verify_nfc(Data0, LineNo, _Acc) -> C2GC = fetch(C1, fun unicode_util:nfc/1), C2GC = fetch(C2, fun unicode_util:nfc/1), C2GC = fetch(C3, fun unicode_util:nfc/1) - catch _Cl:{badmatch, Other} = _R-> + catch _Cl:{badmatch, Other} = _R:Stacktrace -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]), io:format("Expected: ~ts ~w~n", [C2GC, C2GC]), io:format("Got: ~ts ~w~n", [Other, Other]), - erlang:raise(_Cl,_R,erlang:get_stacktrace()); - Cl:R -> + erlang:raise(_Cl,_R,Stacktrace); + Cl:R:Stacktrace -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C3]), - erlang:raise(Cl,R,erlang:get_stacktrace()) + erlang:raise(Cl,R,Stacktrace) end, C4GC = fetch(C4, fun unicode_util:gc/1), try C4GC = fetch(C4, fun unicode_util:nfc/1), C4GC = fetch(C5, fun unicode_util:nfc/1) - catch _Cl2:{badmatch, Other2} = _R2-> + catch _Cl2:{badmatch, Other2} = _R2:Stacktrace2 -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]), io:format("Expected: ~ts ~w~n", [C4GC, C4GC]), io:format("Got: ~ts ~w~n", [Other2, Other2]), - erlang:raise(_Cl2,_R2,erlang:get_stacktrace()); - Cl2:R2 -> + erlang:raise(_Cl2,_R2,Stacktrace2); + Cl2:R2:Stacktrace2 -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C5]), - erlang:raise(Cl2,R2,erlang:get_stacktrace()) + erlang:raise(Cl2,R2,Stacktrace2) end, ok. @@ -263,15 +263,15 @@ verify_nfkd(Data0, LineNo, _Acc) -> C5GC = lists:flatten(fetch(C3, fun unicode_util:nfkd/1)), C5GC = lists:flatten(fetch(C4, fun unicode_util:nfkd/1)), C5GC = lists:flatten(fetch(C5, fun unicode_util:nfkd/1)) - catch _Cl:{badmatch, Other} = _R-> + catch _Cl:{badmatch, Other} = _R:Stacktrace -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C5, C5]), io:format("Expected: ~ts ~w~n", [C5GC, C5GC]), io:format("Got: ~ts ~w~n", [Other, Other]), - erlang:raise(_Cl,_R,erlang:get_stacktrace()); - Cl:R -> + erlang:raise(_Cl,_R,Stacktrace); + Cl:R:Stacktrace -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C3]), - erlang:raise(Cl,R,erlang:get_stacktrace()) + erlang:raise(Cl,R,Stacktrace) end, ok. @@ -296,15 +296,15 @@ verify_nfkc(Data0, LineNo, _Acc) -> C4GC = lists:flatten(fetch(C4, fun unicode_util:nfkc/1)), C4GC = lists:flatten(fetch(C5, fun unicode_util:nfkc/1)) - catch _Cl:{badmatch, Other} = _R-> + catch _Cl:{badmatch, Other} = _R:Stacktrace -> io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C4, C4]), io:format("Expected: ~ts ~w~n", [C4GC, C4GC]), io:format("Got: ~ts ~w~n", [Other, Other]), - erlang:raise(_Cl,_R,erlang:get_stacktrace()); - Cl:R -> + erlang:raise(_Cl,_R,Stacktrace); + Cl:R:Stacktrace -> io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]), io:format("Expected: ~p~n", [C3]), - erlang:raise(Cl,R,erlang:get_stacktrace()) + erlang:raise(Cl,R,Stacktrace) end, ok. diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 1dfcda4ed0..e5ba629c55 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -909,8 +909,7 @@ do_fd_leak(Bad, N) -> ok -> do_fd_leak(Bad, N + 1) catch - C:R -> - Stk = erlang:get_stacktrace(), + C:R:Stk -> io:format("Bad error after ~p attempts\n", [N]), erlang:raise(C, R, Stk) end. diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 5bdfc60448..0c24375b91 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -371,7 +371,7 @@ <v>Serial = integer()</v> </type> <desc> - <p>Creates a process id with creation 0. Example:</p> + <p>Creates a process id with creation 0.</p> </desc> </func> diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index fb657c2928..a3b4bfdddf 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1242,8 +1242,7 @@ spawn_3step(Spawn, FunPrelude, FunAck, FunBody) catch Child ! {Parent, Ref, Go}, Result catch - Class:Reason -> - Stacktrace = erlang:get_stacktrace(), + Class:Reason:Stacktrace -> catch exit(Child, kill), erlang:raise(Class, Reason, Stacktrace) end; diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index 139b3d8a4a..d0152a4915 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -218,9 +218,11 @@ raw() -> call(raw). set(Option, Value) -> call({set, Option, Value}). set({Option, Value}) -> call({set, Option, Value}). save(Filename) -> call({save, Filename}). -load(Filename) -> ok = start_internal(), call({load, Filename}). +load(Filename) -> call({load, Filename}). -call(Msg) -> gen_server:call(?MODULE, Msg, infinity). +call(Msg) -> + ok = start_internal(), + gen_server:call(?MODULE, Msg, infinity). %% -------------------------------------------------------------------- %% %% @@ -237,7 +239,6 @@ apply(Fun) when is_function(Fun) -> lcnt:apply(Fun, []). apply(Fun, As) when is_function(Fun) -> - ok = start_internal(), Opt = lcnt:rt_opt({copy_save, true}), lcnt:clear(), Res = erlang:apply(Fun, As), @@ -943,7 +944,7 @@ print_state_information(#state{locks = Locks} = State) -> print(kv("#tries", s(Stats#stats.tries))), print(kv("#colls", s(Stats#stats.colls))), print(kv("wait time", s(Stats#stats.time) ++ " us" ++ " ( " ++ s(Stats#stats.time/1000000) ++ " s)")), - print(kv("percent of duration", s(Stats#stats.time/State#state.duration*100) ++ " %")), + print(kv("percent of duration", s(percent(Stats#stats.time, State#state.duration)) ++ " %")), ok. diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index 146c915087..a79572a742 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -30,6 +30,8 @@ t_conflicts/1, t_locations/1, t_swap_keys/1, + t_implicit_start/1, + t_crash_before_collect/1, smoke_lcnt/1]). init_per_testcase(_Case, Config) -> @@ -44,8 +46,8 @@ suite() -> {timetrap,{minutes,4}}]. all() -> - [t_load, t_conflicts, t_locations, t_swap_keys, - smoke_lcnt]. + [t_load, t_conflicts, t_locations, t_swap_keys, t_implicit_start, + t_crash_before_collect, smoke_lcnt]. %%---------------------------------------------------------------------- %% Tests @@ -149,6 +151,15 @@ t_swap_keys_file([File|Files]) -> ok = lcnt:stop(), t_swap_keys_file(Files). +%% Prior to OTP-14913 this would crash with 'noproc' as the lcnt server hadn't +%% been started yet. +t_implicit_start(Config) when is_list(Config) -> + ok = lcnt:conflicts(). + +t_crash_before_collect(Config) when is_list(Config) -> + {ok, _} = lcnt:start(), + ok = lcnt:information(). + %% Simple smoke test of actual lock-counting, if running on %% a run-time with lock-counting enabled. smoke_lcnt(Config) -> diff --git a/lib/wx/api_gen/gen_util.erl b/lib/wx/api_gen/gen_util.erl index 5e2f405498..3068a2f4ea 100644 --- a/lib/wx/api_gen/gen_util.erl +++ b/lib/wx/api_gen/gen_util.erl @@ -106,8 +106,8 @@ check_diff(Diff) -> throw:_ -> diff; error:{badmatch,_} -> diff; - _:What -> - io:format("~p:~p: ~p ~p~n", [?MODULE,?LINE, What, erlang:get_stacktrace()]), + _:What:Stacktrace -> + io:format("~p:~p: ~p ~p~n", [?MODULE,?LINE, What, Stacktrace]), diff end. diff --git a/lib/wx/api_gen/gl_gen.erl b/lib/wx/api_gen/gl_gen.erl index 7e3766a43b..6f68517c16 100644 --- a/lib/wx/api_gen/gl_gen.erl +++ b/lib/wx/api_gen/gl_gen.erl @@ -47,9 +47,9 @@ safe(What, QuitOnErr) -> What(), io:format("Completed successfully~n~n", []), QuitOnErr andalso gen_util:halt(0) - catch Err:Reason -> + catch Err:Reason:Stacktrace -> io:format("Error ~p: ~p:~p~n ~p~n", - [get(current_func),Err,Reason,erlang:get_stacktrace()]), + [get(current_func),Err,Reason,Stacktrace]), (catch gen_util:close()), timer:sleep(1999), QuitOnErr andalso gen_util:halt(1) diff --git a/lib/wx/api_gen/gl_gen_erl.erl b/lib/wx/api_gen/gl_gen_erl.erl index 45f5fd8f4c..7e673c2987 100644 --- a/lib/wx/api_gen/gl_gen_erl.erl +++ b/lib/wx/api_gen/gl_gen_erl.erl @@ -246,8 +246,8 @@ gen_types(Where) -> gen_export(F) -> try gen_export_1(F) - catch E:R -> - io:format("Crash ~p:~p in ~p ~n",[E,R, erlang:get_stacktrace()]), + catch E:R:S -> + io:format("Crash ~p:~p in ~p ~n",[E,R,S]), io:format("Func = ~p~n ~p", [F, get(F)]) end. @@ -489,8 +489,8 @@ doc_return_types2(T, Ps) -> doc_arg_type(#arg{name=Name,type=T}) -> try erl_arg_name(Name) ++ " :: " ++ doc_arg_type2(T) - catch _:Error -> - io:format("Error spec: ~p ~p~n~p~n",[Name, Error, erlang:get_stacktrace()]), + catch _:Error:Stacktrace -> + io:format("Error spec: ~p ~p~n~p~n",[Name, Error, Stacktrace]), exit(error) end. diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl index aadfe4b111..ab70a588ab 100644 --- a/lib/wx/api_gen/wx_gen.erl +++ b/lib/wx/api_gen/wx_gen.erl @@ -47,9 +47,9 @@ safe(What, QuitOnErr) -> What(), io:format("Completed successfully~n~n", []), QuitOnErr andalso gen_util:halt(0) - catch Err:Reason -> + catch Err:Reason:Stacktrace -> io:format("Error in ~p ~p~n", [get(current_class),get(current_func)]), - erlang:display({Err,Reason, erlang:get_stacktrace()}), + erlang:display({Err,Reason,Stacktrace}), catch gen_util:close(), QuitOnErr andalso gen_util:halt(1) end. diff --git a/lib/wx/examples/demo/ex_aui.erl b/lib/wx/examples/demo/ex_aui.erl index d8fc0021f1..97805621ed 100644 --- a/lib/wx/examples/demo/ex_aui.erl +++ b/lib/wx/examples/demo/ex_aui.erl @@ -87,8 +87,7 @@ do_init(Config) -> wxAuiManager:update(Manager), process_flag(trap_exit, true), {Panel, #state{parent=Panel, config=Config, aui=Manager}} - catch Class:Reason -> - ST = erlang:get_stacktrace(), + catch Class:Reason:ST -> io:format("AUI Crashed ~p ~p~n",[Reason, ST]), wxAuiManager:unInit(Manager), wxAuiManager:destroy(Manager), diff --git a/lib/wx/src/wx.erl b/lib/wx/src/wx.erl index 34bf06cf46..6dd3c148db 100644 --- a/lib/wx/src/wx.erl +++ b/lib/wx/src/wx.erl @@ -183,7 +183,7 @@ batch(Fun) -> ok = wxe_util:cast(?BATCH_BEGIN, <<>>), try Fun() catch - error:W -> erlang:exit({W, erlang:get_stacktrace()}); + error:W:S -> erlang:exit({W, S}); throw:W -> erlang:throw(W); exit:W -> erlang:exit(W) after @@ -196,7 +196,7 @@ foreach(Fun, List) -> ok = wxe_util:cast(?BATCH_BEGIN, <<>>), try lists:foreach(Fun, List) catch - error:W -> erlang:exit({W, erlang:get_stacktrace()}); + error:W:S -> erlang:exit({W, S}); throw:W -> erlang:throw(W); exit:W -> erlang:exit(W) after @@ -209,7 +209,7 @@ map(Fun, List) -> ok = wxe_util:cast(?BATCH_BEGIN, <<>>), try lists:map(Fun, List) catch - error:W -> erlang:exit({W, erlang:get_stacktrace()}); + error:W:S -> erlang:exit({W, S}); throw:W -> erlang:throw(W); exit:W -> erlang:exit(W) after @@ -222,7 +222,7 @@ foldl(Fun, Acc, List) -> ok = wxe_util:cast(?BATCH_BEGIN, <<>>), try lists:foldl(Fun, Acc, List) catch - error:W -> erlang:exit({W, erlang:get_stacktrace()}); + error:W:S -> erlang:exit({W, S}); throw:W -> erlang:throw(W); exit:W -> erlang:exit(W) after @@ -235,7 +235,7 @@ foldr(Fun, Acc, List) -> ok = wxe_util:cast(?BATCH_BEGIN, <<>>), try lists:foldr(Fun, Acc, List) catch - error:W -> erlang:exit({W, erlang:get_stacktrace()}); + error:W:S -> erlang:exit({W, S}); throw:W -> erlang:throw(W); exit:W -> erlang:exit(W) after diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 58fcaf8f23..d6d9dbd629 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -283,10 +283,10 @@ invoke_callback(Pid, Ev, Ref) -> Return -> exit({bad_return, Return}) end end - catch _:Reason -> + catch _:Reason:Stacktrace -> wxEvent:skip(Ref), ?log("Callback fun crashed with {'EXIT, ~p, ~p}~n", - [Reason, erlang:get_stacktrace()]) + [Reason, Stacktrace]) end, wxe_util:cast(?WXE_CB_RETURN, <<>>) end, @@ -299,9 +299,9 @@ invoke_callback_fun(Fun) -> Return = Fun(), true = is_binary(Return), Return - catch _:Reason -> + catch _:Reason:Stacktrace -> ?log("Callback fun crashed with {'EXIT, ~p, ~p}~n", - [Reason, erlang:get_stacktrace()]), + [Reason, Stacktrace]), <<>> end, wxe_util:cast(?WXE_CB_RETURN, Res). |