diff options
Diffstat (limited to 'lib')
86 files changed, 2758 insertions, 783 deletions
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b98a704e28..bfeffa969f 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -1355,8 +1355,8 @@ xref_export_all(_Config) -> [] -> ok; [_|_] -> - S = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], - io:format("There are unused functions:\n\n~s\n", [S]), + Msg = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], + io:format("There are unused functions:\n\n~s\n", [Msg]), ?t:fail(unused_functions) end. diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 6f09dc4be4..7df2edd714 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -58,7 +58,8 @@ rename_instrs([{call_only,A,F}|Is]) -> rename_instrs([{call_ext_only,A,F}|Is]) -> [{call_ext,A,F},return|rename_instrs(Is)]; rename_instrs([{'%live',_}|Is]) -> - %% When compiling from old .S files. + %% Ignore old type of live annotation. Only happens when compiling + %% from very old .S files. rename_instrs(Is); rename_instrs([I|Is]) -> [rename_instr(I)|rename_instrs(Is)]; diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index fe1ce6f60b..39ae8d5347 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -23,25 +23,32 @@ -module(beam_block). -export([module/2]). --import(lists, [reverse/1,reverse/2,foldl/3,member/2]). +-import(lists, [reverse/1,reverse/2,member/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], +module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> + Blockify = not member(no_blockify, Opts), + Fs = [function(F, Blockify) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}) -> +function({function,Name,Arity,CLabel,Is0}, Blockify) -> try %% Collect basic blocks and optimize them. - Is1 = blockify(Is0), - Is2 = embed_lines(Is1), + Is2 = case Blockify of + true -> + Is1 = blockify(Is0), + embed_lines(Is1); + false -> + Is0 + end, Is3 = beam_utils:anno_defs(Is2), Is4 = move_allocates(Is3), Is5 = beam_utils:live_opt(Is4), Is6 = opt_blocks(Is5), - Is = beam_utils:delete_live_annos(Is6), + Is7 = beam_utils:delete_annos(Is6), + Is = opt_allocs(Is7), %% Done. {function,Name,Arity,CLabel,Is} @@ -136,17 +143,16 @@ embed_lines([], Acc) -> Acc. opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. - [{'%live',_,_}|Bl] = Bl0, + [{'%anno',_}|Bl] = Bl0, [{block,opt_block(Bl)}|opt_blocks(Is)]; opt_blocks([I|Is]) -> [I|opt_blocks(Is)]; opt_blocks([]) -> []. opt_block(Is0) -> - Is = find_fixpoint(fun(Is) -> - opt_tuple_element(opt(Is)) - end, Is0), - opt_alloc(Is). + find_fixpoint(fun(Is) -> + opt_tuple_element(opt(Is)) + end, Is0). find_fixpoint(OptFun, Is0) -> case OptFun(Is0) of @@ -196,7 +202,7 @@ move_allocates([I|Is]) -> [I|move_allocates(Is)]; move_allocates([]) -> []. -move_allocates_1([{'%def',_}|Is], Acc) -> +move_allocates_1([{'%anno',_}|Is], Acc) -> move_allocates_1(Is, Acc); move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) -> case alloc_may_pass(I) of @@ -240,10 +246,14 @@ opt([{set,_,_,{line,_}}=Line1, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> opt([Line2,I2,Line1,I1|Is]); +opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1, + {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is]) + when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> + opt([I2,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; -opt([{'%live',_,_}=I|Is]) -> +opt([{'%anno',_}=I|Is]) -> [I|opt(Is)]; opt([]) -> []. @@ -411,31 +421,47 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> no end. +%% opt_allocs(Instructions) -> Instructions. Optimize allocate +%% instructions inside blocks. If safe, replace an allocate_zero +%% instruction with the slightly cheaper allocate instruction. + +opt_allocs(Is) -> + D = beam_utils:index_labels(Is), + opt_allocs_1(Is, D). + +opt_allocs_1([{block,Bl0}|Is], D) -> + Bl = opt_alloc(Bl0, {D,Is}), + [{block,Bl}|opt_allocs_1(Is, D)]; +opt_allocs_1([I|Is], D) -> + [I|opt_allocs_1(Is, D)]; +opt_allocs_1([], _) -> []. + %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. opt_alloc([{set,[],[],{alloc,Live0,Info0}}, - {set,[],[],{alloc,Live,Info}}|Is]) -> + {set,[],[],{alloc,Live,Info}}|Is], D) -> Live = Live0, %Assertion. Alloc = combine_alloc(Info0, Info), I = {set,[],[],{alloc,Live,Alloc}}, - opt_alloc([I|Is]); -opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) -> - [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is]; -opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; -opt_alloc([]) -> []. + opt_alloc([I|Is], D); +opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) -> + [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is]; +opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)]; +opt_alloc([], _) -> []. combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> {zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}. - + %% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr] %% Generates the optimal sequence of instructions for %% allocating and initalizing the stack frame and needed heap. -opt_alloc(_Is, nostack, Nh, LivingRegs) -> +opt_alloc(_Is, _D, nostack, Nh, LivingRegs) -> {alloc,LivingRegs,{nozero,nostack,Nh,[]}}; -opt_alloc(Is, Ns, Nh, LivingRegs) -> - InitRegs = init_yreg(Is, 0), +opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) -> + Is = [{block,Bl}|OuterIs], + InitRegs = init_yregs(Ns, Is, D), case count_ones(InitRegs) of N when N*2 > Ns -> {alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}}; @@ -451,19 +477,14 @@ gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 -> gen_init(Fs, Regs, Y, Acc) -> gen_init(Fs, Regs bsr 1, Y+1, Acc). -%% init_yreg(Instructions, RegSet) -> RegSetInitialized -%% Calculate the set of initialized y registers. - -init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); -init_yreg(_Is, Reg) -> Reg. - -add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys). - -add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y); -add_yreg(_, Reg) -> Reg. +init_yregs(Y, Is, D) when Y >= 0 -> + case beam_utils:is_killed({y,Y}, Is, D) of + true -> + (1 bsl Y) bor init_yregs(Y-1, Is, D); + false -> + init_yregs(Y-1, Is, D) + end; +init_yregs(_, _, _) -> 0. count_ones(Bits) -> count_ones(Bits, 0). count_ones(0, Acc) -> Acc; @@ -514,7 +535,7 @@ x_live([], Regs) -> Regs. %% Given a reversed instruction stream, determine the %% the registers that are defined. -defined_regs([{'%def',Def}|_], Regs) -> +defined_regs([{'%anno',{def,Def}}|_], Regs) -> Def bor Regs; defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) -> x_live(Ds, Regs bor ((1 bsl Live) - 1)); diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 9ea5a3eb92..9f3b9d788f 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -124,20 +124,21 @@ btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0) end, btb_opt_1(Is, D, Acc) end; -btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is], D, Acc0) -> - case btb_reaches_match(Is, [Ctx,Dst], D) of +btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is0], D, Acc0) -> + case btb_reaches_match(Is0, [Ctx,Dst], D) of {error,Reason} -> Comment = btb_comment_no_opt(Reason, Fs), - btb_opt_1(Is, D, [Comment,I0|Acc0]); + btb_opt_1(Is0, D, [Comment,I0|Acc0]); {ok,MustSave} when U =:= 1 -> Comment = btb_comment_opt(Fs), - Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst}|Acc1], + Acc = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc); {ok,MustSave} -> Comment = btb_comment_opt(Fs), Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst},{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Acc = [{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc) end; btb_opt_1([I|Is], D, Acc) -> @@ -150,6 +151,12 @@ btb_gen_save(true, Reg, Acc) -> [{bs_save2,Reg,{atom,start}}|Acc]; btb_gen_save(false, _, Acc) -> Acc. +prepend_move(Ctx, Dst, [{block,Bl0}|Is]) -> + Bl = [{set,[Dst],[Ctx],move}|Bl0], + [{block,Bl}|Is]; +prepend_move(Ctx, Dst, Is) -> + [{move,Ctx,Dst}|Is]. + %% btb_reaches_match([Instruction], [Register], D) -> %% {ok,MustSave}|{error,Reason} %% diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl index db1053e48c..58a6de6775 100644 --- a/lib/compiler/src/beam_record.erl +++ b/lib/compiler/src/beam_record.erl @@ -71,7 +71,7 @@ rewrite([{test,test_arity,Fail,[Src,N]}=TA, I = {test,is_tagged_tuple,Fail,[Src,N,Atom]}, rewrite(Is, Idx, Def, [I|Acc]) end; -rewrite([{block,[{'%def',Def}|Bl]}|Is], Idx, _Def, Acc) -> +rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) -> rewrite(Is, Idx, Def, [{block,Bl}|Acc]); rewrite([{label,L}=I|Is], Idx0, Def, Acc) -> Idx = beam_utils:index_label(L, Acc, Idx0), diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 16d5a36447..3b6bf49961 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -40,7 +40,7 @@ function({function,Name,Arity,CLabel,Asm0}) -> Asm1 = beam_utils:live_opt(Asm0), Asm2 = opt(Asm1, [], tdb_new()), Asm3 = beam_utils:live_opt(Asm2), - Asm = beam_utils:delete_live_annos(Asm3), + Asm = beam_utils:delete_annos(Asm3), {function,Name,Arity,CLabel,Asm} catch Class:Error:Stack -> @@ -92,7 +92,7 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of - {tuple,_,[Contents]} -> + {tuple,_,_,[Contents]} -> simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc); _ -> Ts = update(I, Ts0), @@ -113,12 +113,12 @@ simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> end; simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of - {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc); + {tuple,_,_,_} -> simplify_basic_1(Is, Ts, Acc); _ -> simplify_basic_1(Is, Ts, [I|Acc]) end; simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> case tdb_find(R, Ts0) of - {tuple,Arity,_} -> + {tuple,exact_size,Arity,_} -> simplify_basic_1(Is, Ts0, Acc); _Other -> Ts = update(I, Ts0), @@ -148,7 +148,7 @@ simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) - simplify_basic_1(Is0, Ts, Acc); simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) -> case tdb_find(R, Ts0) of - {tuple,Arity,[Tag]} -> + {tuple,exact_size,Arity,[Tag]} -> simplify_basic_1(Is, Ts0, Acc); _Other -> Ts = update(I, Ts0), @@ -300,7 +300,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. %% Combine two blocks and eliminate any move instructions that assign %% to registers that are killed later in the block. %% -merge_blocks(B1, [{'%live',_,_}|B2]) -> +merge_blocks(B1, [{'%anno',_}|B2]) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; @@ -349,27 +349,17 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> {[],H+1,Fl}; flt_need_heap_2({set,_,_,put}, H, Fl) -> {[],H+1,Fl}; -%% Then the "neutral" instructions. We just pass them. -flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fclearerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fcheckerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{bif,_,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,move}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,get_list}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) -> - {[],H,Fl}; -%% All other instructions should cause the insertion of an allocation +%% The following instructions cause the insertion of an allocation %% instruction if needed. +flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({'%anno',_}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +%% All other instructions are "neutral". We just pass them. flt_need_heap_2(_, H, Fl) -> - {flt_alloc(H, Fl),0,0}. + {[],H,Fl}. flt_alloc(0, 0) -> []; @@ -392,7 +382,7 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. %% is not continous at an allocation function (e.g. if {x,0} and {x,2} %% are live, but not {x,1}). -flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) -> +flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) -> flt_liveness_1(Is, Regs, [LiveInstr]). flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> @@ -404,7 +394,7 @@ flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) -> Regs = x_live(Ds, Regs0), flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{'%live',_,_}], _Regs, Acc) -> +flt_liveness_1([{'%anno',_}], _Regs, Acc) -> reverse(Acc). init_regs(Live) -> @@ -428,13 +418,14 @@ x_live([], Regs) -> Regs. %% Update the type database to account for executing an instruction. %% %% First the cases for instructions inside basic blocks. -update({'%live',_,_}, Ts) -> Ts; +update({'%anno',_}, Ts) -> + Ts; update({set,[D],[S],move}, Ts) -> tdb_copy(S, D, Ts); update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,I,[]}},{D,kill}], Ts0); update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,0,[]}},{D,kill}], Ts0); update({set,[D],Args,{bif,N,_}}, Ts0) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse @@ -492,7 +483,7 @@ update({kill,D}, Ts) -> update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> - tdb_update([{Src,{tuple,Arity,[]}}], Ts0); + tdb_update([{Src,{tuple,exact_size,Arity,[]}}], Ts0); update({test,is_map,_Fail,[Src]}, Ts0) -> tdb_update([{Src,map}], Ts0); update({get_map_elements,_,Src,{list,Elems0}}, Ts0) -> @@ -506,12 +497,12 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> error -> Ts; {tuple_element,TupleReg,0} -> - tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts); + tdb_update([{TupleReg,{tuple,min_size,1,[Atom]}}], Ts); _ -> Ts end; update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> - tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts); + tdb_update([{Src,{tuple,exact_size,Arity,[Tag]}}], Ts); %% Binary matching @@ -553,7 +544,7 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> Ts = tdb_kill_xregs(Ts0), case tdb_find({x,1}, Ts0) of - {tuple,Sz,_}=T0 -> + {tuple,SzKind,Sz,_}=T0 -> T = case tdb_find({x,0}, Ts0) of {integer,{I,I}} when I > 1 -> %% First element is not changed. The result @@ -562,7 +553,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> _ -> %% Position is 1 or unknown. May change the %% first element of the tuple. - {tuple,Sz,[]} + {tuple,SzKind,Sz,[]} end, tdb_update([{{x,0},T}], Ts); _ -> @@ -646,7 +637,7 @@ possibly_numeric(_) -> false. max_tuple_size(Reg, Ts) -> case tdb_find(Reg, Ts) of - {tuple,Sz,_} -> Sz; + {tuple,_,Sz,_} -> Sz; _Other -> 0 end. @@ -802,11 +793,12 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% -%%% {tuple,Size,First} means that the corresponding register contains a -%%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0,[]}. First is either [] (meaning that -%%% the tuple's first element is unknown) or [FirstElement] (the contents -%%% of the first element). +%%% {tuple,min_size,Size,First} means that the corresponding register contains +%%% a tuple with *at least* Size elements (conversely, exact_size means that it +%%% contains a tuple with *exactly* Size elements). An tuple with unknown size +%%% is represented as {tuple,min_size,0,[]}. First is either [] (meaning that +%%% the tuple's first element is unknown) or [FirstElement] (the contents of +%%% the first element). %%% %%% 'float' means that the register contains a float. %%% @@ -850,7 +842,7 @@ tdb_copy(Literal, D, Ts) -> {literal,#{}} -> map; {literal,Tuple} when tuple_size(Tuple) >= 1 -> Lit = tag_literal(element(1, Tuple)), - {tuple,tuple_size(Tuple),[Lit]}; + {tuple,exact_size,tuple_size(Tuple),[Lit]}; _ -> term end, if @@ -872,14 +864,14 @@ tag_literal(Lit) -> {literal,Lit}. %% Updates a type database. If a 'kill' operation is given, the type %% information for that register will be removed from the database. %% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the +%% register (i.e. [{{x,0},kill},{{x,0},{tuple,min_size,5,[]}}] means that the %% the existing type information, if any, will be discarded, and the -%% the '{tuple,5,[]}' information ignored. +%% the '{tuple,min_size,5,[]}' information ignored. %% %% If NewInfo information is given and there exists information about %% the register, the old and new type information will be merged. -%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce -%% {tuple,10,_}. +%% For instance, {tuple,min_size,5,_} and {tuple,min_size,10,_} will be merged +%% to produce {tuple,min_size,10,_}. tdb_update(Uis0, Ts0) -> Uis1 = filter(fun ({{x,_},_Op}) -> true; @@ -917,16 +909,20 @@ tdb_kill_xregs([]) -> []. remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); remove_key(_, Ops) -> Ops. - + merge_type_info(I, I) -> I; -merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> Max; -merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> Max; -merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> - merge_type_info({tuple,Sz1,First}, Tuple2); -merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> - merge_type_info(Tuple1, {tuple,Sz2,First}); +merge_type_info({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> + Exact; +merge_type_info({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> + Exact; +merge_type_info({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> + merge_type_info({tuple,SzKind1,Sz1,First}, Tuple2); +merge_type_info({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> + merge_type_info(Tuple1, {tuple,SzKind2,Sz2,First}); merge_type_info(integer, {integer,_}=Int) -> Int; merge_type_info({integer,_}=Int, integer) -> @@ -944,7 +940,7 @@ verify_type({integer,{Min,Max}}) when is_integer(Min), is_integer(Max) -> ok; verify_type(map) -> ok; verify_type(nonempty_list) -> ok; -verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; -verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; verify_type(float) -> ok. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 60221578bd..901588ee3b 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -25,7 +25,7 @@ is_not_used/3,usage/3, empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, - live_opt/1,delete_live_annos/1,combine_heap_needs/2, + live_opt/1,delete_annos/1,combine_heap_needs/2, anno_defs/1, split_even/1 ]). @@ -95,7 +95,7 @@ is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> X >= Live; is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is)); -is_killed_block(R, [{'%live',_,Regs}|Is]) -> +is_killed_block(R, [{'%anno',{used,Regs}}|Is]) -> case R of {x,X} when (Regs bsr X) band 1 =:= 0 -> true; _ -> is_killed_block(R, Is) @@ -118,6 +118,7 @@ is_killed(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -130,6 +131,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -146,6 +148,7 @@ is_not_used(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {used,_} -> false; + {exit_not_used,_} -> false; {_,_} -> true end. @@ -267,7 +270,7 @@ is_pure_test({test,Op,_,Ops}) -> %% Go through the instruction sequence in reverse execution %% order, keep track of liveness and remove 'move' instructions %% whose destination is a register that will not be used. -%% Also insert {'%live',Live,Regs} annotations at the beginning +%% Also insert {used,Regs} annotations at the beginning %% and end of each block. -spec live_opt([instruction()]) -> [instruction()]. @@ -282,22 +285,22 @@ live_opt(Is0) -> Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. -%% delete_live_annos([Instruction]) -> [Instruction]. -%% Delete all live annotations. +%% delete_annos([Instruction]) -> [Instruction]. +%% Delete all annotations. --spec delete_live_annos([instruction()]) -> [instruction()]. +-spec delete_annos([instruction()]) -> [instruction()]. -delete_live_annos([{block,Bl0}|Is]) -> - case delete_live_annos(Bl0) of - [] -> delete_live_annos(Is); - [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)] +delete_annos([{block,Bl0}|Is]) -> + case delete_annos(Bl0) of + [] -> delete_annos(Is); + [_|_]=Bl -> [{block,Bl}|delete_annos(Is)] end; -delete_live_annos([{'%live',_,_}|Is]) -> - delete_live_annos(Is); -delete_live_annos([I|Is]) -> - [I|delete_live_annos(Is)]; -delete_live_annos([]) -> []. - +delete_annos([{'%anno',_}|Is]) -> + delete_annos(Is); +delete_annos([I|Is]) -> + [I|delete_annos(Is)]; +delete_annos([]) -> []. + %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. @@ -309,11 +312,11 @@ delete_live_annos([]) -> []. combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> H1 + H2; combine_heap_needs(H1, H2) -> - combine_alloc_lists([H1,H2]). + {alloc,combine_alloc_lists([H1,H2])}. %% anno_defs(Instructions) -> Instructions' -%% Add {'%def',RegisterBitmap} annotations to the beginning of +%% Add {def,RegisterBitmap} annotations to the beginning of %% each block. Iff bit X is set in the the bitmap, it means %% that {x,X} is defined when the block is entered. @@ -347,6 +350,9 @@ split_even(Rs) -> split_even(Rs, [], []). %% %% killed - Reg is assigned or killed by an allocation instruction. %% not_used - the value of Reg is not used, but Reg must not be garbage +%% exit_not_used - the value of Reg is not used, but must not be garbage +%% because the stack will be scanned because an +%% exit BIF will raise an exception %% used - Reg is used check_liveness(R, [{block,Blk}|Is], St0) -> @@ -370,6 +376,8 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> case check_liveness_at(R, Fail, St0) of {killed,St1} -> check_liveness(R, Is, St1); + {exit_not_used,St1} -> + check_liveness(R, Is, St1); {not_used,St1} -> not_used(check_liveness(R, Is, St1)); {used,_}=Used -> @@ -389,6 +397,8 @@ check_liveness(R, [{jump,{f,F}}|_], St) -> check_liveness_at(R, F, St); check_liveness(R, [{case_end,Used}|_], St) -> check_liveness_ret(R, Used, St); +check_liveness(R, [{try_case_end,Used}|_], St) -> + check_liveness_ret(R, Used, St); check_liveness(R, [{badmatch,Used}|_], St) -> check_liveness_ret(R, Used, St); check_liveness(_, [if_end|_], St) -> @@ -432,7 +442,7 @@ check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> false -> if R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) + true -> not_used(check_liveness(R, Is, St)) end end end; @@ -466,7 +476,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> %% We must make sure we don't check beyond this %% instruction or we will fall through into random %% unrelated code and get stuck in a loop. - {killed,St} + {exit_not_used,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -514,16 +524,12 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> {x,_} -> {killed,St}; {y,_} -> not_used(check_liveness(R, Is, St)) end; -check_liveness({x,_}=R, [{'catch',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions following the catch instruction. - check_liveness(R, Is, St); -check_liveness({x,_}=R, [{'try',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions inside the 'try' block. - check_liveness(R, Is, St); +check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); +check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); check_liveness(R, [{try_end,Y}|Is], St) -> case R of Y -> @@ -584,6 +590,12 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) -> Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}}, check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_tuple,Ar,D}|Is], St) -> + Set = {set,[D],[],{put_tuple,Ar}}, + check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_list,S1,S2,D}|Is], St) -> + Set = {set,[D],[S1,S2],put_list}, + check_liveness(R, [{block,[Set]}||Is], St); check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -597,6 +609,12 @@ check_liveness(R, [remove_message|Is], St) -> check_liveness(R, Is, St); check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 -> {killed,St}; +check_liveness(R, [{recv_mark,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{recv_set,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{'%',_}|Is], St) -> + check_liveness(R, Is, St); check_liveness(_R, Is, St) when is_list(Is) -> %% Not implemented. Conservatively assume that the register is used. {used,St}. @@ -631,6 +649,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} end. +not_used({exit_not_used,St}) -> {not_used,St}; not_used({killed,St}) -> {not_used,St}; not_used({_,_}=Res) -> Res. @@ -649,7 +668,7 @@ check_liveness_ret(_, _, St) -> {killed,St}. %% alloc_used - Used only in an allocate instruction %% used - Reg is explicitly used by an instruction %% -%% '%live' annotations are not allowed. +%% Annotations are not allowed. %% %% (Unknown instructions will cause an exception.) @@ -659,13 +678,30 @@ check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> {killed,St0}; true -> case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {killed,St} -> {not_used,St}; {transparent,St} -> {alloc_used,St}; - {_,_}=Res -> Res + {_,_}=Res -> not_used(Res) end end; -check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) -> - check_liveness_block_1(R, Ss, Ds, Op, Is, St); +check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {transparent,St} -> {alloc_used,St}; + {_,_}=Res -> not_used(Res) + end; +check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) -> + case Ds of + [R] -> + {killed,St0}; + _ -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {exit_not_used,St} -> + {used,St}; + {transparent,St} -> + %% Conservatively assumed that it is used. + {used,St}; + {_,_}=Res -> + Res + end + end; check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) -> check_liveness_block_1(R, Ss, Ds, Op, Is, St); check_liveness_block(_, [], St) -> {transparent,St}. @@ -681,6 +717,11 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> true -> {killed,St}; false -> check_liveness_block(R, Is, St) end; + {exit_not_used,St} -> + case member(R, Ds) of + true -> {exit_not_used,St}; + false -> check_liveness_block(R, Is, St) + end; {not_used,St} -> not_used(case member(R, Ds) of true -> {killed,St}; @@ -824,9 +865,9 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> %% Other instructions. live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = {'%live',live_regs(Regs0),Regs0}, + Live0 = make_anno({used,Regs0}), {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - Live = {'%live',live_regs(Regs),Regs}, + Live = make_anno({used,Regs}), live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); live_opt([build_stacktrace=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); @@ -871,7 +912,8 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> +live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) -> + Regs0 = 0, Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); @@ -894,6 +936,25 @@ live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); +live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{bif,N,F}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) -> + Regs = x_live([Src], x_dead([Dst], Regs0)), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> @@ -910,6 +971,10 @@ live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'from_asm' option. @@ -940,7 +1005,7 @@ live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) -> _ -> live_opt_block(Is, Regs, D, [I|Acc]) end; -live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) -> +live_opt_block([{'%anno',_}|Is], Regs, D, Acc) -> live_opt_block(Is, Regs, D, Acc); live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. @@ -1015,7 +1080,7 @@ defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) -> [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; defs([{block,Block0}|Is], Regs0, D0) -> {Block,Regs,D} = defs_list(Block0, Regs0, D0), - [{block,[{'%def',Regs0}|Block]}|defs(Is, Regs, D)]; + [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)]; defs([{bs_init,{f,L},_,_,_,Dst}=I|Is], Regs0, D) -> Regs = def_regs([Dst], Regs0), [I|defs(Is, Regs, update_regs(L, Regs, D))]; @@ -1205,3 +1270,13 @@ update_regs(L, Regs0, D) -> all_defined(Live, Regs) -> All = (1 bsl Live) - 1, Regs band All =:= All. + +%%% +%%% Utilities. +%%% + +%% make_anno(Anno) -> WrappedAnno. +%% Wrap an annotation term. + +make_anno(Anno) -> + {'%anno',Anno}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 2ad9747940..4feb26c513 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -530,9 +530,10 @@ valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> Type = bif_type(Op, Src, Vst), set_type_reg(Type, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, - verify_live(Live, Vst1), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), validate_src(Src, Vst), @@ -686,6 +687,7 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -698,6 +700,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -710,6 +713,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), assert_term(Bits, Vst0), assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), @@ -945,6 +949,7 @@ deallocate(#vst{current=St}=Vst) -> test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), heap_alloc(Heap, Vst). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 770aa2c6c1..1409c358c2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -775,6 +775,8 @@ asm_passes() -> {iff,drecv,{listing,"recv"}}, {unless,no_record_opt,{pass,beam_record}}, {iff,drecord,{listing,"record"}}, + {unless,no_blk2,?pass(block2)}, + {iff,dblk2,{listing,"block2"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, @@ -1350,6 +1352,10 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,St} end. +block2(Code0, #compile{options=Opts}=St) -> + {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]), + {ok,Code,St}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e28d48acf5..46816fe24a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -145,14 +145,9 @@ find_fixpoint(OptFun, Core0, Max) -> body(Body, Sub) -> body(Body, value, Sub). -body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> - Es1 = expr_list(Es0, Ctxt, Sub), - case Ctxt of - value -> - #c_values{anno=A,es=Es1}; - effect -> - make_effect_seq(Es1, Sub) - end; +body(#c_values{anno=A,es=Es0}, value, Sub) -> + Es1 = expr_list(Es0, value, Sub), + #c_values{anno=A,es=Es1}; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). @@ -313,9 +308,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case is_safe_simple(Arg, Sub) of - true -> B1; - false -> Seq0#c_seq{arg=Arg,body=B1} + case {Ctxt,is_safe_simple(Arg, Sub)} of + {effect,true} -> B1; + {effect,false} -> + case is_safe_simple(B1, Sub) of + true -> Arg; + false -> Seq0#c_seq{arg=Arg,body=B1} + end; + {value,true} -> B1; + {value,false} -> Seq0#c_seq{arg=Arg,body=B1} end end; expr(#c_let{}=Let0, Ctxt, Sub) -> @@ -379,10 +380,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), - case move_case_into_arg(Case, Sub) of - impossible -> Expr; - Other -> Other - end; + move_case_into_arg(Expr, Sub); Other -> expr(Other, Ctxt, Sub) end; @@ -2664,53 +2662,93 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), BodySub = update_let_types(Vs, Args, Sub1), + Sub = Sub1#sub{v=[],s=cerl_sets:new()}, B = body(B0, Ctxt, BodySub), Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + opt_simple_let_2(Let, Vs, Arg, B, B0, Sub). + + +%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core. +%% Do final simplifications of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. -opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> - case N1 =:= N2 of - true -> - %% let <Var> = Arg in <Var> ==> Arg - Arg1; - false -> - %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - #c_seq{arg=Arg,body=Body} - end; + {[#c_var{name=V}],Arg1,#c_var{name=V}} -> + %% let <Var> = Arg in <Var> ==> Arg + Arg1; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - case Ctxt of - effect -> - %% Throw away the literal body. - Arg; - value -> - %% Since the variable is not used in the body, we - %% can rewrite the let to a sequence. - %% let <Var> = Arg in Literal ==> seq Arg Literal - #c_seq{arg=Arg,body=Body} - end; - {Vs,Arg1,Body} -> - %% If none of the variables are used in the body, we can - %% rewrite the let to a sequence: - %% let <Var> = Arg in BodyWithoutVar ==> - %% seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - #c_seq{arg=Arg,body=Body}; - true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - opt_bool_case_in_let(Let1, Sub) + {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + case core_lib:is_var_used(V, Body) of + false when Vars =:= [] -> + %% If the variable is not used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar + Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), + #c_seq{arg=Arg,body=Body}; + false -> + %% There are multiple values returned by the argument + %% and the first value is not used (this is a 'case' + %% with exported variables, but the return value is + %% ignored). We can remove the first variable and the + %% the first value returned from the 'let' argument. + Arg2 = remove_first_value(Arg1, Sub), + Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, + post_opt_let(Let1, Sub); + true -> + Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, + post_opt_let(Let1, Sub) end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' +%% post_opt_let(Let, Sub) +%% Final optimizations of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +post_opt_let(Let, Sub) -> + opt_bool_case_in_let(Let, Sub). + + +%% remove_first_value(Core0, Sub) -> Core. +%% Core0 is an expression that returns at least two values. +%% Remove the first value returned from Core0. + +remove_first_value(#c_values{es=[V|Vs]}, Sub) -> + Values = core_lib:make_values(Vs), + case is_safe_simple(V, Sub) of + false -> + #c_seq{arg=V,body=Values}; + true -> + Values + end; +remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Core#c_case{clauses=Cs}; +remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Act = remove_first_value(Act0, Sub), + Core#c_receive{clauses=Cs,action=Act}; +remove_first_value(#c_let{body=B}=Core, Sub) -> + Core#c_let{body=remove_first_value(B, Sub)}; +remove_first_value(#c_seq{body=B}=Core, Sub) -> + Core#c_seq{body=remove_first_value(B, Sub)}; +remove_first_value(#c_primop{}=Core, _Sub) -> + Core; +remove_first_value(#c_call{}=Core, _Sub) -> + Core. + +remove_first_value_cs(Cs, Sub) -> + [C#c_clause{body=remove_first_value(B, Sub)} || + #c_clause{body=B}=C <- Cs]. + +%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2721,12 +2759,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, Vs, PrevBody) -> +maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> - case is_any_var_used(Vs, PrevBody) of + case core_lib:is_var_used(V, PrevBody) of true -> suppress_warning([Arg]); false -> @@ -2815,7 +2853,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, Outer#c_case{arg=OuterArg, clauses=[OuterCa,OuterCb]}; false -> - impossible + Inner0 end; move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, clauses=InnerClauses}=Inner, _Sub) -> @@ -2831,15 +2869,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, %% Outer#c_seq{arg=OuterArg, body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; -move_case_into_arg(_, _) -> - impossible. - -is_any_var_used([#c_var{name=V}|Vs], Expr) -> - case core_lib:is_var_used(V, Expr) of - false -> is_any_var_used(Vs, Expr); - true -> true - end; -is_any_var_used([], _) -> false. +move_case_into_arg(Expr, _) -> + Expr. %%% %%% Retrieving information about types. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 86146c614f..fe856b12b6 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -22,7 +22,8 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, integers/1,coverage/1,booleans/1,setelement/1,cons/1, - tuple/1,record_float/1,binary_float/1,float_compare/1]). + tuple/1,record_float/1,binary_float/1,float_compare/1, + arity_checks/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -40,7 +41,8 @@ groups() -> tuple, record_float, binary_float, - float_compare + float_compare, + arity_checks ]}]. init_per_suite(Config) -> @@ -171,6 +173,31 @@ do_float_compare(X) -> _T -> Y > 0 end. +arity_checks(_Config) -> + %% ERL-549: an unsafe optimization removed a test_arity instruction, + %% causing the following to return 'broken' instead of 'ok'. + ok = do_record_arity_check({rgb, 255, 255, 255, 1}), + ok = do_tuple_arity_check({255, 255, 255, 1}). + +-record(rgb, {r = 255, g = 255, b = 255}). + +do_record_arity_check(RGB) when + (element(2, RGB) >= 0), (element(2, RGB) =< 255), + (element(3, RGB) >= 0), (element(3, RGB) =< 255), + (element(4, RGB) >= 0), (element(4, RGB) =< 255) -> + if + element(1, RGB) =:= rgb, is_record(RGB, rgb) -> broken; + true -> ok + end. + +do_tuple_arity_check(RGB) when is_tuple(RGB), + (element(1, RGB) >= 0), (element(1, RGB) =< 255), + (element(2, RGB) >= 0), (element(2, RGB) =< 255), + (element(3, RGB) >= 0), (element(3, RGB) =< 255) -> + case RGB of + {255, _, _} -> broken; + _ -> ok + end. id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 7e1a432511..7557d6d57b 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -40,7 +40,7 @@ map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, parse_xml/1,get_payload/1,escape/1,num_slots_different/1, - check_bitstring_list/1,guard/1]). + beam_bsm/1,guard/1,is_ascii/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -73,7 +73,7 @@ groups() -> map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, get_payload,escape,num_slots_different, - check_bitstring_list,guard]}]. + beam_bsm,guard,is_ascii]}]. init_per_suite(Config) -> @@ -801,7 +801,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false. first_after(Data, Offset) -> case byte_size(Data) > Offset of false -> - {First, Rest} = {ok, ok}, + {_First, _Rest} = {ok, ok}, ok; true -> <<_:Offset/binary, Rest/binary>> = Data, @@ -1515,7 +1515,7 @@ is_next_char_whitespace(<<C/utf8,_/binary>>) -> {this_hdr = 17, ext_hdr_opts}). -get_payload(Config) -> +get_payload(_Config) -> <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}), {'EXIT',_} = (catch do_get_payload(#ext_header{})), ok. @@ -1574,10 +1574,22 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) -> lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) -> {ok, <<"Ressourcen">>}. -%% Cover more code in beam_bsm. -check_bitstring_list(_Config) -> +%% Test more code in beam_bsm. +beam_bsm(_Config) -> true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]), false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]), + + true = bsm_validate_scheme(<<>>), + true = bsm_validate_scheme(<<5,10>>), + false = bsm_validate_scheme(<<5,10,11,12>>), + true = bsm_validate_scheme([]), + true = bsm_validate_scheme([5,10]), + false = bsm_validate_scheme([5,6,7]), + + <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []), + D = fun(N) -> 2*N end, + [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]), + ok. check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> @@ -1587,8 +1599,32 @@ check_bitstring_list(<<>>, []) -> check_bitstring_list(_, _) -> false. +bsm_validate_scheme([]) -> true; +bsm_validate_scheme([H|T]) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(T); + false -> false + end; +bsm_validate_scheme(<<>>) -> true; +bsm_validate_scheme(<<H, Rest/binary>>) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(Rest); + false -> false + end. + +bsm_is_scheme(Int) -> + Int rem 5 =:= 0. + +%% NOT OPTIMIZED: different control paths use different positions in the binary +bsm_must_save_and_not_save(Bin, []) -> + Bin; +bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) -> + [F(H)|bsm_must_save_and_not_save(T, Fs)]; +bsm_must_save_and_not_save(<<>>, []) -> + []. + guard(_Config) -> - Tuple = id({a,b}), + _Tuple = id({a,b}), ok = guard_1(<<1,2,3>>, {1,2,3}), ok = guard_2(<<42>>, #{}), ok. @@ -1601,6 +1637,24 @@ guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} -> guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} -> ok. +is_ascii(_Config) -> + true = do_is_ascii(<<>>), + true = do_is_ascii(<<"string">>), + false = do_is_ascii(<<1024/utf8>>), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)), + ok. + +do_is_ascii(<<>>) -> + true; +do_is_ascii(<<C,_/binary>>) when C >= 16#80 -> + %% This clause must fail to match if the size of the argument in + %% bits is not divisible by 8. Beware of unsafe optimizations. + false; +do_is_ascii(<<_, T/binary>>) -> + do_is_ascii(T). + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 262967d03d..4fd1f84569 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -27,7 +27,7 @@ multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, no_no_file/1,configuration/1,supplies/1, - redundant_stack_frame/1]). + redundant_stack_frame/1,export_from_case/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -47,7 +47,7 @@ groups() -> multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, no_no_file,configuration,supplies, - redundant_stack_frame]}]. + redundant_stack_frame,export_from_case]}]. init_per_suite(Config) -> @@ -551,4 +551,38 @@ do_redundant_stack_frame(Map) -> end, {X, Y}. +%% Cover some clauses in sys_core_fold:remove_first_value/2. + +-record(export_from_case, {val}). + +export_from_case(_Config) -> + a = export_from_case_1(true), + b = export_from_case_1(false), + + R = #export_from_case{val=0}, + {ok,R} = export_from_case_2(false, R), + {ok,#export_from_case{val=42}} = export_from_case_2(true, R), + + ok. + +export_from_case_1(Bool) -> + case Bool of + true -> + id(42), + Result = a; + false -> + Result = b + end, + id(Result). + +export_from_case_2(Bool, Rec) -> + case Bool of + false -> + Result = Rec; + true -> + Result = Rec#export_from_case{val=42} + end, + {ok,Result}. + + id(I) -> I. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 6957d25774..9a3ea07c97 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -179,6 +179,12 @@ # define HAVE_ECB_IVEC_BUG #endif +#define HAVE_RSA_SSLV23_PADDING +#if defined(HAS_LIBRESSL) \ + && LIBRESSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(2,6,1) +# undef HAVE_RSA_SSLV23_PADDING +#endif + #if defined(HAVE_CMAC) #include <openssl/cmac.h> #endif @@ -659,7 +665,9 @@ static ERL_NIF_TERM atom_rsa_oaep_md; static ERL_NIF_TERM atom_rsa_pad; /* backwards compatibility */ static ERL_NIF_TERM atom_rsa_padding; static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding; +#ifdef HAVE_RSA_SSLV23_PADDING static ERL_NIF_TERM atom_rsa_sslv23_padding; +#endif static ERL_NIF_TERM atom_rsa_x931_padding; static ERL_NIF_TERM atom_rsa_pss_saltlen; static ERL_NIF_TERM atom_sha224; @@ -1064,7 +1072,9 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_rsa_pad = enif_make_atom(env,"rsa_pad"); /* backwards compatibility */ atom_rsa_padding = enif_make_atom(env,"rsa_padding"); atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding"); +#ifdef HAVE_RSA_SSLV23_PADDING atom_rsa_sslv23_padding = enif_make_atom(env,"rsa_sslv23_padding"); +#endif atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding"); atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen"); atom_sha224 = enif_make_atom(env,"sha224"); @@ -4449,8 +4459,10 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI opt->rsa_padding = RSA_PKCS1_PADDING; } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; +#ifdef HAVE_RSA_SSLV23_PADDING } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { opt->rsa_padding = RSA_SSLV23_PADDING; +#endif } else if (tpl_terms[1] == atom_rsa_x931_padding) { opt->rsa_padding = RSA_X931_PADDING; } else if (tpl_terms[1] == atom_rsa_no_padding) { @@ -4516,7 +4528,10 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif PKeyCryptOptions crypt_opt; ErlNifBinary in_bin, out_bin, tmp_bin; - size_t outlen, tmplen; + size_t outlen; +#ifdef HAVE_RSA_SSLV23_PADDING + size_t tmplen; +#endif int is_private = (argv[4] == atom_true), is_encrypt = (argv[5] == atom_true); int algo_init = 0; @@ -4596,6 +4611,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM if (crypt_opt.signature_md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0) goto badarg; +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { if (is_encrypt) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); @@ -4607,9 +4623,11 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM in_bin = tmp_bin; } if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg; - } else { + } else +#endif + { if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg; - } + } #ifdef HAVE_RSA_OAEP_MD if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { if (crypt_opt.rsa_oaep_md != NULL @@ -4728,6 +4746,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) { +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); unsigned char *p; @@ -4745,6 +4764,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM i = 1; } } +#endif } if (tmp_bin.data != NULL) { diff --git a/lib/dialyzer/test/small_SUITE_data/src/abs.erl b/lib/dialyzer/test/small_SUITE_data/src/abs.erl index 251e24cdfc..0e38c3dbb7 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/abs.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/abs.erl @@ -5,7 +5,7 @@ -export([t/0]). t() -> - Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0], + Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0, fun erl_551/0], _ = [catch F() || F <- Fs], ok. @@ -60,6 +60,13 @@ f1() -> f1(A) -> abs(A). +erl_551() -> + accept(9), + accept(-3). + +accept(Number) when abs(Number) >= 8 -> first; +accept(_Number) -> second. + -spec int() -> integer(). int() -> diff --git a/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl new file mode 100644 index 0000000000..2dc00d272a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl @@ -0,0 +1,14 @@ +-module(erl_tar_table). + +%% OTP-14860, PR 1670. + +-export([t/0, v/0, x/0]). + +t() -> + {ok, ["file"]} = erl_tar:table("table.tar"). + +v() -> + {ok, [{_,_,_,_,_,_,_}]} = erl_tar:table("table.tar", [verbose]). + +x() -> + {ok, ["file"]} = erl_tar:table("table.tar", []). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 462a1f9dcd..fc6a844e22 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1974,9 +1974,11 @@ arith_abs(X1, Opaques) -> case infinity_geq(Min1, 0) of true -> {Min1, Max1}; false -> + NegMin1 = infinity_inv(Min1), + NegMax1 = infinity_inv(Max1), case infinity_geq(Max1, 0) of - true -> {0, infinity_inv(Min1)}; - false -> {infinity_inv(Max1), infinity_inv(Min1)} + true -> {0, max(NegMin1, Max1)}; + false -> {NegMax1, NegMin1} end end, t_from_range(NewMin, NewMax) diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index b9e7d93570..aa85626857 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -279,13 +279,22 @@ bad_floats() -> %% (incorrectly) signed. huge_binaries() -> - AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), case erlang:system_info(wordsize) of - 4 -> huge_binaries_32(AlmostIllegal); + 4 -> + Old = erts_debug:set_internal_state(available_internal_state, true), + case erts_debug:set_internal_state(binary, (1 bsl 29)-1) of + false -> + io:format("\nNot enough memory to create 512Mb binary\n",[]); + Bin-> + huge_binaries_32(Bin) + end, + erts_debug:set_internal_state(available_internal_state, Old); + 8 -> ok end, garbage_collect(), id(<<0:(id((1 bsl 31)-1))>>), + garbage_collect(), id(<<0:(id((1 bsl 30)-1))>>), garbage_collect(), ok. diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c index b3a18e03d4..446b46ad82 100644 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c @@ -1365,8 +1365,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1579,8 +1579,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c index 40c7328f03..d6a78d2481 100644 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c index 33cfe71322..17ef21f4f4 100644 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 58abb35428..8477b0e148 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -93,13 +93,6 @@ are now <em>rejected</em> and will cause primitive file operations fail. </p></note> - <warning><p> - Currently null characters at the end of the filename - will be accepted by primitive file operations. Such - filenames are however still documented as invalid. The - implementation will also change in the future and - reject such filenames. - </p></warning> </description> diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 169a76463b..abb045b744 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -197,6 +197,9 @@ fe80::204:acff:fe17:bf38 <datatype> <name name="address_family"/> </datatype> + <datatype> + <name name="socket_protocol"/> + </datatype> </datatypes> <funcs> @@ -461,6 +464,61 @@ get_tcpi_sacked(Sock) -> </func> <func> + <name name="i" arity="0" /> + <name name="i" arity="1" /> + <name name="i" arity="2" /> + <fsummary>Displays information and statistics about sockets on the terminal</fsummary> + <desc> + <p> + Lists all TCP, UDP and SCTP sockets, including those that the Erlang runtime system uses as well as + those created by the application. + </p> + <p> + The following options are available: + </p> + + <taglist> + <tag><c>port</c></tag> + <item> + <p>The internal index of the port.</p> + </item> + <tag><c>module</c></tag> + <item> + <p>The callback module of the socket.</p> + </item> + <tag><c>recv</c></tag> + <item> + <p>Number of bytes received by the socket.</p> + </item> + <tag><c>sent</c></tag> + <item> + <p>Number of bytes sent from the socket.</p> + </item> + <tag><c>owner</c></tag> + <item> + <p>The socket owner process.</p> + </item> + <tag><c>local_address</c></tag> + <item> + <p>The local address of the socket.</p> + </item> + <tag><c>foreign_address</c></tag> + <item> + <p>The address and port of the other end of the connection.</p> + </item> + <tag><c>state</c></tag> + <item> + <p>The connection state.</p> + </item> + <tag><c>type</c></tag> + <item> + <p>STREAM or DGRAM or SEQPACKET.</p> + </item> + </taglist> + </desc> + </func> + + <func> <name name="ntoa" arity="1" /> <fsummary>Convert IPv6/IPV4 address to ASCII.</fsummary> <desc> @@ -1214,7 +1272,7 @@ inet:setopts(Sock,[{raw,6,8,<<30:32/native>>}]),]]></code> For one-to-many style sockets, the special value <c>0</c> is defined to mean that the returned addresses must be without any particular association. - How different SCTP implementations interprets this varies somewhat. + How different SCTP implementations interpret this varies somewhat. </p> </desc> </func> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index e5ac031539..0762cebc94 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1996</year><year>2017</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -469,8 +469,12 @@ MaxT = TickTime + TickTime / 4</code> <item><c>ObjSuffix = string()</c></item> <item><c>SrcSuffix = string()</c></item> </list> - <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and - <c>filelib:find_source/2</c>. If this is set to some other value + <p>Specifies a list of rules for use by + <seealso marker="stdlib:filelib#find_file/2"> + <c>filelib:find_file/2</c></seealso> + <seealso marker="stdlib:filelib#find_source/2"> + <c>filelib:find_source/2</c></seealso> + If this is set to some other value than the empty list, it replaces the default rules. Rules can be simple pairs of directory suffixes, such as <c>{"ebin", "src"}</c>, which are used by <c>filelib:find_file/2</c>, or @@ -478,6 +482,16 @@ MaxT = TickTime + TickTime / 4</code> file name extensions, for example <c>[{".beam", ".erl", [{"ebin", "src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both kinds of rules can be mixed in the list.</p> + <p>The interpretation of <c>ObjDirSuffix</c> and <c>SrcDirSuffix</c> + is as follows: if the end of the directory name where an + object is located matches <c>ObjDirSuffix</c>, then the + name created by replacing <c>ObjDirSuffix</c> with + <c>SrcDirSuffix</c> is expanded by calling + <seealso marker="stdlib:filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>, and the first regular + file found among the matches is the source file. + </p> + </item> </taglist> </section> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 0a08e2c78a..c27182ff0b 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -58,17 +58,6 @@ operations to fail. </p> </note> - <warning> - <p> - Currently null characters at the end of filenames, - environment variable names and values will be accepted - by the primitive operations. Such filenames, environment - variable names and values are however still documented as - invalid. The implementation will also change in the - future and reject such filenames, environment variable - names and values. - </p> - </warning> </description> <datatypes> @@ -143,12 +132,8 @@ <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 - (integer value zero) often are interpreted as string termination. - Current implementation still accepts null characters at the end - of <c><anno>Command</anno></c> even though the documentation - states that no null characters are allowed. This will however - be changed in the future so that no null characters at all will - be accepted.</p></warning> + (integer value zero) often are interpreted as string termination. The + current implementation rejects these.</p></warning> <p><em>Examples:</em></p> <code type="none"> LsOut = os:cmd("ls"), % on unix platform diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index dc20c21c77..fe91b0d33e 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -72,7 +72,7 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). --export_type([address_family/0, hostent/0, hostname/0, ip4_address/0, +-export_type([address_family/0, socket_protocol/0, hostent/0, hostname/0, ip4_address/0, ip6_address/0, ip_address/0, port_number/0, local_address/0, socket_address/0, returned_non_ip_address/0, socket_setopt/0, socket_getopt/0, @@ -1452,11 +1452,14 @@ fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) -> %% socket stat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec i() -> ok. i() -> i(tcp), i(udp), i(sctp). +-spec i(socket_protocol()) -> ok. i(Proto) -> i(Proto, [port, module, recv, sent, owner, local_address, foreign_address, state, type]). +-spec i(socket_protocol(), [atom()]) -> ok. i(tcp, Fs) -> ii(tcp_sockets(), Fs, tcp); i(udp, Fs) -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index b5f19d4b99..fbc046c8f9 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -27,12 +27,13 @@ -export_type([env_var_name/0, env_var_value/0, env_var_name_value/0, command_input/0]). +-export([getenv/0, getenv/1, getenv/2, putenv/2, unsetenv/1]). + %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, - perf_counter/0, perf_counter/1, - putenv/2, set_signal/2, system_time/0, system_time/1, - timestamp/0, unsetenv/1]). +-export([get_env_var/1, getpid/0, list_env_vars/0, perf_counter/0, + perf_counter/1, set_env_var/2, set_signal/2, system_time/0, + system_time/1, timestamp/0, unset_env_var/1]). -type env_var_name() :: nonempty_string(). @@ -42,29 +43,15 @@ -type command_input() :: atom() | io_lib:chars(). --spec getenv() -> [env_var_name_value()]. - -getenv() -> erlang:nif_error(undef). - --spec getenv(VarName) -> Value | false when - VarName :: env_var_name(), - Value :: env_var_value(). - -getenv(_) -> +-spec list_env_vars() -> [{env_var_name(), env_var_value()}]. +list_env_vars() -> erlang:nif_error(undef). --spec getenv(VarName, DefaultValue) -> Value when +-spec get_env_var(VarName) -> Value | false when VarName :: env_var_name(), - DefaultValue :: env_var_value(), Value :: env_var_value(). - -getenv(VarName, DefaultValue) -> - case os:getenv(VarName) of - false -> - DefaultValue; - Value -> - Value - end. +get_env_var(_VarName) -> + erlang:nif_error(undef). -spec getpid() -> Value when Value :: string(). @@ -84,11 +71,10 @@ perf_counter() -> perf_counter(Unit) -> erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). --spec putenv(VarName, Value) -> true when +-spec set_env_var(VarName, Value) -> true when VarName :: env_var_name(), Value :: env_var_value(). - -putenv(_, _) -> +set_env_var(_, _) -> erlang:nif_error(undef). -spec system_time() -> integer(). @@ -108,10 +94,9 @@ system_time(_Unit) -> timestamp() -> erlang:nif_error(undef). --spec unsetenv(VarName) -> true when +-spec unset_env_var(VarName) -> true when VarName :: env_var_name(). - -unsetenv(_) -> +unset_env_var(_) -> erlang:nif_error(undef). -spec set_signal(Signal, Option) -> 'ok' when @@ -125,6 +110,39 @@ set_signal(_Signal, _Option) -> %%% End of BIFs +-spec getenv() -> [env_var_name_value()]. +getenv() -> + [lists:flatten([Key, $=, Value]) || {Key, Value} <- os:list_env_vars() ]. + +-spec getenv(VarName) -> Value | false when + VarName :: env_var_name(), + Value :: env_var_value(). +getenv(VarName) -> + os:get_env_var(VarName). + +-spec getenv(VarName, DefaultValue) -> Value when + VarName :: env_var_name(), + DefaultValue :: env_var_value(), + Value :: env_var_value(). +getenv(VarName, DefaultValue) -> + case os:getenv(VarName) of + false -> + DefaultValue; + Value -> + Value + end. + +-spec putenv(VarName, Value) -> true when + VarName :: env_var_name(), + Value :: env_var_value(). +putenv(VarName, Value) -> + os:set_env_var(VarName, Value). + +-spec unsetenv(VarName) -> true when + VarName :: env_var_name(). +unsetenv(VarName) -> + os:unset_env_var(VarName). + -spec type() -> {Osfamily, Osname} when Osfamily :: unix | win32, Osname :: atom(). diff --git a/lib/observer/include/etop.hrl b/lib/observer/include/etop.hrl index 002937e522..f8d370450b 100644 --- a/lib/observer/include/etop.hrl +++ b/lib/observer/include/etop.hrl @@ -18,4 +18,4 @@ %% %CopyrightEnd% %% --include("../../runtime_tools/include/observer_backend.hrl"). +-include_lib("runtime_tools/include/observer_backend.hrl"). diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index f6d282638a..6c4739042b 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -48,6 +48,7 @@ init([Id, Data, ParentFrame, Callback, App, Parent]) -> display_progress(ParentFrame,App), case Callback:get_details(Id, Data) of {ok,Details} -> + display_progress_pulse(Callback,Id), init(Id,ParentFrame,Callback,App,Parent,Details); {yes_no, Info, Fun} -> destroy_progress(App), @@ -69,8 +70,16 @@ display_progress(ParentFrame,cdv) -> "Reading data"); display_progress(_,_) -> ok. + +%% Display pulse while creating process detail page with much data +display_progress_pulse(cdv_proc_cb,Pid) -> + observer_lib:report_progress({ok,"Displaying data for "++Pid}), + observer_lib:report_progress({ok,start_pulse}); +display_progress_pulse(_,_) -> + ok. + destroy_progress(cdv) -> - observer_lib:destroy_progress_dialog(); + observer_lib:sync_destroy_progress_dialog(); destroy_progress(_) -> ok. diff --git a/lib/observer/src/cdv_info_wx.erl b/lib/observer/src/cdv_info_wx.erl index 7e416dd11a..07c28610e2 100644 --- a/lib/observer/src/cdv_info_wx.erl +++ b/lib/observer/src/cdv_info_wx.erl @@ -95,6 +95,10 @@ handle_cast(Msg, State) -> io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down},userData=Target}, State) -> cdv_virtual_list_wx:start_detail_win(Target), {noreply, State}; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index f197e72b90..bba97624a7 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -1240,7 +1240,7 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> "Last calls" -> get_procinfo(Fd,Fun,Proc#proc{last_calls=get_last_calls(Fd)},WS); "Link list" -> - {Links,Monitors,MonitoredBy} = parse_link_list(bytes(Fd),[],[],[]), + {Links,Monitors,MonitoredBy} = get_link_list(Fd), get_procinfo(Fd,Fun,Proc#proc{links=Links, monitors=Monitors, mon_by=MonitoredBy},WS); @@ -1322,86 +1322,64 @@ get_last_calls(Fd,<<>>,Acc,Lines) -> lists:reverse(Lines,[byte_list_to_string(lists:reverse(Acc))]) end. -parse_link_list([SB|Str],Links,Monitors,MonitoredBy) when SB==$[; SB==$] -> - parse_link_list(Str,Links,Monitors,MonitoredBy); -parse_link_list("#Port"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_port(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("<"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_pid(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("{to,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,[Mon|Monitors],MonitoredBy); -parse_link_list("{from,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,Monitors,[Mon|MonitoredBy]); -parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) -> - parse_link_list(Rest,Links,Monitors,MonitoredBy); -parse_link_list([],Links,Monitors,MonitoredBy) -> - {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}; -parse_link_list(Unexpected,Links,Monitors,MonitoredBy) -> - io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), - parse_link_list([],Links,Monitors,MonitoredBy). - - -parse_port(Str) -> - {Port,Rest} = parse_link(Str,[]), - {{Port,Port},Rest}. - -parse_pid(Str) -> - {Pid,Rest} = parse_link(Str,[]), - {{Pid,Pid},Rest}. - -parse_monitor("{"++Str) -> - %% Named process - {Name,Node,Rest1} = parse_name_node(Str,[]), - Pid = get_pid_from_name(Name,Node), - case parse_link(string:trim(Rest1,leading,","),[]) of - {Ref,"}"++Rest2} -> - %% Bug in break.c - prints an extra "}" for remote - %% nodes... thus the strip - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"}, - string:trim(Rest2,leading,"}")}; - {Ref,[]} -> - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},[]} - end; -parse_monitor(Str) -> - case parse_link(Str,[]) of - {Pid,","++Rest1} -> - case parse_link(Rest1,[]) of - {Ref,"}"++Rest2} -> - {{Pid,Pid++" ("++Ref++")"},Rest2}; - {Ref,[]} -> - {{Pid,Pid++" ("++Ref++")"},[]} - end; - {Pid,[]} -> - {{Pid,Pid++" (unknown_ref)"},[]} +get_link_list(Fd) -> + case get_chunk(Fd) of + {ok,<<"[",Bin/binary>>} -> + #{links:=Links, + mons:=Monitors, + mon_by:=MonitoredBy} = + get_link_list(Fd,Bin,#{links=>[],mons=>[],mon_by=>[]}), + {lists:reverse(Links), + lists:reverse(Monitors), + lists:reverse(MonitoredBy)}; + eof -> + {[],[],[]} end. -parse_link(">"++Rest,Acc) -> - {lists:reverse(Acc,">"),Rest}; -parse_link([H|T],Acc) -> - parse_link(T,[H|Acc]); -parse_link([],Acc) -> - %% truncated - {lists:reverse(Acc),[]}. +get_link_list(Fd,<<NL:8,_/binary>>=Bin,Acc) when NL=:=$\r; NL=:=$\n-> + skip(Fd,Bin), + Acc; +get_link_list(Fd,Bin,Acc) -> + case binary:split(Bin,[<<", ">>,<<"]">>]) of + [Link,Rest] -> + get_link_list(Fd,Rest,get_link(Link,Acc)); + [Incomplete] -> + case get_chunk(Fd) of + {ok,More} -> + get_link_list(Fd,<<Incomplete/binary,More/binary>>,Acc); + eof -> + Acc + end + end. -parse_name_node(","++Rest,Name) -> - parse_name_node(Rest,Name,[]); -parse_name_node([H|T],Name) -> - parse_name_node(T,[H|Name]); -parse_name_node([],Name) -> - %% truncated - {lists:reverse(Name),[],[]}. - -parse_name_node("}"++Rest,Name,Node) -> - {lists:reverse(Name),lists:reverse(Node),Rest}; -parse_name_node([H|T],Name,Node) -> - parse_name_node(T,Name,[H|Node]); -parse_name_node([],Name,Node) -> - %% truncated - {lists:reverse(Name),lists:reverse(Node),[]}. +get_link(<<"#Port",_/binary>>=PortBin,#{links:=Links}=Acc) -> + PortStr = binary_to_list(PortBin), + Acc#{links=>[{PortStr,PortStr}|Links]}; +get_link(<<"<",_/binary>>=PidBin,#{links:=Links}=Acc) -> + PidStr = binary_to_list(PidBin), + Acc#{links=>[{PidStr,PidStr}|Links]}; +get_link(<<"{to,",Bin/binary>>,#{mons:=Monitors}=Acc) -> + Acc#{mons=>[parse_monitor(Bin)|Monitors]}; +get_link(<<"{from,",Bin/binary>>,#{mon_by:=MonitoredBy}=Acc) -> + Acc#{mon_by=>[parse_monitor(Bin)|MonitoredBy]}; +get_link(Unexpected,Acc) -> + io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), + Acc. + +parse_monitor(MonBin) -> + case binary:split(MonBin,[<<",">>,<<"{">>,<<"}">>],[global]) of + [PidBin,RefBin,<<>>] -> + PidStr = binary_to_list(PidBin), + RefStr = binary_to_list(RefBin), + {PidStr,PidStr++" ("++RefStr++")"}; + [<<>>,NameBin,NodeBin,<<>>,RefBin,<<>>] -> + %% Named process + NameStr = binary_to_list(NameBin), + NodeStr = binary_to_list(NodeBin), + PidStr = get_pid_from_name(NameStr,NodeStr), + RefStr = binary_to_list(RefBin), + {PidStr,"{"++NameStr++","++NodeStr++"} ("++RefStr++")"} + end. get_pid_from_name(Name,Node) -> case ets:lookup(cdv_reg_proc_table,cdv_dump_node_name) of @@ -2029,12 +2007,16 @@ all_modinfo(Fd,LM,LineHead,DecodeOpts) -> end. get_attribute(Fd, DecodeOpts) -> + Term = do_get_attribute(Fd, DecodeOpts), + io_lib:format("~tp~n",[Term]). + +do_get_attribute(Fd, DecodeOpts) -> Bytes = bytes(Fd, ""), try get_binary(Bytes, DecodeOpts) of {Bin,_} -> try binary_to_term(Bin) of Term -> - io_lib:format("~tp~n",[Term]) + Term catch _:_ -> {"WARNING: The term is probably truncated!", diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 52e6c3e52a..0678b64134 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -21,7 +21,8 @@ -export([get_wx_parent/1, display_info_dialog/2, display_yes_no_dialog/1, - display_progress_dialog/3, destroy_progress_dialog/0, + display_progress_dialog/3, + destroy_progress_dialog/0, sync_destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, interval_dialog/4, start_timer/1, start_timer/2, stop_timer/1, timer_config/1, @@ -31,7 +32,8 @@ set_listctrl_col_size/2, create_status_bar/1, html_window/1, html_window/2, - make_obsbin/2 + make_obsbin/2, + add_scroll_entries/2 ]). -include_lib("wx/include/wx.hrl"). @@ -40,6 +42,8 @@ -define(SINGLE_LINE_STYLE, ?wxBORDER_NONE bor ?wxTE_READONLY bor ?wxTE_RICH2). -define(MULTI_LINE_STYLE, ?SINGLE_LINE_STYLE bor ?wxTE_MULTILINE). +-define(NUM_SCROLL_ITEMS,8). + -define(pulse_timeout,50). get_wx_parent(Window) -> @@ -397,17 +401,18 @@ get_box_info({Title, left, List}) -> {Title, ?wxALIGN_LEFT, List}; get_box_info({Title, right, List}) -> {Title, ?wxALIGN_RIGHT, List}. add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), + NumStr = " ("++integer_to_list(length(List))++")", + Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title ++ NumStr}]), Scroll = wxScrolledWindow:new(Panel), wxScrolledWindow:enableScrolling(Scroll,true,true), wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), - add_entries(Format, List, Scroll, ScrollSizer, Cursor), + Entries = add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), - {Scroll,ScrollSizer,length(List)}. + {Scroll,ScrollSizer,length(Entries)}. add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> @@ -415,7 +420,20 @@ add_entries(click, List, Scroll, ScrollSizer, Cursor) -> wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, - [Add(Link) || Link <- List]; + if length(List) > ?NUM_SCROLL_ITEMS -> + {List1,Rest} = lists:split(?NUM_SCROLL_ITEMS,List), + LinkEntries = [Add(Link) || Link <- List1], + NStr = integer_to_list(length(Rest)), + TC = link_entry2(Scroll, + {{more,{Rest,Scroll,ScrollSizer}},"more..."}, + Cursor, + "Click to see " ++ NStr ++ " more entries"), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + E = wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]), + LinkEntries ++ [E]; + true -> + [Add(Link) || Link <- List] + end; add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> TC = wxStaticText:new(Scroll, ?wxID_ANY, String), @@ -423,6 +441,23 @@ add_entries(plain, List, Scroll, ScrollSizer, _) -> end, [Add(String) || String <- List]. +add_scroll_entries(MoreEntry,{List, Scroll, ScrollSizer}) -> + wx:batch( + fun() -> + wxSizer:remove(ScrollSizer,?NUM_SCROLL_ITEMS), + wxStaticText:destroy(MoreEntry), + Cursor = wxCursor:new(?wxCURSOR_HAND), + Add = fun(Link) -> + TC = link_entry(Scroll, Link, Cursor), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) + end, + Entries = [Add(Link) || Link <- List], + wxCursor:destroy(Cursor), + wxSizer:layout(ScrollSizer), + wxSizer:setVirtualSizeHints(ScrollSizer,Scroll), + Entries + end). create_box(_Panel, {scroll_boxes,[]}) -> undefined; @@ -449,7 +484,7 @@ create_box(Panel, {scroll_boxes,Data}) -> {_,H} = wxWindow:getSize(Dummy), wxTextCtrl:destroy(Dummy), - MaxH = if MaxL > 8 -> 8*H; + MaxH = if MaxL > ?NUM_SCROLL_ITEMS -> ?NUM_SCROLL_ITEMS*H; true -> MaxL*H end, [wxWindow:setMinSize(B,{0,MaxH}) || {B,_,_} <- Boxes], @@ -504,20 +539,22 @@ create_box(Parent, Data) -> link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), - TC = link_entry2(Panel, to_link(Link), Cursor), + TC = link_entry(Panel, Link, Cursor), wxCursor:destroy(Cursor), TC. link_entry(Panel, Link, Cursor) -> - link_entry2(Panel, to_link(Link), Cursor). + link_entry2(Panel,to_link(Link),Cursor). link_entry2(Panel,{Target,Str},Cursor) -> + link_entry2(Panel,{Target,Str},Cursor,"Click to see properties for " ++ Str). +link_entry2(Panel,{Target,Str},Cursor,ToolTipText) -> TC = wxStaticText:new(Panel, ?wxID_ANY, Str), wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), wxWindow:connect(TC, left_down, [{userData,Target}]), wxWindow:connect(TC, enter_window), wxWindow:connect(TC, leave_window), - ToolTip = wxToolTip:new("Click to see properties for " ++ Str), + ToolTip = wxToolTip:new(ToolTipText), wxWindow:setToolTip(TC, ToolTip), TC. @@ -708,6 +745,11 @@ wait_for_progress() -> destroy_progress_dialog() -> report_progress(finish). +sync_destroy_progress_dialog() -> + Ref = erlang:monitor(process,?progress_handler), + destroy_progress_dialog(), + receive {'DOWN',Ref,process,_,_} -> ok end. + report_progress(Progress) -> case whereis(?progress_handler) of Pid when is_pid(Pid) -> @@ -787,9 +829,8 @@ progress_dialog_new(Parent,Title,Str) -> [{style,?wxDEFAULT_DIALOG_STYLE}]), Panel = wxPanel:new(Dialog), Sizer = wxBoxSizer:new(?wxVERTICAL), - Message = wxStaticText:new(Panel, 1, Str), - Gauge = wxGauge:new(Panel, 2, 100, [{size, {170, -1}}, - {style, ?wxGA_HORIZONTAL}]), + Message = wxStaticText:new(Panel, 1, Str,[{size,{220,-1}}]), + Gauge = wxGauge:new(Panel, 2, 100, [{style, ?wxGA_HORIZONTAL}]), SizerFlags = ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT bor ?wxTOP, wxSizer:add(Sizer, Message, [{flag,SizerFlags},{border,15}]), wxSizer:add(Sizer, Gauge, [{flag, SizerFlags bor ?wxBOTTOM},{border,15}]), diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 5908e99e36..f7ae07fb85 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -242,6 +242,10 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index 2e5fe0bc1a..d612e0a1c5 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -27,7 +27,7 @@ handle_event/2, handle_cast/2]). -include_lib("wx/include/wx.hrl"). --include("../include/etop.hrl"). +-include("etop.hrl"). -include("observer_defs.hrl"). -include("etop_defs.hrl"). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 4ce38e439d..4d3f306a0a 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -120,6 +120,10 @@ handle_event(#wx{id=?REFRESH}, #state{frame=Frame, pid=Pid, pages=Pages, expand_ end, {noreply, State}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index bb1755f530..b5e94a893a 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -83,6 +83,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> link(OtherPid), % own node link(Pid2), % external node erlang:monitor(process,OtherPid), + erlang:monitor(process,init), % named process erlang:monitor(process,Pid2), code:load_file(?MODULE), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 9fbd1a62a4..32773a779e 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -459,6 +459,27 @@ special(File,Procs) -> old_attrib=undefined, old_comp_info=undefined}=Mod2, ok; + ".trunc_mod" -> + ModName = atom_to_list(?helper_mod), + {ok,Mod=#loaded_mod{},[TW]} = + crashdump_viewer:loaded_mod_details(ModName), + "WARNING: The crash dump is truncated here."++_ = TW, + #loaded_mod{current_attrib=CA,current_comp_info=CCI, + old_attrib=OA,old_comp_info=OCI} = Mod, + case lists:all(fun(undefined) -> + true; + (S) when is_list(S) -> + io_lib:printable_unicode_list(lists:flatten(S)); + (_) -> false + end, + [CA,CCI,OA,OCI]) of + true -> + ok; + false -> + ct:fail({should_be_printable_strings_or_undefined, + {CA,CCI,OA,OCI}}) + end, + ok; ".trunc_bin1" -> %% This is 'full_dist' truncated after the first %% "=binary:" @@ -658,13 +679,32 @@ do_create_dumps(DataDir,Rel) -> CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), CD7 = dump_with_maps(DataDir,Rel,"maps"), - TruncatedDumps = truncate_dump(CD1), - {[CD1,CD2,CD3,CD4,CD5,CD6,CD7|TruncatedDumps], DosDump}; + TruncDumpMod = truncate_dump_mod(CD1), + TruncatedDumpsBinary = truncate_dump_binary(CD1), + {[CD1,CD2,CD3,CD4,CD5,CD6,CD7,TruncDumpMod|TruncatedDumpsBinary], + DosDump}; _ -> {[CD1,CD2], DosDump} end. -truncate_dump(File) -> +truncate_dump_mod(File) -> + {ok,Bin} = file:read_file(File), + ModNameBin = atom_to_binary(?helper_mod,latin1), + NewLine = case os:type() of + {win32,_} -> <<"\r\n">>; + _ -> <<"\n">> + end, + RE = <<NewLine/binary,"=mod:",ModNameBin/binary, + NewLine/binary,"Current size: [0-9]*", + NewLine/binary,"Current attributes: ...">>, + {match,[{Pos,Len}]} = re:run(Bin,RE), + Size = Pos + Len, + <<Truncated:Size/binary,_/binary>> = Bin, + DumpName = filename:rootname(File) ++ ".trunc_mod", + file:write_file(DumpName,Truncated), + DumpName. + +truncate_dump_binary(File) -> {ok,Bin} = file:read_file(File), BinTag = <<"\n=binary:">>, Colon = <<":">>, diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 92109c9a74..119d7cc3d4 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -75,43 +75,37 @@ load_report(file, File) -> load_report(data, from_file(File)); load_report(data, Report) -> ok = start_internal(), gen_server:call(?SERVER, {load_report, Report}, infinity). -report() -> [ - {init_arguments, init:get_arguments()}, - {code_paths, code:get_path()}, - {code, code()}, - {system_info, erlang_system_info()}, - {erts_compile_info, erlang:system_info(compile_info)}, - {beam_dynamic_libraries, get_dynamic_libraries()}, - {environment_erts, os_getenv_erts_specific()}, - {environment, [split_env(Env) || Env <- os:getenv()]}, - {sanity_check, sanity_check()} - ]. +report() -> + %% This is ugly but beats having to maintain two distinct implementations, + %% and we don't really care about memory use since it's internal and + %% undocumented. + {ok, Fd} = file:open([], [ram, read, write]), + to_fd(Fd), + {ok, _} = file:position(Fd, bof), + from_fd(Fd). -spec to_file(FileName) -> ok | {error, Reason} when FileName :: file:name_all(), Reason :: file:posix() | badarg | terminated | system_limit. to_file(File) -> - file:write_file(File, iolist_to_binary([ - io_lib:format("{system_information_version, ~p}.~n", [ - ?REPORT_FILE_VSN - ]), - io_lib:format("{system_information, ~p}.~n", [ - report() - ]) - ])). + case file:open(File, [raw, write, binary, delayed_write]) of + {ok, Fd} -> + try + to_fd(Fd) + after + file:close(Fd) + end; + {error, Reason} -> + {error, Reason} + end. from_file(File) -> - case file:consult(File) of - {ok, Data} -> - case get_value([system_information_version], Data) of - ?REPORT_FILE_VSN -> - get_value([system_information], Data); - Vsn -> - erlang:error({unknown_version, Vsn}) - end; - _ -> - erlang:error(bad_report_file) + {ok, Fd} = file:open(File, [raw, read]), + try + from_fd(Fd) + after + file:close(Fd) end. applications() -> applications([]). @@ -457,61 +451,151 @@ split_env([$=|Vs], Key) -> {lists:reverse(Key), Vs}; split_env([I|Vs], Key) -> split_env(Vs, [I|Key]); split_env([], KV) -> lists:reverse(KV). % should not happen. -%% get applications +from_fd(Fd) -> + try + [{system_information_version, "1.0"}, + {system_information, Data}] = consult_fd(Fd), + Data + catch + _:_ -> erlang:error(bad_report_file) + end. -code() -> - % order is important - get_code_from_paths(code:get_path()). +consult_fd(Fd) -> + consult_fd_1(Fd, [], {ok, []}). +consult_fd_1(Fd, Cont0, ReadResult) -> + Data = + case ReadResult of + {ok, Characters} -> Characters; + eof -> eof + end, + case erl_scan:tokens(Cont0, Data, 1) of + {done, {ok, Tokens, _}, Next} -> + {ok, Term} = erl_parse:parse_term(Tokens), + [Term | consult_fd_1(Fd, [], {ok, Next})]; + {more, Cont} -> + consult_fd_1(Fd, Cont, file:read(Fd, 1 bsl 20)); + {done, {eof, _}, eof} -> [] + end. -get_code_from_paths([]) -> []; -get_code_from_paths([Path|Paths]) -> - case is_application_path(Path) of - true -> - [{application, get_application_from_path(Path)}|get_code_from_paths(Paths)]; - false -> - [{code, [ - {path, Path}, - {modules, get_modules_from_path(Path)} - ]}|get_code_from_paths(Paths)] +%% +%% Dumps a system_information tuple to the given Fd, writing the term in chunks +%% to avoid eating too much memory on large systems. +%% + +to_fd(Fd) -> + EmitChunk = + fun(Format, Args) -> + ok = file:write(Fd, io_lib:format(Format, Args)) + end, + + EmitChunk("{system_information_version, ~p}.~n" + "{system_information,[" + "{init_arguments,~p}," + "{code_paths,~p},", + [?REPORT_FILE_VSN, + init:get_arguments(), + code:get_path()]), + + 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}" + "]}.~n", + [erlang_system_info(), + erlang:system_info(compile_info), + get_dynamic_libraries(), + os_getenv_erts_specific(), + [split_env(Env) || Env <- os:getenv()], + sanity_check()]). + +%% Emits all modules/applications in the *code path order* +emit_code_info(EmitChunk) -> + EmitChunk("{code, [", []), + comma_separated_foreach(EmitChunk, + fun(Path) -> + case is_application_path(Path) of + true -> emit_application_info(EmitChunk, Path); + false -> emit_code_path_info(EmitChunk, Path) + end + end, code:get_path()), + EmitChunk("]}", []). + +emit_application_info(EmitChunk, Path) -> + [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), + case file:consult(Appfile) of + {ok, [{application, App, Info}]} -> + RtDeps = proplists:get_value(runtime_dependencies, Info, []), + Description = proplists:get_value(description, Info, []), + Version = proplists:get_value(vsn, Info, []), + + EmitChunk("{application, {~p,[" + "{description,~p}," + "{vsn,~p}," + "{path,~p}," + "{runtime_dependencies,~p},", + [App, Description, Version, Path, RtDeps]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}}", []) end. +emit_code_path_info(EmitChunk, Path) -> + EmitChunk("{code, [" + "{path, ~p},", [Path]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}", []). + +emit_module_info_from_path(EmitChunk, Path) -> + BeamFiles = filelib:wildcard(filename:join(Path, "*.beam")), + + EmitChunk("{modules, [", []), + comma_separated_foreach(EmitChunk, + fun(Beam) -> + emit_module_info(EmitChunk, Beam) + end, BeamFiles), + EmitChunk("]}", []). + +emit_module_info(EmitChunk, Beam) -> + %% FIXME: The next three calls load *all* significant chunks onto the heap, + %% which may cause us to run out of memory if there's a huge module in the + %% code path. + {ok,{Mod, Md5}} = beam_lib:md5(Beam), + + CompilerVersion = get_compiler_version(Beam), + Native = beam_is_native_compiled(Beam), + + Loaded = case code:is_loaded(Mod) of + false -> false; + _ -> true + end, + + EmitChunk("{~p,[" + "{loaded,~p}," + "{native,~p}," + "{compiler,~p}," + "{md5,~p}" + "]}", + [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]). + +comma_separated_foreach(_EmitChunk, _Fun, []) -> + ok; +comma_separated_foreach(_EmitChunk, Fun, [H]) -> + Fun(H); +comma_separated_foreach(EmitChunk, Fun, [H | T]) -> + Fun(H), + EmitChunk(",", []), + comma_separated_foreach(EmitChunk, Fun, T). + is_application_path(Path) -> case filelib:wildcard(filename:join(Path, "*.app")) of [] -> false; _ -> true end. -get_application_from_path(Path) -> - [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), - case file:consult(Appfile) of - {ok, [{application, App, Info}]} -> - {App, [ - {description, proplists:get_value(description, Info, [])}, - {vsn, proplists:get_value(vsn, Info, [])}, - {path, Path}, - {runtime_dependencies, - proplists:get_value(runtime_dependencies, Info, [])}, - {modules, get_modules_from_path(Path)} - ]} - end. - -get_modules_from_path(Path) -> - [ - begin - {ok,{Mod, Md5}} = beam_lib:md5(Beam), - Loaded = case code:is_loaded(Mod) of - false -> false; - _ -> true - end, - {Mod, [ - {loaded, Loaded}, - {native, beam_is_native_compiled(Beam)}, - {compiler, get_compiler_version(Beam)}, - {md5, hexstring(Md5)} - ]} - end || Beam <- filelib:wildcard(filename:join(Path, "*.beam")) - ]. - hexstring(Bin) when is_binary(Bin) -> lists:flatten([io_lib:format("~2.16.0b", [V]) || <<V>> <= Bin]). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 154894cda8..ad9efc4755 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -54,7 +54,7 @@ sha/1, sign/3, verify/5]). %%% For test suites --export([pack/3]). +-export([pack/3, adjust_algs_for_peer_version/2]). -export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove -define(Estring(X), ?STRING((if is_binary(X) -> X; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index a18383d148..21359a0386 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -37,6 +37,7 @@ MODULES= \ ssh_renegotiate_SUITE \ ssh_basic_SUITE \ ssh_bench_SUITE \ + ssh_compat_SUITE \ ssh_connection_SUITE \ ssh_engine_SUITE \ ssh_protocol_SUITE \ diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl new file mode 100644 index 0000000000..74ab5aca3a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -0,0 +1,814 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_compat_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). % #ssh_msg_kexinit{} +-include_lib("kernel/include/inet.hrl"). % #hostent{} +-include_lib("kernel/include/file.hrl"). % #file_info{} +-include("ssh_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(USER,"sshtester"). +-define(PWD, "foobar"). +-define(DOCKER_PFX, "ssh_compat_suite-ssh"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [%%{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,40}}]. + +all() -> + [{group,G} || G <- vers()]. + +groups() -> + [{G, [], tests()} || G <- vers()]. + +tests() -> + [login_with_password_otp_is_client, + login_with_password_otp_is_server, + login_with_keyboard_interactive_otp_is_client, + login_with_keyboard_interactive_otp_is_server, + login_with_all_public_keys_otp_is_client, + login_with_all_public_keys_otp_is_server, + all_algorithms_otp_is_client, + all_algorithms_otp_is_server + ]. + + + +vers() -> + try + %% Find all useful containers in such a way that undefined command, too low + %% priviliges, no containers and containers found give meaningful result: + L0 = ["REPOSITORY"++_|_] = string:tokens(os:cmd("docker images"), "\r\n"), + [["REPOSITORY","TAG"|_]|L1] = [string:tokens(E, " ") || E<-L0], + [list_to_atom(V) || [?DOCKER_PFX,V|_] <- L1] + of + Vs -> + lists:sort(Vs) + catch + error:{badmatch,_} -> + [] + end. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ?CHECK_CRYPTO( + case os:find_executable("docker") of + false -> + {skip, "No docker"}; + _ -> + ssh:start(), + ct:log("Crypto info: ~p",[crypto:info_lib()]), + Config + end). + +end_per_suite(Config) -> + %% Remove all containers that are not running: +%%% os:cmd("docker rm $(docker ps -aq -f status=exited)"), + %% Remove dangling images: +%%% os:cmd("docker rmi $(docker images -f dangling=true -q)"), + Config. + + + +init_per_group(G, Config) -> + case lists:member(G, vers()) of + true -> + try start_docker(G) of + {ok,ID} -> + ct:log("==> ~p",[G]), + [Vssh|VsslRest] = string:tokens(atom_to_list(G), "-"), + Vssl = lists:flatten(lists:join($-,VsslRest)), + ct:comment("+++ ~s + ~s +++",[Vssh,Vssl]), + %% Find the algorithms that both client and server supports: + {IP,Port} = ip_port([{id,ID}]), + try common_algs([{id,ID}|Config], IP, Port) of + {ok, RemoteServerCommon, RemoteClientCommon} -> + [{ssh_version,Vssh},{ssl_version,Vssl}, + {id,ID}, + {common_server_algs,RemoteServerCommon}, + {common_client_algs,RemoteClientCommon} + |Config]; + Other -> + ct:log("Error in init_per_group: ~p",[Other]), + stop_docker(ID), + {fail, "Can't contact docker sshd"} + catch + Class:Exc -> + ST = erlang:get_stacktrace(), + ct:log("common_algs: ~p:~p~n~p",[Class,Exc,ST]), + stop_docker(ID), + {fail, "Failed during setup"} + end + catch + cant_start_docker -> + {skip, "Can't start docker"}; + + C:E -> + ST = erlang:get_stacktrace(), + ct:log("No ~p~n~p:~p~n~p",[G,C,E,ST]), + {skip, "Can't start docker"} + end; + + false -> + Config + end. + +end_per_group(_, Config) -> + catch stop_docker(proplists:get_value(id,Config)), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +login_with_password_otp_is_client(Config) -> + {IP,Port} = ip_port(Config), + {ok,C} = ssh:connect(IP, Port, [{auth_methods,"password"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_password_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"password"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+2]).\r\n'", + [<<"Answer=3">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_client(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{auth_methods,"keyboard-interactive"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"keyboard-interactive"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+3]).\r\n'", + [<<"Answer=4">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_client(Config) -> + CommonAlgs = [{public_key_from_host,A} + || {public_key,A} <- proplists:get_value(common_server_algs, Config)], + {DockerIP,DockerPort} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + ssh:connect(DockerIP, DockerPort, + [{auth_methods, "publickey"}, + {user, ?USER}, + {user_dir, setup_remote_auth_keys_and_local_priv(Alg, Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_server(Config) -> + CommonAlgs = [{public_key_to_host,A} + || {public_key,A} <- proplists:get_value(common_client_algs, Config)], + UserDir = new_dir(Config), + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods, "publickey"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + + R = chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + setup_remote_priv_and_local_auth_keys(Alg, clear_dir(UserDir), Config), + exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+4]).\r\n'", + [<<"Answer=5">>], + "") + end), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_client(Config) -> + CommonAlgs = proplists:get_value(common_server_algs, Config), + {IP,Port} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag, Alg) -> + ssh:connect(IP, Port, [{user,?USER}, + {password,?PWD}, + {auth_methods, "password"}, + {user_dir, new_dir(Config)}, + {preferred_algorithms, [{Tag,[Alg]}]}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_server(Config) -> + CommonAlgs = proplists:get_value(common_client_algs, Config), + UserDir = setup_remote_priv_and_local_auth_keys('ssh-rsa', Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag,Alg) -> + HostKeyAlg = case Tag of + public_key -> Alg; + _ -> 'ssh-rsa' + end, + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{preferred_algorithms, [{Tag,[Alg]}]}, + {system_dir, setup_local_hostdir(HostKeyAlg, Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "hi_there.\r\n", + [<<"hi_there">>], + ""), + ssh:stop_daemon(Server), + R + end). + +%%-------------------------------------------------------------------- +%% Utilities --------------------------------------------------------- +%%-------------------------------------------------------------------- +exec_from_docker(WhatEver, {0,0,0,0}, HostPort, Command, Expects, ExtraSshArg) -> + exec_from_docker(WhatEver, host_ip(), HostPort, Command, Expects, ExtraSshArg); + +exec_from_docker(Config, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)), + is_list(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + R = exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg), + ssh:close(C), + R; + +exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)) -> + SSH_from_docker = + lists:concat(["sshpass -p ",?PWD," ", + "/buildroot/ssh/bin/ssh -p ",HostPort," -o 'CheckHostIP=no' -o 'StrictHostKeyChecking=no' ", + ExtraSshArg," ", + inet_parse:ntoa(HostIP)," " + ]), + ExecCommand = SSH_from_docker ++ Command, + R = exec(C, ExecCommand), + case R of + {ok,{ExitStatus,Result}} when ExitStatus == 0 -> + case binary:match(Result, Expects) of + nomatch -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Bad answer"}; + _ -> + ok + end; + {ok,_} -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Exit status =/= 0"}; + _ -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Couldn't login to host"} + end. + + + + +exec(C, Cmd) -> + ct:log("~s",[Cmd]), + {ok,Ch} = ssh_connection:session_channel(C, 10000), + success = ssh_connection:exec(C, Ch, Cmd, 10000), + exec_result(C, Ch). + + +exec_result(C, Ch) -> + exec_result(C, Ch, undefined, <<>>). + +exec_result(C, Ch, ExitStatus, Acc) -> + receive + {ssh_cm,C,{closed,Ch}} -> + %%ct:log("CHAN ~p got *closed*",[Ch]), + {ok, {ExitStatus, Acc}}; + + {ssh_cm,C,{exit_status,Ch,ExStat}} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got *exit status ~p*",[Ch,ExStat]), + exec_result(C, Ch, ExStat, Acc); + + {ssh_cm,C,{data,Ch,_,Data}=_X} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got ~p",[Ch,_X]), + exec_result(C, Ch, ExitStatus, <<Acc/binary, Data/binary>>); + + _Other -> + %%ct:log("OTHER: ~p",[_Other]), + exec_result(C, Ch, ExitStatus, Acc) + + after 5000 -> + %%ct:log("NO MORE, received so far:~n~s",[Acc]), + {error, timeout} + end. + + +chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> + ct:comment("~p algorithms",[length(CommonAlgs)]), + %% Check each algorithm + Failed = + lists:foldl( + fun({Tag,Alg}, FailedAlgos) -> + ct:log("Try ~p",[Alg]), + case DoTestFun(Tag,Alg) of + {ok,C} -> + ssh:close(C), + FailedAlgos; + ok -> + FailedAlgos; + Other -> + ct:log("FAILED! ~p ~p: ~p",[Tag,Alg,Other]), + [Alg|FailedAlgos] + end + end, [], CommonAlgs), + ct:pal("~s", [format_result_table_use_all_algos(Config, CommonAlgs, Failed)]), + case Failed of + [] -> + ok; + _ -> + {fail, Failed} + end. + +setup_local_hostdir(KeyAlg, Config) -> + setup_local_hostdir(KeyAlg, new_dir(Config), Config). +setup_local_hostdir(KeyAlg, HostDir, Config) -> + {ok, {Priv,Publ}} = host_priv_pub_keys(Config, KeyAlg), + %% Local private and public key + DstFile = filename:join(HostDir, dst_filename(host,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + HostDir. + + +setup_remote_auth_keys_and_local_priv(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, Config) -> + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local private and public keys + DstFile = filename:join(UserDir, dst_filename(user,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + %% Remote auth_methods with public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + ok = ssh_sftp:write_file(Ch, ".ssh/authorized_keys", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh/authorized_keys", #file_info{mode=8#700}), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + + +setup_remote_priv_and_local_auth_keys(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, Config) -> + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local auth_methods with public key + AuthKeyFile = filename:join(UserDir, "authorized_keys"), + ok = file:write_file(AuthKeyFile, Publ), + %% Remote private and public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + DstFile = filename:join(".ssh", dst_filename(user,KeyAlg)), + ok = ssh_sftp:write_file(Ch, DstFile, Priv), + ok = ssh_sftp:write_file_info(Ch, DstFile, #file_info{mode=8#700}), + ok = ssh_sftp:write_file(Ch, DstFile++".pub", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + +user_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("users_keys", user, Config, KeyAlg). +host_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("host_keys", host, Config, KeyAlg). + +priv_pub_keys(KeySubDir, Type, Config, KeyAlg) -> + KeyDir = filename:join(proplists:get_value(data_dir,Config), KeySubDir), + {ok,Priv} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg))), + {ok,Publ} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg)++".pub")), + {ok, {Priv,Publ}}. + + +src_filename(user, 'ssh-rsa' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +src_filename(user, 'ssh-dss' ) -> "id_dsa"; +src_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa256"; +src_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa384"; +src_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa521"; +src_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +src_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +src_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key256"; +src_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key384"; +src_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521". + +dst_filename(user, 'ssh-rsa' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +dst_filename(user, 'ssh-dss' ) -> "id_dsa"; +dst_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; +dst_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key". + + +format_result_table_use_all_algos(Config, CommonAlgs, Failed) -> + %% Write a nice table with the result + AlgHead = 'Algorithm', + AlgWidth = lists:max([length(atom_to_list(A)) || {_,A} <- CommonAlgs]), + {ResultTable,_} = + lists:mapfoldl( + fun({T,A}, Tprev) -> + Tag = case T of + Tprev -> ""; + _ -> io_lib:format('~s~n',[T]) + end, + {io_lib:format('~s ~*s ~s~n', + [Tag, -AlgWidth, A, + case lists:member(A,Failed) of + true -> "<<<< FAIL <<<<"; + false-> "(ok)" + end]), + T} + end, undefined, CommonAlgs), + + Vssh = proplists:get_value(ssh_version,Config,""), + Vssl = proplists:get_value(ssl_version,Config,""), + io_lib:format("~nResults, Peer versions: ~s and ~s~n" + "Tag ~*s Result~n" + "=====~*..=s=======~n~s" + ,[Vssh,Vssl, + -AlgWidth,AlgHead, + AlgWidth, "", ResultTable]). + + +start_docker(Ver) -> + Cmnd = lists:concat(["docker run -itd --rm -p 1234 ",?DOCKER_PFX,":",Ver]), + Id0 = os:cmd(Cmnd), + ct:log("Ver = ~p, Cmnd ~p~n-> ~p",[Ver,Cmnd,Id0]), + case is_docker_sha(Id0) of + true -> + Id = hd(string:tokens(Id0, "\n")), + IP = ip(Id), + Port = 1234, + {ok, {Ver,{IP,Port},Id}}; + false -> + throw(cant_start_docker) + end. + + +stop_docker({_Ver,_,Id}) -> + Cmnd = lists:concat(["docker kill ",Id]), + os:cmd(Cmnd). + +is_docker_sha(L) -> + lists:all(fun(C) when $a =< C,C =< $z -> true; + (C) when $0 =< C,C =< $9 -> true; + ($\n) -> true; + (_) -> false + end, L). + +ip_port(Config) -> + {_Ver,{IP,Port},_} = proplists:get_value(id,Config), + {IP,Port}. + +port_mapped_to(Id) -> + Cmnd = lists:concat(["docker ps --format \"{{.Ports}}\" --filter id=",Id]), + [_, PortStr | _] = string:tokens(os:cmd(Cmnd), ":->/"), + list_to_integer(PortStr). + +ip(Id) -> + Cmnd = lists:concat(["docker inspect --format='{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}' ", + Id]), + IPstr0 = os:cmd(Cmnd), + ct:log("Cmnd ~p~n-> ~p",[Cmnd,IPstr0]), + IPstr = hd(string:tokens(IPstr0, "\n")), + {ok,IP} = inet:parse_address(IPstr), + IP. + +new_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SubDirName = integer_to_list(erlang:system_time()), + Dir = filename:join(PrivDir, SubDirName), + case file:read_file_info(Dir) of + {error,enoent} -> + ok = file:make_dir(Dir), + Dir; + _ -> + timer:sleep(25), + new_dir(Config) + end. + +clear_dir(Dir) -> + delete_all_contents(Dir), + {ok,[]} = file:list_dir(Dir), + Dir. + +delete_all_contents(Dir) -> + {ok,Fs} = file:list_dir(Dir), + lists:map(fun(F0) -> + F = filename:join(Dir, F0), + case filelib:is_file(F) of + true -> + file:delete(F); + false -> + case filelib:is_dir(F) of + true -> + delete_all_contents(F), + file:del_dir(F); + false -> + ct:log("Neither file nor dir: ~p",[F]) + end + end + end, Fs). + +common_algs(Config, IP, Port) -> + case remote_server_algs(IP, Port) of + {ok, {RemoteHelloBin, RemoteServerKexInit}} -> + case remote_client_algs(Config) of + {ok,{_Hello,RemoteClientKexInit}} -> + RemoteServerAlgs = kexint_msg2default_algorithms(RemoteServerKexInit), + Server = find_common_algs(RemoteServerAlgs, + use_algorithms(RemoteHelloBin)), + RemoteClientAlgs = kexint_msg2default_algorithms(RemoteClientKexInit), + Client = find_common_algs(RemoteClientAlgs, + use_algorithms(RemoteHelloBin)), + ct:log("Docker server algorithms:~n ~p~n~nDocker client algorithms:~n ~p", + [RemoteServerAlgs,RemoteClientAlgs]), + {ok, Server, Client}; + Other -> + Other + end; + Other -> + Other + end. + + +find_common_algs(Remote, Local) -> + [{T,V} || {T,Vs} <- ssh_test_lib:extract_algos( + ssh_test_lib:intersection(Remote, + Local)), + V <- Vs]. + + +use_algorithms(RemoteHelloBin) -> + MyAlgos = ssh:chk_algos_opts( + [{modify_algorithms, + [{append, + [{kex,['diffie-hellman-group1-sha1']} + ]} + ]} + ]), + ssh_transport:adjust_algs_for_peer_version(binary_to_list(RemoteHelloBin)++"\r\n", + MyAlgos). + +kexint_msg2default_algorithms(#ssh_msg_kexinit{kex_algorithms = Kex, + server_host_key_algorithms = PubKey, + encryption_algorithms_client_to_server = CipherC2S, + encryption_algorithms_server_to_client = CipherS2C, + mac_algorithms_client_to_server = MacC2S, + mac_algorithms_server_to_client = MacS2C, + compression_algorithms_client_to_server = CompC2S, + compression_algorithms_server_to_client = CompS2C + }) -> + [{kex, ssh_test_lib:to_atoms(Kex)}, + {public_key, ssh_test_lib:to_atoms(PubKey)}, + {cipher, [{client2server,ssh_test_lib:to_atoms(CipherC2S)}, + {server2client,ssh_test_lib:to_atoms(CipherS2C)}]}, + {mac, [{client2server,ssh_test_lib:to_atoms(MacC2S)}, + {server2client,ssh_test_lib:to_atoms(MacS2C)}]}, + {compression, [{client2server,ssh_test_lib:to_atoms(CompC2S)}, + {server2client,ssh_test_lib:to_atoms(CompS2C)}]}]. + + + +remote_server_algs(IP, Port) -> + case try_gen_tcp_connect(IP, Port, 5) of + {ok,S} -> + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + receive_hello(S, <<>>); + {error,Error} -> + {error,Error} + end. + +try_gen_tcp_connect(IP, Port, N) when N>0 -> + case gen_tcp:connect(IP, Port, [binary]) of + {ok,S} -> + {ok,S}; + {error,_Error} when N>1 -> + receive after 1000 -> ok end, + try_gen_tcp_connect(IP, Port, N-1); + {error,Error} -> + {error,Error} + end; +try_gen_tcp_connect(_, _, _) -> + {error, "No contact"}. + + +remote_client_algs(Config) -> + Parent = self(), + Ref = make_ref(), + spawn( + fun() -> + {ok,Sl} = gen_tcp:listen(0, [binary]), + {ok,{IP,Port}} = inet:sockname(Sl), + Parent ! {addr,Ref,IP,Port}, + {ok,S} = gen_tcp:accept(Sl), + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + Parent ! {Ref,receive_hello(S, <<>>)} + end), + receive + {addr,Ref,IP,Port} -> + spawn(fun() -> + exec_from_docker(Config, IP, Port, + "howdy.\r\n", + [<<"howdy">>], + "") + end), + receive + {Ref, Result} -> + Result + after 15000 -> + {error, timeout2} + end + after 15000 -> + {error, timeout1} + end. + + + +receive_hello(S, Ack) -> + %% The Ack is to collect bytes until the full message is received + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + case binary:split(<<Ack/binary, Bin0/binary>>, [<<"\r\n">>,<<"\r">>,<<"\n">>]) of + [Hello = <<"SSH-2.0-",_/binary>>, NextPacket] -> + ct:log("Got 2.0 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Hello = <<"SSH-1.99-",_/binary>>, NextPacket] -> + ct:comment("Old SSH ~s",["1.99"]), + ct:log("Got 1.99 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Bin] when size(Bin) < 256 -> + ct:log("Got part of hello (~p chars):~n~s~n~s",[size(Bin),Bin, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + receive_hello(S, Bin0); + + _ -> + ct:log("Bad hello string (line ~p, ~p chars):~n~s~n~s",[?LINE,size(Bin0),Bin0, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + ct:fail("Bad hello string received") + end; + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for hello!~n~s",[Ack]), + throw(timeout) + end. + + +receive_kexinit(_S, <<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) + when PacketLen < 5000, % heuristic max len to stop huge attempts if packet decodeing get out of sync + size(PayloadAndPadding) >= (PacketLen-1) % Need more bytes? + -> + ct:log("Has all ~p packet bytes",[PacketLen]), + PayloadLen = PacketLen - PaddingLen - 1, + <<Payload:PayloadLen/binary, _Padding:PaddingLen/binary>> = PayloadAndPadding, + ssh_message:decode(Payload); + +receive_kexinit(S, Ack) -> + ct:log("Has ~p bytes, need more",[size(Ack)]), + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + receive_kexinit(S, <<Ack/binary, Bin0/binary>>); + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for kexinit!~n~s",[Ack]), + throw(timeout) + end. + + + +host_ip() -> + {ok,Name} = inet:gethostname(), + {ok,#hostent{h_addr_list = [IP|_]}} = inet_res:gethostbyname(Name), + IP. + + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image new file mode 100755 index 0000000000..1cb7bf33e1 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image @@ -0,0 +1,38 @@ +#!/bin/sh + +UBUNTU_VER=${1:-16.04} + +USER=sshtester +PWD=foobar + +docker build \ + -t ubuntubuildbase \ + --build-arg https_proxy=$HTTPS_PROXY \ + --build-arg http_proxy=$HTTP_PROXY \ + - <<EOF + + FROM ubuntu:$UBUNTU_VER + WORKDIR /buildroot + + # Prepare for installing OpenSSH + RUN apt-get update + RUN apt-get upgrade -y + RUN apt-get -y install apt-utils + RUN apt-get -y install build-essential zlib1g-dev + RUN apt-get -y install sudo iputils-ping tcptraceroute net-tools + RUN apt-get -y install sshpass expect + RUN apt-get -y install libpam0g-dev + + # A user for the tests + RUN (echo $PWD; echo $PWD; echo; echo; echo; echo; echo; echo ) | adduser $USER + RUN adduser $USER sudo + + # Prepare the privsep preauth environment for openssh + RUN mkdir -p /var/empty + RUN chown root:sys /var/empty + RUN chmod 755 /var/empty + RUN groupadd -f sshd + RUN ls /bin/false + RUN id -u sshd 2> /dev/null || useradd -g sshd -c 'sshd privsep' -d /var/empty -s /bin/false sshd + +EOF diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image new file mode 100755 index 0000000000..983c57b18b --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image @@ -0,0 +1,71 @@ +#!/bin/sh + +# ./create-image openssh 7.3p1 openssl 1.0.2m + +set -x + +case $1 in + openssh) + FAMssh=openssh + VERssh=$2 + PFX=https://ftp.eu.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo "Unsupported: $1" + exit +esac + +FAMssl=$3 +VERssl=$4 + +VER=${FAMssh}${VERssh}-${FAMssl}${VERssl} + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ssh_compat_suite-${FAMssl}:${VERssl} + + LABEL openssh-version=${VER} + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + # Build and install + + WORKDIR ${FAMssh}-${VERssh} + + # Probably VERY OpenSSH dependent...: + RUN ./configure --without-pie \ + --prefix=/buildroot/ssh \ + --with-ssl-dir=/buildroot/ssl \ + --with-pam + RUN make + RUN make install + RUN echo UsePAM yes >> /buildroot/ssh/etc/sshd_config + + RUN echo Built ${VER} + + # Start the daemon, but keep it in foreground to avoid killing the container + CMD /buildroot/ssh/sbin/sshd -D -p 1234 + +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VERssh$SFX + +# Build the image: +docker build -t ssh_compat_suite-ssh:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image new file mode 100755 index 0000000000..66f8358b8a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image @@ -0,0 +1,61 @@ +#!/bin/sh + +# ./create-image openssl 1.0.2m + +case "$1" in + "openssl") + FAM=openssl + VER=$2 + PFX=https://www.openssl.org/source/openssl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + "libressl") + FAM=libressl + VER=$2 + PFX=https://ftp.openbsd.org/pub/OpenBSD/LibreSSL/libressl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo No lib type + exit + ;; +esac + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ubuntubuildbase + + LABEL version=$FAM-$VER + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + WORKDIR ${FAM}-${VER} + + RUN ./config --prefix=/buildroot/ssl + + RUN make + RUN make install + + RUN echo Built ${FAM}-${VER} +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VER$SFX + +# Build the image: +docker build -t ssh_compat_suite-$FAM:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all new file mode 100755 index 0000000000..16b9c21d9f --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all @@ -0,0 +1,87 @@ +#!/bin/bash + +UBUNTU_VERSION=16.04 + +SSH_SSL_VERSIONS=(\ + openssh 4.4p1 openssl 0.9.8zh \ + openssh 4.5p1 openssl 0.9.8zh \ + openssh 5.0p1 openssl 0.9.8zh \ + openssh 6.2p2 openssl 0.9.8zh \ + openssh 6.3p1 openssl 0.9.8zh \ + \ + openssh 7.1p1 openssl 1.0.0t \ + \ + openssh 7.1p1 openssl 1.0.1p \ + \ + openssh 6.6p1 openssl 1.0.2n \ + openssh 7.1p1 openssl 1.0.2n \ + openssh 7.6p1 openssl 1.0.2n \ + ) + +if [ "x$1" == "x-b" ] +then + shift + SKIP_CREATE_BASE=true +fi + +WHAT_TO_DO=$1 + +function create_one_image () +{ + SSH_FAM=$1 + SSH_VER=$2 + SSL_FAM=$3 + SSL_VER=$4 + + [ "x$SKIP_CREATE_BASE" == "xtrue" ] || ./create-base-image || (echo "Create base failed." >&2; exit 1) + ./create-ssl-image $SSL_FAM $SSL_VER \ + || (echo "Create $SSL_FAM $SSL_VER failed." >&2; exit 2) + + ./create-ssh-image $SSH_FAM $SSH_VER $SSL_FAM $SSL_VER \ + || (echo "Create $SSH_FAM $SSH_VER on $SSL_FAM $SSL_VER failed." >&2; exit 3) +} + + +case ${WHAT_TO_DO} in + list) + ;; + listatoms) + PRE="[" + POST="]" + C=\' + COMMA=, + ;; + build_one) + if [ $# != 5 ] + then + echo "$0 build_one openssh SSH_ver openssl SSL_ver " && exit + else + create_one_image $2 $3 $4 $5 + exit + fi + ;; + build_all) + ;; + *) + echo "$0 [-b] list | listatoms | build_one openssh SSH_ver openssl SSL_ver | build_all" && exit + ;; +esac + + +echo -n $PRE +i=0 +while [ "x${SSH_SSL_VERSIONS[i]}" != "x" ] +do + case ${WHAT_TO_DO} in + list*) + [ $i -eq 0 ] || echo $COMMA + echo -n $C${SSH_SSL_VERSIONS[$i]}${SSH_SSL_VERSIONS[$(( $i + 1 ))]}-${SSH_SSL_VERSIONS[$(( $i + 2 ))]}${SSH_SSL_VERSIONS[$(( $i + 3 ))]}$C + ;; + build_all) + create_one_image ${SSH_SSL_VERSIONS[$i]} ${SSH_SSL_VERSIONS[$(( $i + 1 ))]} ${SSH_SSL_VERSIONS[$(( $i + 2 ))]} ${SSH_SSL_VERSIONS[$(( $i + 3 ))]} + ;; + esac + + i=$(( $i + 4 )) +done +echo $POST diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key new file mode 100644 index 0000000000..8b2354a7ea --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBugIBAAKBgQDlXDEddxFbTtPsu2bRTbSONFVKMxe430iqBoXoKK2Gyhlqn7J8 +SRGlmvTN7T06+9iFqgJi+x+dlSJGlNEY/v67Z8C7rWfJynYuRier4TujLwP452RT +YrsnCq47pGJXHb9xAWr7UGMv85uDrECUiIdK4xIrwpW/gMb5zPSThDGNiwIVANts +B9nBX0NH/B0lXthVCg2jRSkpAoGAIS3vG8VmjQNYrGfdcdvQtGubFXs4jZJO6iDe +9u9/O95dcnH4ZIL4y3ZPHbw73dCKXFe5NlqI/POmn3MyFdpyqH5FTHWB/aAFrma6 +qo00F1mv83DkQCEfg6fwE/SaaBjDecr5I14hWOtocpYqlY1/x1aspahwK6NLPp/D +A4aAt78CgYAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7Xmyq +blfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZ +iEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpgIURgW8SZGj +X0mMkMJv/Ltdt0gYx60= +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..9116493472 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAOVcMR13EVtO0+y7ZtFNtI40VUozF7jfSKoGhegorYbKGWqfsnxJEaWa9M3tPTr72IWqAmL7H52VIkaU0Rj+/rtnwLutZ8nKdi5GJ6vhO6MvA/jnZFNiuycKrjukYlcdv3EBavtQYy/zm4OsQJSIh0rjEivClb+AxvnM9JOEMY2LAAAAFQDbbAfZwV9DR/wdJV7YVQoNo0UpKQAAAIAhLe8bxWaNA1isZ91x29C0a5sVeziNkk7qIN7273873l1ycfhkgvjLdk8dvDvd0IpcV7k2Woj886afczIV2nKofkVMdYH9oAWuZrqqjTQXWa/zcORAIR+Dp/AT9JpoGMN5yvkjXiFY62hyliqVjX/HVqylqHAro0s+n8MDhoC3vwAAAIAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7XmyqblfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZiEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..5ed2b361cc --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEILwQIf+Jul+oygeJn7cBSvn2LGqnW1ZfiHDQMDXZ96mooAoGCCqGSM49 +AwEHoUQDQgAEJUo0gCIhXEPJYvxec23IAjq7BjV1xw8deI8JV9vL5BMCZNhyj5Vt +NbFPbKPuL/Sikn8p4YP/5y336ug7szvYrg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..240387d901 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBCVKNIAiIVxDyWL8XnNtyAI6uwY1dccPHXiPCVfby+QTAmTYco+VbTWxT2yj7i/0opJ/KeGD/+ct9+roO7M72K4= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..9d31d75cd5 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBw+P1sic2i41wTGQgjyUlBtxQfnY77L8TFcDngoRiVrbCugnDrioNo +JogqymWhSC+gBwYFK4EEACKhZANiAATwaqEp3vyLzfb08kqgIZLv/mAYJyGD+JMt +f11OswGs3uFkbHZOErFCgeLuBvarSTAFkOlMR9GZGaDEfcrPBTtvKj+jEaAvh6yr +JxS97rtwk2uadDMem2x4w9Ga4jw4S8E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..cca85bda72 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBPBqoSne/IvN9vTySqAhku/+YBgnIYP4ky1/XU6zAaze4WRsdk4SsUKB4u4G9qtJMAWQ6UxH0ZkZoMR9ys8FO28qP6MRoC+HrKsnFL3uu3CTa5p0Mx6bbHjD0ZriPDhLwQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..b698be1ec9 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIBtGVvyn7kGX7BfWAYHK2ZXmhWscTOV0J0mAfab0u0ZMw0id2a3O9s +sBjJoCqoAXTJ7d/OUw85qqQNDE5GDQpDFq6gBwYFK4EEACOhgYkDgYYABAHPWfUD +tQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJ +yO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuh +RPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..d181d30d69 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHPWfUDtQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJyO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuhRPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key new file mode 100644 index 0000000000..84096298ca --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAuC6uxC0P8voYQCrwJzczo9iSiwsovPv4etd2BLnu8cKWdnjR +34tWvtguw2kO+iDyt4hFGGfDBQf2SXl+ZEsE2N1RlSp5A73me2byw/L4MreX2rbU +TwyNXF3TBvKb3Gbpx7PoiB9frcb9RCMxtypBvGQD6bx6h5UWKuSkYzARaRLv3kbB +swcqfrA3PfWybkIoaa2RO1Ca86u6K0v+a4r0OfRxTnghuakZkH6CD7+uU3irliPI +UFt2wTI/qWmnDrMFh4RffToHK0QZHXdkq4ama5kRZdZ0svSorxqkl8EWGPhReoUj +Yrz0bCNevSlDxHCxLi8epRxuv+AhZHW0YdMCCwIDAQABAoIBAHUyj1aZbfqolWHP +cL0jbSKnHqiHU0bd9sED9T8QqTEBJwj/3Fwop+wMV8VURol3CbsrZPwgmoHLDTa3 +rmtXKSBtxAns2tA8uDpxyaxSIQj0thYgHHyoehL6SNu06OSYP84pdp+XhyRm6KXA +11O7+dRMuAi1PCql/VMR5mCPJ6T5qWAVYHFyEBvMm4q5yYSRSPaAaZHC6WbEsxHN +jGzcyl3tvmOyN0+M7v0U86lQ+H2tSXH+nQg/Ig6hWgFGg8AYoos/9yUGOY+e9bUE +serYdsuiyxBfo4CgoSeDsjwNp1lAZ5UOrIDdRqK9C8jGVkHDzwfmmtczWXkVVzGZ +Bd05izECgYEA31yHzSA/umamyZAQbi/5psk1Fc5m6MzsgmJmB6jm7hUZ0EbpSV4C +6b1nOrk/IAtA12rvDHgWy0zpkJbC5b03C77RnBgTRgLQyolrcpLDJ47+Kxf/AHGk +m63KaCpwZEQ4f9ARBXySD/jNoW9gz5S6Xa3RnHOC70DsIIk5VOCjWk0CgYEA0xiM +Ay27PJcbAG/4tnjH8DZfHb8SULfnfUj8kMe3V2SDPDWbhY8zheo45wTBDRflFU5I +XyGmfuZ7PTTnFVrJz8ua3mAMOzkFn4MmdaRCX9XtuE4YWq3lFvxlrJvfXSjEL0km +8UwlhJMixaEPqFQjsKc9BHwWKRiKcF4zFQ1DybcCgYB46yfdhYLaj23lmqc6b6Bw +iWbCql2N1DqJj2l65hY2d5fk6C6s+EcNcOrsoJKq70yoEgzdrDlyz+11yBg0tU2S +fzgMkAAHG8kajHBts0QRK1kvzSrQe7VITjpQUAFOVpxbnTFJzhloqiHwLlKzremC +g3IBh4svqO7r4j32VDI61QKBgQCQL4gS872cWSncVp7vI/iNHtZBHy2HbNX1QVEi +Iwgb7U+mZIdh5roukhlj0l96bgPPVbUhJX7v1sX+vI/KikSmZk/V7IzuNrich5xR +ZmzfwOOqq8z+wyBjXuqjx6P9oca+9Zxf3L8Tmtx5WNW1CCOImfKXiZopX9XPgsgp +bPIMaQKBgQCql4uTSacSQ5s6rEEdvR+y6nTohF3zxhOQ+6xivm3Hf1mgTk40lQ+t +sr6HsSTv8j/ZbhhtaUUb2efro3pDztjlxXFvITar9ZDB2B4QMlpSsDR9UNk8xKGY +J9aYLr4fJC6J6VA7Wf0yq6LpjSXRH/2GeNtmMl5rFRsHt+VU7GZK9g== +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..4ac6e7b124 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4Lq7ELQ/y+hhAKvAnNzOj2JKLCyi8+/h613YEue7xwpZ2eNHfi1a+2C7DaQ76IPK3iEUYZ8MFB/ZJeX5kSwTY3VGVKnkDveZ7ZvLD8vgyt5fattRPDI1cXdMG8pvcZunHs+iIH1+txv1EIzG3KkG8ZAPpvHqHlRYq5KRjMBFpEu/eRsGzByp+sDc99bJuQihprZE7UJrzq7orS/5rivQ59HFOeCG5qRmQfoIPv65TeKuWI8hQW3bBMj+paacOswWHhF99OgcrRBkdd2SrhqZrmRFl1nSy9KivGqSXwRYY+FF6hSNivPRsI169KUPEcLEuLx6lHG6/4CFkdbRh0wIL uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa new file mode 100644 index 0000000000..01a88acea2 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQC97XncQDaa9PQYEWK7llBxZQ2suVYTz1eadw2HtY+Y8ZKdUBLd +9LUQ2lymUC9yq66rb5pBBR13k/9Zcbu8I0nafrZT4wJ4H0YGD6Ob5O4HR4EHjO5q +hgnMJ17e1XnzI31MW5xAuAHTLLClNvnG05T1jaU+tRAsVSCHin3+sOenowIVAMSe +ANBvw7fm5+Lw+ziOAHPjeYzRAoGBALkWCGpKmlJ65F3Y/RcownHQvsrDAllzKF/a +cSfriCVVP5qVZ3Ach28ZZ9BFEnRE2SKqVsyBAiceb/+ISlu8CqKEvvoNIMJAu5rU +MwZh+PeHN4ES6tWTwBGAwu84ke6N4BgV+6Q4qkcyywHsT5oU0EdVbn2zzAZw8c7v +BpbsJ1KsAoGABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CI +TjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJ +MIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+WsCFQCRJayH +P4vM1XUOVEeX7u04K1EAFg== +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub new file mode 100644 index 0000000000..30661d5adf --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAL3tedxANpr09BgRYruWUHFlDay5VhPPV5p3DYe1j5jxkp1QEt30tRDaXKZQL3KrrqtvmkEFHXeT/1lxu7wjSdp+tlPjAngfRgYPo5vk7gdHgQeM7mqGCcwnXt7VefMjfUxbnEC4AdMssKU2+cbTlPWNpT61ECxVIIeKff6w56ejAAAAFQDEngDQb8O35ufi8Ps4jgBz43mM0QAAAIEAuRYIakqaUnrkXdj9FyjCcdC+ysMCWXMoX9pxJ+uIJVU/mpVncByHbxln0EUSdETZIqpWzIECJx5v/4hKW7wKooS++g0gwkC7mtQzBmH494c3gRLq1ZPAEYDC7ziR7o3gGBX7pDiqRzLLAexPmhTQR1VufbPMBnDxzu8GluwnUqwAAACABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CITjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJMIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+Ws= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub new file mode 100644 index 0000000000..b349d26da3 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAtyeX0PPvMULKNJYQXaC3bw9eKErEIjLsHl6vg8tvuDI3cNv228NAr2xNviljXIMMUS8nDRnDAgXX/3DoDchpA= sshtester@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 new file mode 100644 index 0000000000..ece6c8f284 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBdgJs/xThHiy/aY1ymtQ4B0URNnRCm8l2WZMFjua57+nvq4Duf+igN +pN/5p/+azLKgBwYFK4EEACKhZANiAATUw6pT/UW2HvTW6lL2BGY7NfUGEX285XVi +9AcTXH1K+TOekbGmcpSirlGzSb15Wycajpmaae5vAzH1nnvcVd3FYODVdDXTHgV/ +FeXQ+vaw7CZnEAKZsr8mjXRX3fEyO1E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub new file mode 100644 index 0000000000..fd81e220f7 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBNTDqlP9RbYe9NbqUvYEZjs19QYRfbzldWL0BxNcfUr5M56RsaZylKKuUbNJvXlbJxqOmZpp7m8DMfWee9xV3cVg4NV0NdMeBX8V5dD69rDsJmcQApmyvyaNdFfd8TI7UQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 new file mode 100644 index 0000000000..21c000ea03 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEEhm0w3xcGILU8eP61mThVBwCJfyzrFktGf7cCa1ciL4YLsukd20Q3Z +yp0YcEDLcEm36CZGabgkEvblJ1Rx2lPTu6AHBgUrgQQAI6GBiQOBhgAEAYep8cX2 +7wUPw5pNYwFkWQXrJ2GSkmO8iHwkWJ6srRay/sF3WoPF/dyDVymFgirtsSTJ+D0u +ex4qphOOJxkd1Yf+ANHvDFN9LoBvbgtNLTRJlpuNLCdWQlt+mEnPMDGMV/HWHHiz +7/mWE+XUVIcQjhm5uv0ObI/wroZEurXMGEhTis3L +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub new file mode 100644 index 0000000000..d9830da5de --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAGHqfHF9u8FD8OaTWMBZFkF6ydhkpJjvIh8JFierK0Wsv7Bd1qDxf3cg1cphYIq7bEkyfg9LnseKqYTjicZHdWH/gDR7wxTfS6Ab24LTS00SZabjSwnVkJbfphJzzAxjFfx1hx4s+/5lhPl1FSHEI4Zubr9DmyP8K6GRLq1zBhIU4rNyw== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa new file mode 100644 index 0000000000..2e50ac2304 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpQIBAAKCAQEA7+C3gLoflKybq4I+clbg2SWf6cXyHpnLNDnZeMvIbOz2X/Ce +XUm17DFeexTaVBs9Zq9WwDFOFkLQhbuXgpvB0shSY0nr+Em7InRM8AiRLxPe0txM +mFFhL+v083dYwgaJOo1PthNM/tGRZJu+0sQDqrmN7CusFHdZg2NTzTzbwWqPiuP/ +mf3o7W4CWqDTBzbYTgpWlH7vRZf9FYwT4on5YWzLA8TvO2TwBGTfTMK5nswH++iO +v4jKecoEwyBFMUSKqZ9UYHGw/kshHbltM65Ye/xjXEX0GxDdxu8ZyVKXd4acNbJJ +P0tcxN4GzKJiR6zNYwCzDhjqDEbM5qCGhShhgQIDAQABAoIBAQCucdGBP9mvmUcs +Fu+q3xttTztYGqfVMSrhtCA/BJOhA0K4ypegZ/Zw6gY3pBaSi6y/fEuuQSz0a2qR +lra8OOFflGa15hBA4/2/NKyu8swCXITy+1qIesYev43HcMePcolhl1qcorSfq2/8 +pnbDd+Diy0Y2thvSVmk2b4mF+/gkUx3CHLhgRMcxCHLG1VeqIfLf+pa0jIw94tZ5 +CoIoI096pDTsneO9xhh1QxWQRRFVqdf3Q9zyiBgJCggpX+1fVsbQejuEK4hKRBKx +SRPX/pX5aU+7+KSZ/DbtXGg1sCw9NUDFTIEV3UPmko4oWawNGv/CQAK80g3go28v +UnVf11BBAoGBAP2amIFp+Ps33A5eesT7g/NNkGqBEi5W37K8qzYJxqXJvH0xmpFo +8a3Je3PQRrzbTUJyISA6/XNnA62+bEvWiEXPiK3stQzNHoVz7ftCb19zgW4sLKRW +Qhjq7QsGeRrdksJnZ7ekfzOv658vHJPElS1MdPu2WWhiNvAjtmdyFQulAoGBAPIk +6831QAnCdp/ffH/K+cqV9vQYOFig8n4mQNNC+sLghrtZh9kbmTuuNKAhF56vdCCn +ABD/+RiLXKVsF0PvQ5g9wRLKaiJubXI7XEBemCCLhjtESxGpWEV8GalslUgE1cKs +d1pwSVjd0sYt0gOAf2VRhlbpSWhXA2xVll34xgetAoGAHaI089pYN7K9SgiMO/xP +3NxRZcCTSUrpdM9LClN2HOVH2zEyqI8kvnPuswfBXEwb6QnBCS0bdKKy8Vhw+yOk +ZNPtWrVwKoDFcj6rrlKDBRpQI3mR9doGezboYANvn04I2iKPIgxcuMNzuvQcWL/9 +1n86pDcYl3Pyi3kA1XGlN+kCgYEAz1boBxpqdDDsjGa8X1y5WUviAw8+KD3ghj5R +IdTnjbjeBUxbc38bTawUac0MQZexE0iMWQImFGs4sHkGzufwdErkqSdjjAoMc1T6 +4C9fifaOwO7wbLYZ3J2wB4/vn5RsSV6OcIVXeN2wXnvbqZ38+A+/vWnSrqJbTwdW +Uy7yup0CgYEA8M9vjpAoCr3XzNDwJyWRQcT7e+nRYUNDlXBl3jpQhHuJtnSnkoUv +HXYXEwvp8peycNzeVz5OwFVMzCH8OG4WiGN4Pmo0rDWHED/W7eIRHIitHGTzZ+Qw +gRxscoewblSLSkYMXidBLmQjr4U5bDBesRuGhm5NuLyMTa1f3Pc/90k= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub new file mode 100644 index 0000000000..26e560d4f8 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDv4LeAuh+UrJurgj5yVuDZJZ/pxfIemcs0Odl4y8hs7PZf8J5dSbXsMV57FNpUGz1mr1bAMU4WQtCFu5eCm8HSyFJjSev4SbsidEzwCJEvE97S3EyYUWEv6/Tzd1jCBok6jU+2E0z+0ZFkm77SxAOquY3sK6wUd1mDY1PNPNvBao+K4/+Z/ejtbgJaoNMHNthOClaUfu9Fl/0VjBPiiflhbMsDxO87ZPAEZN9MwrmezAf76I6/iMp5ygTDIEUxRIqpn1RgcbD+SyEduW0zrlh7/GNcRfQbEN3G7xnJUpd3hpw1skk/S1zE3gbMomJHrM1jALMOGOoMRszmoIaFKGGB uabhnil@elxadlj3q32 diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index f317dfded4..e4109dd080 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -42,9 +42,11 @@ TLS-1.1, and TLS-1.2.</item> <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 19) </item> + <item>For security reasons RSA key exchange cipher suites are no longer supported by default, + but can be configured. (OTP 21) </item> <item>For security reasons DES cipher suites are no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 20) </item> <item> Renegotiation Indication Extension <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url> is supported </item> <item>Ephemeral Diffie-Hellman cipher suites are supported, diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index b0e38fb9ad..dba8e5a311 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -38,7 +38,7 @@ cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1]). @@ -324,7 +324,8 @@ all_suites({3, _} = Version) -> ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) - ++ des_suites(Version); + ++ des_suites(Version) + ++ rsa_suites(Version); all_suites(Version) -> dtls_v1:all_suites(Version). @@ -373,7 +374,6 @@ anonymous_suites(N) when N == 0; %%-------------------------------------------------------------------- psk_suites({3, N}) -> psk_suites(N); - psk_suites(N) when N >= 3 -> [ @@ -394,7 +394,6 @@ psk_suites(N) ?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, @@ -430,7 +429,7 @@ srp_suites() -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec rc4_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +-spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the RSA|(ECDH/RSA)| (ECDH/ECDSA) %% with RC4 cipher suites, only supported if explicitly set by user. @@ -438,13 +437,15 @@ srp_suites() -> %% belonged to the user configured only category. %%-------------------------------------------------------------------- rc4_suites({3, 0}) -> + rc4_suites(0); +rc4_suites({3, Minor}) -> + rc4_suites(Minor) ++ rc4_suites(0); +rc4_suites(0) -> [?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5]; -rc4_suites({3, N}) when N =< 3 -> +rc4_suites(N) when N =< 3 -> [?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- @@ -459,6 +460,29 @@ des_suites(_)-> ?TLS_RSA_WITH_DES_CBC_SHA]. %%-------------------------------------------------------------------- +-spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the RSA key exchange +%% cipher suites, only supported if explicitly set by user. +%% Are not considered secure any more. +%%-------------------------------------------------------------------- +rsa_suites({3, 0}) -> + rsa_suites(0); +rsa_suites({3, Minor}) -> + rsa_suites(Minor) ++ rsa_suites(0); +rsa_suites(0) -> + [?TLS_RSA_WITH_AES_256_CBC_SHA, + ?TLS_RSA_WITH_AES_128_CBC_SHA, + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA + ]; +rsa_suites(N) when N =< 3 -> + [ + ?TLS_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ]. +%%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. @@ -2301,7 +2325,7 @@ calc_mac_hash(Type, Version, MacSecret, SeqNo, Type, Length, PlainFragment). -is_stream_ciphersuite({_, rc4_128, _, _}) -> +is_stream_ciphersuite(#{cipher := rc4_128}) -> true; is_stream_ciphersuite(_) -> false. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index a8fe119bf8..af3f037477 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -202,7 +202,6 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, @@ -210,15 +209,13 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA ]; suites(3) -> [?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, @@ -238,8 +235,6 @@ suites(3) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - ?TLS_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_RSA_WITH_AES_256_CBC_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, @@ -253,9 +248,7 @@ suites(3) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 %% not supported %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384, @@ -264,8 +257,6 @@ suites(3) -> %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 ] ++ suites(2). - - signature_algs({3, 3}, HashSigns) -> CryptoSupports = crypto:supports(), Hashes = proplists:get_value(hashs, CryptoSupports), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 3b4ca40058..dc602910a1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -280,8 +280,11 @@ end_per_suite(_Config) -> init_per_group(GroupName, Config) when GroupName == basic_tls; GroupName == options_tls; + GroupName == options; GroupName == basic; - GroupName == options -> + GroupName == session; + GroupName == error_handling_tests_tls + -> ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of @@ -381,12 +384,12 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites; TestCase == anonymous_cipher_suites; TestCase == psk_anon_cipher_suites; TestCase == psk_anon_with_hint_cipher_suites; - TestCase == srp_cipher_suites, - TestCase == srp_anon_cipher_suites, - TestCase == srp_dsa_cipher_suites, - TestCase == des_rsa_cipher_suites, - TestCase == des_ecdh_rsa_cipher_suites, - TestCase == versions_option, + TestCase == srp_cipher_suites; + TestCase == srp_anon_cipher_suites; + TestCase == srp_dsa_cipher_suites; + TestCase == des_rsa_cipher_suites; + TestCase == des_ecdh_rsa_cipher_suites; + TestCase == versions_option; TestCase == tls_tcp_connect_big -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 60}), @@ -427,6 +430,12 @@ init_per_testcase(rizzo_disabled, Config) -> ct:timetrap({seconds, 60}), rizzo_add_mitigation_option(disabled, Config); +init_per_testcase(TestCase, Config) when TestCase == no_reuses_session_server_restart_new_cert_file; + TestCase == no_reuses_session_server_restart_new_cert -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:timetrap({seconds, 15}), + Config; + init_per_testcase(prf, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 40}), @@ -655,7 +664,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa, aes_128_cbc, sha}]} | + [{ciphers,[{dhe_rsa, aes_128_cbc, sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -663,7 +672,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {dhe_rsa, aes_128_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -1278,9 +1287,14 @@ cipher_suites() -> [{doc,"Test API function cipher_suites/0"}]. cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, - [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites), + 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), Suites = ssl:cipher_suites(erlang), [_|_] =ssl:cipher_suites(openssl). @@ -1289,7 +1303,7 @@ cipher_suites_mix() -> [{doc,"Test to have old and new cipher suites at the same time"}]. cipher_suites_mix(Config) when is_list(Config) -> - CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}], + CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}], ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), @@ -3234,16 +3248,16 @@ tls_tcp_reuseaddr(Config) when is_list(Config) -> honor_server_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_server_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {rsa, aes_256_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {dhe_rsa, aes_256_cbc, sha}). honor_client_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_client_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {rsa, aes_128_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {dhe_rsa, aes_128_cbc, sha}). honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), @@ -4600,38 +4614,39 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. run_suites(Ciphers, Config, Type) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), ct:log("Running cipher suites ~p~n", [Ciphers]), {ClientOpts, ServerOpts} = case Type of rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_verification_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; dsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_dsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; anonymous -> %% No certs in opts! {ssl_test_lib:ssl_options(client_verification_opts, Config), - [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options([], Config)]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_hint, Config) ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), @@ -4644,7 +4659,8 @@ run_suites(Ciphers, Config, Type) -> ssl_test_lib:ssl_options(server_srp_dsa, Config)}; ecdsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; ecdh_rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}; @@ -4669,7 +4685,6 @@ run_suites(Ciphers, Config, Type) -> [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_verification_opts, Config)]} end, - Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, ssl_test_lib:filter_suites(Ciphers, Version)), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 03c3ed9be3..e74529b455 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1024,15 +1024,26 @@ string_regex_filter(Str, Search) when is_list(Str) -> string_regex_filter(_Str, _Search) -> false. -anonymous_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]. - -psk_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]. - -psk_anon_suites(Version) -> - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]. - +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))]. srp_suites() -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- @@ -1335,8 +1346,9 @@ enough_openssl_crl_support(_) -> true. wait_for_openssl_server(Port, tls) -> do_wait_for_openssl_tls_server(Port, 10); -wait_for_openssl_server(Port, dtls) -> - do_wait_for_openssl_dtls_server(Port, 10). +wait_for_openssl_server(_Port, dtls) -> + ok. %% No need to wait for DTLS over UDP server + %% client will retransmitt until it is up. do_wait_for_openssl_tls_server(_, 0) -> exit(failed_to_connect_to_openssl); @@ -1349,21 +1361,6 @@ do_wait_for_openssl_tls_server(Port, N) -> do_wait_for_openssl_tls_server(Port, N-1) end. -do_wait_for_openssl_dtls_server(_, 0) -> - %%exit(failed_to_connect_to_openssl); - ok; -do_wait_for_openssl_dtls_server(Port, N) -> - %% case gen_udp:open(0) of - %% {ok, S} -> - %% gen_udp:connect(S, "localhost", Port), - %% gen_udp:close(S); - %% _ -> - %% ct:sleep(?SLEEP), - %% do_wait_for_openssl_dtls_server(Port, N-1) - %% end. - ct:sleep(500), - do_wait_for_openssl_dtls_server(Port, N-1). - version_flag(tlsv1) -> "-tls1"; version_flag('tlsv1.1') -> @@ -1664,78 +1661,3 @@ hardcode_dsa_key(3) -> y = 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, x = 1457508827177594730669011716588605181448418352823}. -dtls_hello() -> - [1, - <<0,1,4>>, - <<0,0>>, - <<0,0,0>>, - <<0,1,4>>, - <<254,253,88, - 156,129,61, - 131,216,15, - 131,194,242, - 46,154,190, - 20,228,234, - 234,150,44, - 62,96,96,103, - 127,95,103, - 23,24,42,138, - 13,142,32,57, - 230,177,32, - 210,154,152, - 188,121,134, - 136,53,105, - 118,96,106, - 103,231,223, - 133,10,165, - 50,32,211, - 227,193,14, - 181,143,48, - 66,0,0,100,0, - 255,192,44, - 192,48,192, - 36,192,40, - 192,46,192, - 50,192,38, - 192,42,0,159, - 0,163,0,107, - 0,106,0,157, - 0,61,192,43, - 192,47,192, - 35,192,39, - 192,45,192, - 49,192,37, - 192,41,0,158, - 0,162,0,103, - 0,64,0,156,0, - 60,192,10, - 192,20,0,57, - 0,56,192,5, - 192,15,0,53, - 192,8,192,18, - 0,22,0,19, - 192,3,192,13, - 0,10,192,9, - 192,19,0,51, - 0,50,192,4, - 192,14,0,47, - 1,0,0,86,0,0, - 0,14,0,12,0, - 0,9,108,111, - 99,97,108, - 104,111,115, - 116,0,10,0, - 58,0,56,0,14, - 0,13,0,25,0, - 28,0,11,0,12, - 0,27,0,24,0, - 9,0,10,0,26, - 0,22,0,23,0, - 8,0,6,0,7,0, - 20,0,21,0,4, - 0,5,0,18,0, - 19,0,1,0,2,0, - 3,0,15,0,16, - 0,17,0,11,0, - 2,1,0>>]. - diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9118e4b7e3..bbb925e742 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -201,11 +201,11 @@ init_per_testcase(expired_session, Config) -> init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs; TestCase == ciphers_dsa_signed_certs -> - ct:timetrap({seconds, 60}), + ct:timetrap({seconds, 90}), special_init(TestCase, Config); init_per_testcase(TestCase, Config) -> - ct:timetrap({seconds, 20}), + ct:timetrap({seconds, 35}), special_init(TestCase, Config). special_init(TestCase, Config) diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 5e631aac21..3b5be75bc0 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2003</year><year>2017</year> + <year>2003</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -296,7 +296,7 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> for a file with the extension <c>.beam</c>, the default rule is to look for a file with a corresponding extension <c>.erl</c> by replacing the suffix <c>"ebin"</c> of the object directory path with - <c>"src"</c>. + <c>"src"</c> or <c>"src/*"</c>. The file search is done through <seealso marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of the object file is always tried before any other directory specified diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index d2608ad542..ce19f70df0 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2017</year> + <year>1997</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -399,15 +399,18 @@ true tuples <c>{<anno>BinSuffix</anno>, <anno>SourceSuffix</anno>}</c> and is interpreted as follows: if the end of the directory name where the object is located matches <c><anno>BinSuffix</anno></c>, then the - source code directory has the same name, but with - <c><anno>BinSuffix</anno></c> replaced by - <c><anno>SourceSuffix</anno></c>. <c><anno>Rules</anno></c> defaults + name created by replacing <c><anno>BinSuffix</anno></c> with + <c><anno>SourceSuffix</anno></c> is expanded by calling + <seealso marker="filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>. + If a regular file is found among the matches, the function + returns that location together with <c><anno>Options</anno></c>. + Otherwise the next rule is tried, and so on.</p> + <p><c><anno>Rules</anno></c> defaults to:</p> <code type="none"> -[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}]</code> - <p>If the source file is found in the resulting directory, the function - returns that location together with <c><anno>Options</anno></c>. - Otherwise the next rule is tried, and so on.</p> +[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}, + {"ebin", "src/*"}, {"ebin", "esrc/*"}]</code> <p>The function returns <c>{<anno>SourceFile</anno>, <anno>Options</anno>}</c> if it succeeds. <c><anno>SourceFile</anno></c> is the absolute path to the source diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index 64fcf4379f..72c774e6ef 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -257,8 +257,9 @@ ok</pre> \x{400} ok 5> <input>io:fwrite("~s~n",[[1024]]).</input> -** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, - ...</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s~n",[[1024]])</pre> </item> <tag><c>w</c></tag> <item> @@ -454,12 +455,9 @@ ok</pre> abc def 'abc def' {foo,1} A ok 2> <input>io:fwrite("~s", [65]).</input> -** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, - {erl_eval,do_apply,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]} - in function io:o_request/2</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s","A")</pre> <p>In this example, an attempt was made to output the single character 65 with the aid of the string formatting directive <c>"~s"</c>.</p> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index eafee346eb..4ee11383da 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -69,6 +69,9 @@ -type(non_local_function_handler() :: {value, nlfun_handler()} | none). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% exprs(ExpressionSeq, Bindings) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler) @@ -90,7 +93,7 @@ exprs(Exprs, Bs) -> ok -> exprs(Exprs, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,exprs,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(exprs(Expressions, Bindings, LocalFunctionHandler) -> @@ -141,7 +144,7 @@ expr(E, Bs) -> ok -> expr(E, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,expr,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(expr(Expression, Bindings, LocalFunctionHandler) -> @@ -182,7 +185,7 @@ check_command(Es, Bs) -> fun_data(F) when is_function(F) -> case erlang:fun_info(F, module) of - {module,erl_eval} -> + {module,?MODULE} -> case erlang:fun_info(F, env) of {env,[{FBs,_FLf,_FEf,FCs}]} -> {fun_data,FBs,FCs}; @@ -209,8 +212,8 @@ expr({var,_,V}, Bs, _Lf, _Ef, RBs) -> case binding(V, Bs) of {value,Val} -> ret_expr(Val, Bs, RBs); - unbound -> % Should not happen. - erlang:raise(error, {unbound,V}, stacktrace()) + unbound -> % Cannot not happen if checked by erl_lint + erlang:raise(error, {unbound,V}, ?STACKTRACE) end; expr({char,_,C}, Bs, _Lf, _Ef, RBs) -> ret_expr(C, Bs, RBs); @@ -236,13 +239,13 @@ expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), ret_expr(list_to_tuple(Vs), Bs, RBs); expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); %% map expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> @@ -281,7 +284,7 @@ expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 %% Don't know what to do... - erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]); + erlang:raise(error, undef, [{?MODULE,Name,Arity}|?STACKTRACE]); expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> %% Save only used variables in the function environment. %% {value,L,V} are hidden while lint finds used variables. @@ -326,7 +329,7 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end; _Other -> erlang:raise(error, {'argument_limit',{'fun',Line,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> @@ -378,7 +381,7 @@ expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> RF, Info) end; _Other -> erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, @@ -422,25 +425,28 @@ expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {As,Bs2} = expr_list(As0, Bs1, Lf, Ef), case Func of {M,F} when is_atom(M), is_atom(F) -> - erlang:raise(error, {badfun,Func}, stacktrace()); + erlang:raise(error, {badfun,Func}, ?STACKTRACE); _ -> do_apply(Func, As, Bs2, Ef, RBs) end; expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) -> - Ref = make_ref(), - case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of - {Ref,{value,V,Bs}} -> % Nothing was thrown (guaranteed). - ret_expr(V, Bs, RBs); - Other -> - ret_expr(Other, Bs0, RBs) + try expr(Expr, Bs0, Lf, Ef, none) of + {value,V,Bs} -> + ret_expr(V, Bs, RBs) + catch + throw:Term -> + ret_expr(Term, Bs0, RBs); + exit:Reason -> + ret_expr({'EXIT',Reason}, Bs0, RBs); + error:Reason:Stacktrace -> + ret_expr({'EXIT',{Reason,Stacktrace}}, Bs0, RBs) end; expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) -> {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none), case match(Lhs, Rhs, Bs1) of {match,Bs} -> ret_expr(Rhs, Bs, RBs); - nomatch -> - erlang:raise(error, {badmatch,Rhs}, stacktrace()) + nomatch -> erlang:raise(error, {badmatch,Rhs}, ?STACKTRACE) end; expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) -> {value,A,Bs} = expr(A0, Bs0, Lf, Ef, none), @@ -452,7 +458,7 @@ expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; false -> false; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -462,7 +468,7 @@ expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> false -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -474,7 +480,7 @@ expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) -> {value,V,Bs} = eval_bits:expr_grp(Fs, Bs0, EvalFun), ret_expr(V, Bs, RBs); expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {badexpr,':'}, stacktrace()); + erlang:raise(error, {badexpr,':'}, ?STACKTRACE); expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. ret_expr(Val, Bs, RBs). @@ -570,7 +576,7 @@ local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> - erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). + erlang:raise(error, undef, [{?MODULE,Func,length(As0)}|?STACKTRACE]). local_func2({value,V,Bs}, RBs) -> ret_expr(V, Bs, RBs); @@ -637,7 +643,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_fun(FCs, As, FBs, FLf, FEf, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {{env,[{FBs,FLf,FEf,FCs,FName}]},_} -> NRBs = if @@ -648,7 +654,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {no_env,none} when RBs =:= value -> %% Make tail recursive calls when possible. @@ -730,7 +736,7 @@ eval_generate([V|Rest], P, Bs0, Lf, Ef, CompFun, Acc) -> eval_generate([], _P, _Bs0, _Lf, _Ef, _CompFun, Acc) -> Acc; eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Mfun = match_fun(Bs0), @@ -746,7 +752,7 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Acc end; eval_b_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> case erl_lint:is_guard_test(F) of @@ -760,7 +766,7 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> {value,true,Bs1} -> CompFun(Bs1); {value,false,_} -> Acc; {value,V,_} -> - erlang:raise(error, {bad_filter,V}, stacktrace()) + erlang:raise(error, {bad_filter,V}, ?STACKTRACE) end end. @@ -816,7 +822,7 @@ eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) -> end; eval_fun([], As, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) -> @@ -836,7 +842,7 @@ eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) -> end; eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). %% expr_list(ExpressionList, Bindings) @@ -894,13 +900,13 @@ if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf, Ef, RBs) -> false -> if_clauses(Cs, Bs, Lf, Ef, RBs) end; if_clauses([], _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, if_clause, stacktrace()). + erlang:raise(error, if_clause, ?STACKTRACE). %% try_clauses(Body, CaseClauses, CatchClauses, AfterBody, Bindings, %% LocalFuncHandler, ExtFuncHandler, RBs) -%% When/if variable bindings between the different parts of a -%% try-catch expression are introduced this will have to be rewritten. + try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> + check_stacktrace_vars(Catches, Bs), try exprs(B, Bs, Lf, Ef, none) of {value,V,Bs1} when Cases =:= [] -> ret_expr(V, Bs1, RBs); @@ -909,23 +915,18 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {try_clause,V}, stacktrace()) + erlang:raise(error, {try_clause,V}, ?STACKTRACE) end catch - Class:Reason when Catches =:= [] -> - %% Rethrow - erlang:raise(Class, Reason, stacktrace()); - Class:Reason -> -%%% %% Set stacktrace -%%% try erlang:raise(Class, Reason, stacktrace()) -%%% catch _:_ -> ok -%%% end, - V = {Class,Reason,erlang:get_stacktrace()}, - case match_clause(Catches, [V],Bs, Lf, Ef) of + Class:Reason:Stacktrace when Catches =:= [] -> + erlang:raise(Class, Reason, Stacktrace); + Class:Reason:Stacktrace -> + V = {Class,Reason,Stacktrace}, + case match_clause(Catches, [V], Bs, Lf, Ef) of {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(Class, Reason, stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end after if AB =:= [] -> @@ -935,6 +936,23 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> end end. +check_stacktrace_vars([{clause,_,[{tuple,_,[_,_,STV]}],_,_}|Cs], Bs) -> + case STV of + {var,_,V} -> + case binding(V, Bs) of + {value, _} -> + erlang:raise(error, stacktrace_bound, ?STACKTRACE); + unbound -> + check_stacktrace_vars(Cs, Bs) + end; + _ -> + erlang:raise(error, + {illegal_stacktrace_variable,STV}, + ?STACKTRACE) + end; +check_stacktrace_vars([], _Bs) -> + ok. + %% case_clauses(Value, Clauses, Bindings, LocalFuncHandler, ExtFuncHandler, %% RBs) @@ -943,7 +961,7 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) -> {B, Bs1} -> exprs(B, Bs1, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {case_clause,Val}, stacktrace()) + erlang:raise(error, {case_clause,Val}, ?STACKTRACE) end. %% @@ -1018,7 +1036,7 @@ guard0([G|Gs], Bs0, Lf, Ef) -> {value,false,_} -> false end; false -> - erlang:raise(error, guard_expr, stacktrace()) + erlang:raise(error, guard_expr, ?STACKTRACE) end; guard0([], _Bs, _Lf, _Ef) -> true. @@ -1073,7 +1091,7 @@ match(Pat, Term, Bs) -> match(Pat, Term, Bs, BBs) -> case catch match1(Pat, Term, Bs, BBs) of invalid -> - erlang:raise(error, {illegal_pattern,Pat}, stacktrace()); + erlang:raise(error, {illegal_pattern,Pat}, ?STACKTRACE); Other -> Other end. @@ -1254,7 +1272,7 @@ merge_bindings(Bs1, Bs2) -> case orddict:find(Name, Bs) of {ok,Val} -> Bs; %Already with SAME value {ok,V1} -> - erlang:raise(error, {badmatch,V1}, stacktrace()); + erlang:raise(error, {badmatch,V1}, ?STACKTRACE); error -> orddict:store(Name, Val, Bs) end end, Bs2, orddict:to_list(Bs1)). @@ -1264,7 +1282,7 @@ merge_bindings(Bs1, Bs2) -> %% fun (Name, Val, Bs) -> %% case orddict:find(Name, Bs) of %% {ok,Val} -> orddict:erase(Name, Bs); -%% {ok,V1} -> erlang:raise(error,{badmatch,V1},stacktrace()); +%% {ok,V1} -> erlang:raise(error,{badmatch,V1},?STACKTRACE); %% error -> Bs %% end %% end, Bs2, Bs1). @@ -1326,7 +1344,3 @@ ret_expr(_Old, New) -> New. line(Expr) -> element(2, Expr). - -%% {?MODULE,expr,3} is still the stacktrace, despite the -%% fact that expr() now takes two, three or four arguments... -stacktrace() -> [{?MODULE,expr,3}]. diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 76f0b38108..5ee584d612 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -189,7 +189,7 @@ table(Name) -> %% Returns a list of names of the files in the tar file Name. %% Options accepted: compressed, verbose, cooked. -spec table(open_handle(), [compressed | verbose | cooked]) -> - {ok, [tar_entry()]} | {error, term()}. + {ok, [string() | tar_entry()]} | {error, term()}. table(Name, Opts) when is_list(Opts) -> foldl_read(Name, fun table1/4, [], table_opts(Opts)). diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 631faa3be5..bb86a65c72 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -25,6 +25,9 @@ -export([expr_grp/3,expr_grp/5,match_bits/6, match_bits/7,bin_gen/6]). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% Types used in this module: %% @type bindings(). An abstract structure for bindings between %% variables and values (the environment) @@ -93,9 +96,9 @@ eval_exp_field1(V, Size, Unit, Type, Endian, Sign) -> eval_exp_field(V, Size, Unit, Type, Endian, Sign) catch error:system_limit -> - error(system_limit); + erlang:raise(error, system_limit, ?STACKTRACE); error:_ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end. eval_exp_field(Val, Size, Unit, integer, little, signed) -> @@ -131,7 +134,7 @@ eval_exp_field(Val, all, Unit, binary, _, _) -> Size when Size rem Unit =:= 0 -> <<Val:Size/binary-unit:1>>; _ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end; eval_exp_field(Val, Size, Unit, binary, _, _) -> <<Val:(Size*Unit)/binary-unit:1>>. @@ -377,12 +380,12 @@ make_bit_type(Line, default, Type0) -> {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end; make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' case erl_bits:set_bit_type(Size, Type0) of {ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end. match_check_size(Mfun, Size, Bs) -> @@ -405,9 +408,3 @@ match_check_size(_, {value,_,_}, _Bs, _AllowAll) -> ok; %From the debugger. match_check_size(_, _, _Bs, _AllowAll) -> throw(invalid). - -%% error(Reason) -> exception thrown -%% Throw a nice-looking exception, similar to exceptions from erl_eval. -error(Reason) -> - erlang:raise(error, Reason, [{erl_eval,expr,3}]). - diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 0f90b3fc33..de839be5cf 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -582,17 +582,16 @@ default_search_rules() -> {"", ".c", c_source_search_rules()}, {"", ".in", basic_source_search_rules()}, %% plain old directory rules, backwards compatible - {"", ""}, - {"ebin","src"}, - {"ebin","esrc"} - ]. + {"", ""}] ++ erl_source_search_rules(). basic_source_search_rules() -> (erl_source_search_rules() ++ c_source_search_rules()). erl_source_search_rules() -> - [{"ebin","src"}, {"ebin","esrc"}]. + [{"ebin","src"}, {"ebin","esrc"}, + {"ebin",filename:join("src", "*")}, + {"ebin",filename:join("esrc", "*")}]. c_source_search_rules() -> [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}]. @@ -672,8 +671,16 @@ try_dir_rule(Dir, Filename, From, To) -> Src = filename:join(NewDir, Filename), case is_regular(Src) of true -> {ok, Src}; - false -> error + false -> find_regular_file(wildcard(Src)) end; false -> error end. + +find_regular_file([]) -> + error; +find_regular_file([File|Files]) -> + case is_regular(File) of + true -> {ok, File}; + false -> find_regular_file(Files) + end. diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index a7980cc294..51e0c3f77e 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -551,7 +551,7 @@ format_stacktrace1(S0, Stack0, PF, SF, Enc) -> format_stacktrace2(S, Stack, 1, PF, Enc). format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~ts ~s">>, + [io_lib:fwrite(<<"~s~s ~ts ~ts">>, [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A, Enc), location(L)]) @@ -573,7 +573,7 @@ location(L) -> Line = proplists:get_value(line, L), if File =/= undefined, Line =/= undefined -> - io_lib:format("(~s, line ~w)", [File, Line]); + io_lib:format("(~ts, line ~w)", [File, Line]); true -> "" end. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 212b143b1d..ad4984b64c 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -701,7 +701,9 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> {W,V0}; true -> case result_will_be_saved() of true -> V0; - false -> ignored + false -> + erlang:garbage_collect(), + ignored end end, {{value,V,Bs,get()},Bs}; diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c3ef4eb051..8eb85cab8e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,6 +41,7 @@ otp_8133/1, otp_10622/1, otp_13228/1, + otp_14826/1, funs/1, try_catch/1, eval_expr_5/1, @@ -57,6 +58,7 @@ -export([count_down/2, count_down_fun/0, do_apply/2, local_func/3, local_func_value/2]). +-export([simple/0]). -ifdef(STANDALONE). -define(config(A,B),config(A,B)). @@ -83,7 +85,7 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, otp_13228, + otp_8133, otp_10622, otp_13228, otp_14826, funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. @@ -988,6 +990,173 @@ otp_13228(_Config) -> EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). +%% OTP-14826: more accurate stacktrace. +otp_14826(_Config) -> + backtrace_check("fun(P) when is_pid(P) -> true end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_fun,6}, + ?MODULE]), + backtrace_check("B.", + {unbound_var, 'B'}, + [{erl_eval,expr,2}, ?MODULE]), + backtrace_check("B.", + {unbound, 'B'}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + backtrace_check("1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch 1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + check(fun() -> catch exit(foo) end, + "catch exit(foo).", + {'EXIT', foo}), + check(fun() -> catch throw(foo) end, + "catch throw(foo).", + foo), + backtrace_check("try 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch (try 1/0 after foo end).", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("try catch 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_check("try a of b -> bar after foo end.", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + check(fun() -> X = try foo:bar() catch A:B:C -> {A,B} end, X end, + "try foo:bar() catch A:B:C -> {A,B} end.", + {error, undef}), + backtrace_check("C = 4, try foo:bar() catch A:B:C -> {A,B,C} end.", + stacktrace_bound, + [{erl_eval,check_stacktrace_vars,2}, + {erl_eval,try_clauses,8}], + none, none), + backtrace_catch("catch (try a of b -> bar after foo end).", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + backtrace_check("try 1/0 catch exit:a -> foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + Es = [{'try',1,[{call,1,{remote,1,{atom,1,foo},{atom,1,bar}},[]}], + [], + [{clause,1,[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}], + [],[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}]}],[]}], + try + erl_eval:exprs(Es, [], none, none), + ct:fail(stacktrace_variable) + catch + error:{illegal_stacktrace_variable,{atom,1,'C'}}:S -> + [{erl_eval,check_stacktrace_vars,2,_}, + {erl_eval,try_clauses,8,_}|_] = S + end, + backtrace_check("{1,1} = {A = 1, A = 2}.", + {badmatch, 1}, + [erl_eval, {lists,foldl,3}]), + backtrace_check("case a of a when foo:bar() -> x end.", + guard_expr, + [{erl_eval,guard0,4}], none, none), + backtrace_check("case a of foo() -> ok end.", + {illegal_pattern,{call,1,{atom,1,foo},[]}}, + [{erl_eval,match,4}], none, none), + backtrace_check("case a of b -> ok end.", + {case_clause,a}, + [{erl_eval,case_clauses,6}, ?MODULE]), + backtrace_check("if a =:= b -> ok end.", + if_clause, + [{erl_eval,if_clauses,5}, ?MODULE]), + backtrace_check("fun A(b) -> ok end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_named_fun,8}, + ?MODULE]), + backtrace_check("[A || A <- a].", + {bad_generator, a}, + [{erl_eval,eval_generate,7}, {erl_eval, eval_lc, 6}]), + backtrace_check("<< <<A>> || <<A>> <= a>>.", + {bad_generator, a}, + [{erl_eval,eval_b_generate,7}, {erl_eval, eval_bc, 6}]), + backtrace_check("[A || A <- [1], begin a end].", + {bad_filter, a}, + [{erl_eval,eval_filter,6}, {erl_eval, eval_generate, 7}]), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun F(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + backtrace_check("foo().", + undef, + [{erl_eval,foo,0},{erl_eval,local_func,6}], + none, none), + backtrace_check("a orelse false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("a andalso false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("t = u.", + {badmatch, u}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("{math,sqrt}(2).", + {badfun, {math,sqrt}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("erl_eval_SUITE:simple().", + simple, + [{?MODULE,simple1,0},{?MODULE,simple,0},erl_eval]), + Args = [{integer,1,I} || I <- lists:seq(1, 30)], + backtrace_check("fun(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {'fun',1,[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("fun F(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {named_fun,1,'F',[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("#r{}.", + {undef_record,r}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + %% eval_bits + backtrace_check("<<100:8/bitstring>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval]), + backtrace_check("<<100:8/foo>>.", + {undefined_bittype,foo}, + [{eval_bits,make_bit_type,3},eval_bits, + eval_bits,erl_eval], + none, none), + backtrace_check("B = <<\"foo\">>, <<B/binary-unit:7>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval], + none, none), + ok. + +simple() -> + A = simple1(), + {A}. + +simple1() -> + erlang:error(simple). + %% Simple cases, just to cover some code. funs(Config) when is_list(Config) -> do_funs(none, none), @@ -1488,6 +1657,43 @@ error_check(String, Result, LFH, EFH) -> ct:fail({eval, Other, Result}) end. +backtrace_check(String, Result, Backtrace) -> + case catch parse_and_run(String) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_check(String, Result, Backtrace, LFH, EFH) -> + case catch parse_and_run(String, LFH, EFH) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_catch(String, Result, Backtrace) -> + case parse_and_run(String) of + {value, {'EXIT', {Result, BT}}, _Bindings} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +check_backtrace([B1|Backtrace], [B2|BT]) -> + case {B1, B2} of + {M, {M,_,_,_}} -> + ok; + {{M,F,A}, {M,F,A,_}} -> + ok; + {B, B} -> + ok + end, + check_backtrace(Backtrace, BT); +check_backtrace([], _) -> + ok. + eval_string(String) -> {value, Result, _} = parse_and_run(String), Result. @@ -1499,8 +1705,8 @@ parse_and_run(String) -> parse_and_run(String, LFH, EFH) -> {ok,Tokens,_} = erl_scan:string(String), - {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - erl_eval:expr(Expr, [], LFH, EFH). + {ok, Exprs} = erl_parse:parse_exprs(Tokens), + erl_eval:exprs(Exprs, [], LFH, EFH). no_final_dot(S) -> case lists:reverse(S) of diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 930cea347f..7403d52881 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2017. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, - find_source/1]). + find_source/1, find_source_subdir/1]). -import(lists, [foreach/2]). @@ -49,7 +49,7 @@ all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, wildcard_symlink, is_file_symlink, file_props_symlink, - find_source]. + find_source, find_source_subdir]. groups() -> []. @@ -567,16 +567,18 @@ find_source(Config) when is_list(Config) -> [{".erl",".yrl",[{"",""}]}]), {ok, ParserErl} = filelib:find_source(code:which(core_parse)), + ParserErlName = filename:basename(ParserErl), + ParserErlDir = filename:dirname(ParserErl), {ok, ParserYrl} = filelib:find_source(ParserErl), "lry." ++ _ = lists:reverse(ParserYrl), - {ok, ParserYrl} = filelib:find_source(ParserErl, + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, [{".beam",".erl",[{"ebin","src"}]}, {".erl",".yrl",[{"",""}]}]), %% find_source automatically checks the local directory regardless of rules {ok, ParserYrl} = filelib:find_source(ParserErl), - {ok, ParserYrl} = filelib:find_source(ParserErl, - [{".beam",".erl",[{"ebin","src"}]}]), + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, + [{".erl",".yrl",[{"ebin","src"}]}]), %% find_file does not check the local directory unless in the rules ParserYrlName = filename:basename(ParserYrl), @@ -590,3 +592,24 @@ find_source(Config) when is_list(Config) -> {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), ok. + +find_source_subdir(Config) when is_list(Config) -> + BeamFile = code:which(inets), % Located in lib/inets/src/inets_app/ + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + SrcName = filename:basename(SrcFile), + + {error, not_found} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl",[{"ebin","src"}]}]), + {ok, SrcFile} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl", + [{"ebin",filename:join("src", "*")}]}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + + ok. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl index cc7e070dbd..9ad4bae2f5 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2017. All Rights Reserved. +%% Copyright Ericsson AB 2012-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -281,7 +281,7 @@ comparison(Kind) -> SimpleTimerMon = norm(SimpleTimerMon0, Simple0), Generic = norm(Generic0, Simple0), GenericTimer = norm(GenericTimer0, Simple0), - {Parallelism, _N, Message} = bench_params(Kind), + {Parallelism, Message} = bench_params(Kind), Wordsize = erlang:system_info(wordsize), MSize = Wordsize * erts_debug:flat_size(Message), What = io_lib:format("#parallel gen_server instances: ~.4w, " @@ -296,79 +296,78 @@ comparison(Kind) -> {comment, C}. norm(T, Ref) -> - io_lib:format("~.2f", [T/Ref]). + io_lib:format("~.2f", [Ref/T]). + +-define(MAX_TIME_SECS, 3). % s +-define(MAX_TIME, 1000 * ?MAX_TIME_SECS). % ms +-define(CALLS_PER_LOOP, 5). do_tests(Test, ParamSet) -> {Client, ServerMod} = bench(Test), - {Parallelism, N, Message} = bench_params(ParamSet), - Fun = create_clients(N, Message, ServerMod, Client, Parallelism), - Time = run_test(Fun), - TimesPerTest = 5, - PerSecond = Parallelism * TimesPerTest * round((1000 * N) / Time), + {Parallelism, Message} = bench_params(ParamSet), + Fun = create_clients(Message, ServerMod, Client, Parallelism), + {TotalLoops, AllPidTime} = run_test(Fun), + PerSecond = ?CALLS_PER_LOOP * round((1000 * TotalLoops) / AllPidTime), ct_event:notify(#event{name = benchmark_data, data = [{suite,"stdlib_gen_server"}, {value,PerSecond}]}), - Time. + PerSecond. + +-define(COUNTER, n). -simple_client(0, _, _P) -> - ok; simple_client(N, M, P) -> + put(?COUNTER, N), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), - simple_client(N-1, M, P). + simple_client(N+1, M, P). -simple_client_timer(0, _, _P) -> - ok; simple_client_timer(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), - simple_client_timer(N-1, M, P). + simple_client_timer(N+1, M, P). -simple_client_mon(0, _, _P) -> - ok; simple_client_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), - simple_client_mon(N-1, M, P). + simple_client_mon(N+1, M, P). -simple_client_timer_mon(0, _, _P) -> - ok; simple_client_timer_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), - simple_client_timer_mon(N-1, M, P). + simple_client_timer_mon(N+1, M, P). -generic_client(0, _, _P) -> - ok; generic_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), - generic_client(N-1, M, P). + generic_client(N+1, M, P). -generic_timer_client(0, _, _P) -> - ok; generic_timer_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), - generic_timer_client(N-1, M, P). + generic_timer_client(N+1, M, P). bench(simple) -> {fun simple_client/3, simple_server}; @@ -383,16 +382,16 @@ bench(generic) -> bench(generic_timer) -> {fun generic_timer_client/3, generic_server_timer}. -%% -> {Parallelism, NumberOfMessages, MessageTerm} -bench_params(single_small) -> {1, 700000, small()}; -bench_params(single_medium) -> {1, 350000, medium()}; -bench_params(single_big) -> {1, 70000, big()}; -bench_params(sched_small) -> {parallelism(), 200000, small()}; -bench_params(sched_medium) -> {parallelism(), 100000, medium()}; -bench_params(sched_big) -> {parallelism(), 20000, big()}; -bench_params(multi_small) -> {400, 2000, small()}; -bench_params(multi_medium) -> {400, 1000, medium()}; -bench_params(multi_big) -> {400, 200, big()}. +%% -> {Parallelism, MessageTerm} +bench_params(single_small) -> {1, small()}; +bench_params(single_medium) -> {1, medium()}; +bench_params(single_big) -> {1, big()}; +bench_params(sched_small) -> {parallelism(), small()}; +bench_params(sched_medium) -> {parallelism(), medium()}; +bench_params(sched_big) -> {parallelism(), big()}; +bench_params(multi_small) -> {400, small()}; +bench_params(multi_medium) -> {400, medium()}; +bench_params(multi_big) -> {400, big()}. small() -> small. @@ -409,19 +408,38 @@ parallelism() -> _ -> 1 end. -create_clients(N, M, ServerMod, Client, Parallel) -> +create_clients(M, ServerMod, Client, Parallel) -> fun() -> State = term, ServerPid = ServerMod:start(State), - PidRefs = [spawn_monitor(fun() -> Client(N, M, ServerPid) end) || + PidRefs = [spawn_monitor(fun() -> Client(0, M, ServerPid) end) || _ <- lists:seq(1, Parallel)], - _ = [receive {'DOWN', Ref, _, _, _} -> ok end || - {_Pid, Ref} <- PidRefs], - ok = ServerMod:stop(ServerPid) + timer:sleep(?MAX_TIME), + try + AllPidsN = collect(PidRefs, []), + TotalLoops = lists:sum(AllPidsN), + TotalLoops + after + ok = ServerMod:stop(ServerPid) + end end. +collect([], Result) -> + Result; +collect([{Pid, Ref}|PidRefs], Result) -> + N = case erlang:process_info(Pid, dictionary) of + {dictionary, Dict} -> + {?COUNTER, N0} = lists:keyfind(?COUNTER, 1, Dict), + N0; + undefined -> % Process did not start in ?MAX_TIME_SECS. + 0 + end, + exit(Pid, kill), + receive {'DOWN', Ref, _, _, _} -> ok end, + collect(PidRefs, [N|Result]). + run_test(Test) -> {T1, _} = statistics(runtime), - Test(), + Result = Test(), {T2, _} = statistics(runtime), - T2 - T1. + {Result, T2 - T1}. diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index f03f326278..60a15c8e3f 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -780,8 +780,7 @@ lay_2(Node, Ctxt) -> '_' -> beside(D1, beside(text(":"), D2)); _ -> - D3 = lay(erl_syntax:class_qualifier_stacktrace(Node), - Ctxt1), + D3 = lay(Stacktrace, Ctxt1), beside(D1, beside(beside(text(":"), D2), beside(text(":"), D3))) end; diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index ed552b73df..b816c0699c 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -3895,7 +3895,9 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) -> unfold_try_clauses(Cs) -> [unfold_try_clause(C) || C <- Cs]. -unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, V, _]}], +unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, + V, + [{var, _, '_'}]]}], Guard, Body}) -> {clause, Pos, [V], Guard, Body}; unfold_try_clause({clause, Pos, [{tuple, _, [C, V, Stacktrace]}], @@ -7761,8 +7763,9 @@ subtrees(T) -> catch_expr -> [[catch_expr_body(T)]]; class_qualifier -> - [[class_qualifier_argument(T)], - [class_qualifier_body(T)]]; + [[class_qualifier_argument(T)], + [class_qualifier_body(T)], + [class_qualifier_stacktrace(T)]]; clause -> case clause_guard(T) of none -> @@ -7983,6 +7986,7 @@ make_tree(block_expr, [B]) -> block_expr(B); make_tree(case_expr, [[A], C]) -> case_expr(A, C); make_tree(catch_expr, [[B]]) -> catch_expr(B); make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B); +make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C); make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); make_tree(cond_expr, [C]) -> cond_expr(C); |