diff options
Diffstat (limited to 'lib')
184 files changed, 6551 insertions, 4981 deletions
diff --git a/lib/Makefile b/lib/Makefile index 4740e6eb59..ae466ed518 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -35,7 +35,7 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco \ - eunit ssh typer eldap dialyzer hipe + eunit ssh eldap dialyzer hipe ifdef BUILD_ALL ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) diff --git a/lib/asn1/doc/src/asn1_getting_started.xml b/lib/asn1/doc/src/asn1_getting_started.xml index d2b73d63c3..c036d289fc 100644 --- a/lib/asn1/doc/src/asn1_getting_started.xml +++ b/lib/asn1/doc/src/asn1_getting_started.xml @@ -266,6 +266,10 @@ asn1ct:compile("H323-MESSAGES.asn1",[per]). </pre> <c>{error, {asn1, Description}}</c> where <c>Description</c> is an Erlang term describing the error.</p> + <p>Currently, <c>Description</c> looks like this: + <c>{ErrorDescription, StackTrace}</c>. Applications should + not depend on the exact contents of <c>Description</c> as it + could change in the future.</p> </section> </section> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 321f4147f5..4f04b78241 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -4948,7 +4948,7 @@ componentrelation_leadingattr(S,CompList) -> %%FIXME expand_ExtAddGroups([C#'ExtensionAdditionGroup'{components=ExtAdds}|T], %% CurrPos,PosAcc,CompAcc) -> -%% expand_ExtAddGroups(T,CurrPos+ L = lenght(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc); +%% expand_ExtAddGroups(T,CurrPos+ L = length(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc); %% expand_ExtAddGroups([C|T],CurrPos,PosAcc,CompAcc) -> %% expand_ExtAddGroups(T,CurrPos+ 1,PosAcc,[C|CompAcc]); %% expand_ExtAddGroups([],_CurrPos,PosAcc,CompAcc) -> diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index b7579c8065..9cd9864b80 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -979,6 +979,10 @@ mark_optional(Other) -> gen_enc_components_call1(Gen, TopType, [C|Rest], DynamicEnc, Ext) -> #'ComponentType'{name=Cname,typespec=Type, prop=Prop,textual_order=Num} = C, + InnerType = asn1ct_gen:get_inner(Type#type.def), + CommentString = attribute_comment(InnerType, Num, Cname), + ImmComment = asn1ct_imm:enc_comment(CommentString), + {Imm0,Element} = enc_fetch_field(Gen, Num, Prop), Imm1 = gen_enc_line_imm(Gen, TopType, Cname, Type, Element, DynamicEnc, Ext), @@ -993,7 +997,7 @@ gen_enc_components_call1(Gen, TopType, [C|Rest], DynamicEnc, Ext) -> end, Imm = case Imm2 of [] -> []; - _ -> Imm0 ++ Imm2 + _ -> [ImmComment|Imm0 ++ Imm2] end, [Imm|gen_enc_components_call1(Gen, TopType, Rest, DynamicEnc, Ext)]; gen_enc_components_call1(_Gen, _TopType, [], _, _) -> @@ -1328,27 +1332,17 @@ gen_dec_comp_calls([], _, _, _, _, _, _, Tpos, Acc) -> gen_dec_comp_call(Comp, Gen, TopType, Tpos, OptTable, DecInfObj, Ext, NumberOfOptionals) -> - #'ComponentType'{typespec=Type,prop=Prop,textual_order=TextPos} = Comp, + #'ComponentType'{name=Cname,typespec=Type, + prop=Prop,textual_order=TextPos} = Comp, Pos = case Ext of noext -> Tpos; {ext,Epos,_Enum} -> Tpos - Epos + 1 end, - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=InType} -> - InType; - Def -> - asn1ct_gen:get_inner(Def) - end, + InnerType = asn1ct_gen:get_inner(Type#type.def), - DispType = case InnerType of - #'Externaltypereference'{type=T} -> T; - IT when is_tuple(IT) -> element(2,IT); - _ -> InnerType - end, + CommentString = attribute_comment(InnerType, TextPos, Cname), Comment = fun(St) -> - emit([nl,"%% attribute number ",TextPos, - " with type ",DispType,nl]), + emit([nl,"%% ",CommentString,nl]), St end, @@ -1987,3 +1981,12 @@ enc_dig_out_value(#gen{pack=map}=Gen, [{_,Name}|T], Value) -> make_var(Base) -> {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(Base)))}. + +attribute_comment(InnerType, TextPos, Cname) -> + DispType = case InnerType of + #'Externaltypereference'{type=T} -> T; + IT when is_tuple(IT) -> element(2,IT); + _ -> InnerType + end, + Comment = ["attribute ",Cname,"(",TextPos,") with type ",DispType], + lists:concat(Comment). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 9943bd056a..9f628c7b04 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -802,11 +802,12 @@ result_line_1(Items) -> try_catch() -> [" catch",nl, " Class:Exception when Class =:= error; Class =:= exit ->",nl, + " Stk = erlang:get_stacktrace(),",nl, " case Exception of",nl, - " {error,Reason}=Error ->",nl, - " Error;",nl, + " {error,{asn1,Reason}} ->",nl, + " {error,{asn1,{Reason,Stk}}};",nl, " Reason ->",nl, - " {error,{asn1,Reason}}",nl, + " {error,{asn1,{Reason,Stk}}}",nl, " end",nl, "end."]. diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 2ab848652e..130f68c21d 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -41,7 +41,8 @@ per_enc_extensions_map/4, per_enc_optional/2]). -export([per_enc_sof/5]). --export([enc_absent/3,enc_append/1,enc_element/2,enc_maps_get/2]). +-export([enc_absent/3,enc_append/1,enc_element/2,enc_maps_get/2, + enc_comment/1]). -export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). @@ -216,7 +217,8 @@ per_enc_legacy_bit_string(Val0, NNL0, Constraint0, Aligned) -> per_enc_boolean(Val0, _Aligned) -> {B,[Val]} = mk_vars(Val0, []), B++build_cond([[{eq,Val,false},{put_bits,0,1,[1]}], - [{eq,Val,true},{put_bits,1,1,[1]}]]). + [{eq,Val,true},{put_bits,1,1,[1]}], + ['_',{error,{illegal_boolean,Val}}]]). per_enc_choice(Val0, Cs0, _Aligned) -> {B,[Val]} = mk_vars(Val0, []), @@ -237,7 +239,7 @@ per_enc_enumerated(Val0, Root, Aligned) -> B++[{'cond',Cs++enumerated_error(Val)}]. enumerated_error(Val) -> - [['_',{error,Val}]]. + [['_',{error,{illegal_enumerated,Val}}]]. per_enc_integer(Val0, Constraint0, Aligned) -> {B,[Val]} = mk_vars(Val0, []), @@ -437,6 +439,9 @@ enc_maps_get(N, Val0) -> {var,SrcVar} = Val, {[{assign,DstExpr,SrcVar}],Dst0}. +enc_comment(Comment) -> + {comment,Comment}. + enc_cg(Imm0, false) -> Imm1 = enc_cse(Imm0), Imm2 = enc_pre_cg(Imm1), @@ -874,10 +879,8 @@ flatten_map_cs_1([integer_default], {Int,_}) -> [{'_',Int}]; flatten_map_cs_1([enum_default], {Int,_}) -> [{'_',["{asn1_enum,",Int,"}"]}]; -flatten_map_cs_1([enum_error], {Var,Cs}) -> - Vs = [V || {_,V} <- Cs], - [{'_',["exit({error,{asn1,{decode_enumerated,{",Var,",", - {asis,Vs},"}}}})"]}]; +flatten_map_cs_1([enum_error], {Var,_}) -> + [{'_',["exit({error,{asn1,{decode_enumerated,",Var,"}}})"]}]; flatten_map_cs_1([], _) -> []. flatten_hoist_align([[{align_bits,_,_}=Ab|T]|Cs]) -> @@ -1051,6 +1054,7 @@ split_off_nonbuilding(Imm) -> is_nonbuilding({assign,_,_}) -> true; is_nonbuilding({call,_,_,_,_}) -> true; +is_nonbuilding({comment,_}) -> true; is_nonbuilding({lc,_,_,_,_}) -> true; is_nonbuilding({set,_,_}) -> true; is_nonbuilding({list,_,_}) -> true; @@ -1107,7 +1111,7 @@ per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) -> per_enc_integer_1(Val0, [Constr], Aligned) -> {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), Prefix++build_cond([[Check|Action], - ['_',{error,Val0}]]). + ['_',{error,{illegal_integer,Val0}}]]). per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> per_enc_constrained(Val, Sv, Sv, Aligned); @@ -1931,6 +1935,8 @@ enc_opt({'cond',Cs0}, St0) -> {Cs,Type} = enc_opt_cond_1(Cs1, Type0, [{Cond,Imm}]), {{'cond',Cs},St0#ost{t=Type}} end; +enc_opt({comment,_}=Imm, St) -> + {Imm,St#ost{t=undefined}}; enc_opt({cons,H0,T0}, St0) -> {H,#ost{t=TypeH}=St1} = enc_opt(H0, St0), {T,#ost{t=TypeT}=St} = enc_opt(T0, St1), @@ -2320,6 +2326,9 @@ enc_cg({block,Imm}) -> enc_cg(Imm), emit([nl, "end"]); +enc_cg({seq,{comment,Comment},Then}) -> + emit(["%% ",Comment,nl]), + enc_cg(Then); enc_cg({seq,First,Then}) -> enc_cg(First), emit([com,nl]), @@ -2353,9 +2362,9 @@ enc_cg({'cond',Cs}) -> enc_cg_cond(Cs); enc_cg({error,Error}) when is_function(Error, 0) -> Error(); -enc_cg({error,Var0}) -> +enc_cg({error,{Tag,Var0}}) -> Var = mk_val(Var0), - emit(["exit({error,{asn1,{illegal_value,",Var,"}}})"]); + emit(["exit({error,{asn1,{",Tag,",",Var,"}}})"]); enc_cg({integer,Int}) -> emit(mk_val(Int)); enc_cg({lc,Body,Var,List}) -> @@ -2618,6 +2627,8 @@ enc_opt_al({call,per_common,encode_unconstrained_number,[_]}=Call, _) -> {[Call],0}; enc_opt_al({call,_,_,_,_}=Call, Al) -> {[Call],Al}; +enc_opt_al({comment,_}=Imm, Al) -> + {[Imm],Al}; enc_opt_al({'cond',Cs0}, Al0) -> {Cs,Al} = enc_opt_al_cond(Cs0, Al0), {[{'cond',Cs}],Al}; @@ -2714,6 +2725,8 @@ per_fixup([{block,Block}|T]) -> [{block,per_fixup(Block)}|per_fixup(T)]; per_fixup([{'assign',_,_}=H|T]) -> [H|per_fixup(T)]; +per_fixup([{comment,_}=H|T]) -> + [H|per_fixup(T)]; per_fixup([{'cond',Cs0}|T]) -> Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], [{'cond',Cs}|per_fixup(T)]; diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 3896cb7fa5..e7edfb1ee0 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -140,6 +140,8 @@ encode_relative_oid(Val) when is_tuple(Val) -> encode_relative_oid(Val) when is_list(Val) -> list_to_binary([e_object_element(X)||X <- Val]). +encode_unconstrained_number(Val) when not is_integer(Val) -> + exit({error,{asn1,{illegal_integer,Val}}}); encode_unconstrained_number(Val) when Val >= 0 -> if Val < 16#80 -> diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index 4fe0901683..91c8696e61 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -18,6 +18,8 @@ BEGIN IntExpPri ::= [PRIVATE 51] EXPLICIT INTEGER IntExpApp ::= [APPLICATION 52] EXPLICIT INTEGER + IntConstrained ::= INTEGER (0..255) + IntEnum ::= INTEGER {first(1),last(31)} Enum ::= ENUMERATED {monday(1),tuesday(2),wednesday(3),thursday(4), diff --git a/lib/asn1/test/asn1_SUITE_data/testobj.erl b/lib/asn1/test/asn1_SUITE_data/testobj.erl index e547ea4572..66f4a92188 100644 --- a/lib/asn1/test/asn1_SUITE_data/testobj.erl +++ b/lib/asn1/test/asn1_SUITE_data/testobj.erl @@ -967,7 +967,7 @@ pdu_pdp() -> 116,101,115,116, % lable1 = test 4, % length lable2 116,101,115,116, % lable2 = test - 4, % lenght lable3 + 4, % length lable3 116,101,115,116, % lable3 = test 4, % length lable3 116,101,115,116, % lable4 = test diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index c0840e02d7..c45d130ff4 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -26,48 +26,41 @@ run([]) -> {ok,B} = 'Constructed':encode('S3', {'S3',17}), [T,L|V] = binary_to_list(B), Bytes = list_to_binary([T,L+3|V] ++ [2,1,3]), - case 'Constructed':decode('S3', Bytes) of - {error,{asn1,{unexpected,_}}} -> ok - end, + {unexpected,_} = dec_error('S3', Bytes), %% Unexpected bytes must be accepted if there is an extensionmark {ok,{'S3ext',17}} = 'Constructed':decode('S3ext', Bytes), %% Truncated tag. - {error,{asn1,{invalid_tag,_}}} = - (catch 'Constructed':decode('I', <<31,255,255>>)), + {invalid_tag,_} = dec_error('I', <<31,255,255>>), %% Overlong tag. - {error,{asn1,{invalid_tag,_}}} = - (catch 'Constructed':decode('I', <<31,255,255,255,127>>)), + {invalid_tag,_} = dec_error('I', <<31,255,255,255,127>>), %% Invalid length. - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('I', <<8,255>>)), + {invalid_length,_} = dec_error('I', <<8,255>>), %% Other errors. - {error,{asn1,{invalid_value,_}}} = - (catch 'Constructed':decode('I', <<>>)), + {invalid_value,_} = dec_error('I', <<>>), - {error,{asn1,{invalid_value,_}}} = - (catch 'Constructed':decode('I', <<8,7>>)), + {invalid_value,_} = dec_error('I', <<8,7>>), %% Short indefinite length. Make sure that the decoder doesn't look %% beyond the end of binary when looking for a 0,0 terminator. - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('S', sub(<<8,16#80,0,0>>, 3))), - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('S', sub(<<8,16#80,0,0>>, 2))), - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('S', sub(<<40,16#80,1,1,255,0,0>>, 6))), - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('S', sub(<<40,16#80,1,1,255,0,0>>, 5))), + {invalid_length,_} = dec_error('S', sub(<<8,16#80,0,0>>, 3)), + {invalid_length,_} = dec_error('S', sub(<<8,16#80,0,0>>, 2)), + {invalid_length,_} = dec_error('S', sub(<<40,16#80,1,1,255,0,0>>, 6)), + {invalid_length,_} = dec_error('S', sub(<<40,16#80,1,1,255,0,0>>, 5)), %% A primitive must not be encoded with an indefinite length. - {error,{asn1,{invalid_length,_}}} = - (catch 'Constructed':decode('OS', <<4,128,4,3,97,98,99,0,0>>)), + {invalid_length,_} = dec_error('OS', <<4,128,4,3,97,98,99,0,0>>), ok. +dec_error(T, Bin) -> + {error,{asn1,{Reason,Stk}}} = 'Constructed':decode(T, Bin), + [{_,_,_,_}|_] = Stk, + Reason. + sub(Bin, Bytes) -> <<B:Bytes/binary,_/binary>> = Bin, B. diff --git a/lib/asn1/test/testChoPrim.erl b/lib/asn1/test/testChoPrim.erl index 573c482f2b..61b6ab2d05 100644 --- a/lib/asn1/test/testChoPrim.erl +++ b/lib/asn1/test/testChoPrim.erl @@ -31,10 +31,10 @@ bool(Rules) -> roundtrip('ChoCon', {int2,233}), case Rules of ber -> - {error,{asn1,{invalid_choice_type,wrong}}} = - (catch 'ChoPrim':encode('ChoCon', {wrong,233})), - {error,{asn1,{invalid_choice_tag,_WrongTag}}} = - (catch 'ChoPrim':decode('ChoCon', <<131,2,0,233>>)); + {error,{asn1,{{invalid_choice_type,wrong},[_|_]}}} = + (catch 'ChoPrim':encode('ChoCon', {wrong,233})), + {error,{asn1,{{invalid_choice_tag,_WrongTag},[_|_]}}} = + (catch 'ChoPrim':decode('ChoCon', <<131,2,0,233>>)); per -> ok; uper -> diff --git a/lib/asn1/test/testInfObjectClass.erl b/lib/asn1/test/testInfObjectClass.erl index 560986fac9..540407fa51 100644 --- a/lib/asn1/test/testInfObjectClass.erl +++ b/lib/asn1/test/testInfObjectClass.erl @@ -33,19 +33,29 @@ main(Rule) -> roundtrip('Seq', Val), %% OTP-5783 - {error,{asn1,{'Type not compatible with table constraint', - {component,'ArgumentType'}, - {value,_},_}}} = 'InfClass':encode('Seq', {'Seq',12,13,1}), + {'Type not compatible with table constraint', + {component,'ArgumentType'}, + {value,_},_} = enc_error('Seq', {'Seq',12,13,1}), Bytes2 = case Rule of ber -> <<48,9,2,1,12,2,1,11,2,1,1>>; _ -> <<1,12,1,11,1,1>> end, - {error,{asn1,{'Type not compatible with table constraint', - {{component,_}, - {value,_B},_}}}} = 'InfClass':decode('Seq', Bytes2), + {'Type not compatible with table constraint', + {{component,_}, + {value,_B},_}} = dec_error('Seq', Bytes2), ok. roundtrip(T, V) -> asn1_test_lib:roundtrip('InfClass', T, V). + +enc_error(T, V) -> + {error,{asn1,{Reason,Stk}}} = 'InfClass':encode(T, V), + [{_,_,_,_}|_] = Stk, + Reason. + +dec_error(T, Bin) -> + {error,{asn1,{Reason,Stk}}} = 'InfClass':decode(T, Bin), + [{_,_,_,_}|_] = Stk, + Reason. diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 96a2dd6c79..b2933dfabc 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -34,15 +34,12 @@ bool(Rules) -> Types = ['Bool','BoolCon','BoolPri','BoolApp', 'BoolExpCon','BoolExpPri','BoolExpApp'], [roundtrip(T, V) || T <- Types, V <- [true,false]], - case Rules of - ber -> - [begin - {error,{asn1,{encode_boolean,517}}} = enc_error(T, 517) - end || T <- Types], - ok; - _ -> - ok - end. + Tag = case Rules of + ber -> encode_boolean; + _ -> illegal_boolean + end, + [{Tag,517} = enc_error(T, 517) || T <- Types], + ok. int(Rules) -> @@ -60,10 +57,22 @@ int(Rules) -> 123456789,12345678901234567890, -1,-2,-3,-4,-100,-127,-255,-256,-257, -1234567890,-2147483648], - [roundtrip(T, V) || - T <- ['Int','IntCon','IntPri','IntApp', - 'IntExpCon','IntExpPri','IntExpApp'], - V <- [1|Values]], + Types = ['Int','IntCon','IntPri','IntApp', + 'IntExpCon','IntExpPri','IntExpApp'], + _ = [roundtrip(T, V) || T <- Types, V <- [1|Values]], + Tag = case Rules of + ber -> encode_integer; + _ -> illegal_integer + end, + _ = [{Tag,V} = enc_error(T, V) || + T <- Types, V <- [atom,42.0,{a,b,c}]], + case Rules of + ber -> + ok; + _ -> + _ = [{Tag,V} = enc_error('IntConstrained', V) || + V <- [atom,-1,256,42.0]] + end, %%========================================================== %% IntEnum ::= INTEGER {first(1),last(31)} @@ -119,7 +128,11 @@ enum(Rules) -> roundtrip('Enum', monday), roundtrip('Enum', thursday), - {error,{asn1,{_,4}}} = enc_error('Enum', 4), + Tag = case Rules of + ber -> enumerated_not_in_range; + _ -> illegal_enumerated + end, + {Tag,4} = enc_error('Enum', 4), case Rules of Per when Per =:= per; Per =:= uper -> @@ -182,13 +195,15 @@ roundtrip(Type, Value, ExpectedValue) -> enc_error(T, V) -> case get(no_ok_wrapper) of false -> - 'Prim':encode(T, V); + {error,{asn1,{Reason,Stk}}} = 'Prim':encode(T, V), + [{_,_,_,_}|_] = Stk, + Reason; true -> try 'Prim':encode(T, V) of _ -> ?t:fail() catch - _:Reason -> + _:{error,{asn1,Reason}} -> Reason end end. diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 48ffe653e4..d407a0a53f 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -224,7 +224,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:end_per_suite-1"><c>end_per_suite/1</c></seealso> + must also be defined.</p> <p>This configuration function is called as the first function in the suite. It typically contains initializations that are common for @@ -256,7 +258,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:init_per_suite-1"><c>init_per_suite/1</c></seealso> + must also be defined.</p> <p>This function is called as the last test case in the suite. It is meant to be used for cleaning up after @@ -360,7 +364,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:end_per_group-2"><c>end_per_group/2</c></seealso> + must also be defined.</p> <p>This configuration function is called before execution of a test case group. It typically contains initializations that are @@ -396,7 +402,9 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, then <seealso + marker="#Module:init_per_group-2"><c>init_per_group/2</c></seealso> + must also be defined.</p> <p>This function is called after the execution of a test case group is finished. It is meant to be used for cleaning up after @@ -427,7 +435,10 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, + then <seealso marker="#Module:end_per_testcase-2"> + <c>end_per_testcase/2</c></seealso> must also be + defined.</p> <p>This function is called before each test case. Argument <c>TestCase</c> is the test case name, and @@ -454,7 +465,10 @@ </type> <desc> - <p>OPTIONAL</p> + <p>OPTIONAL; if this function is defined, + then <seealso marker="#Module:init_per_testcase-2"> + <c>init_per_testcase/2</c></seealso> must also be + defined.</p> <p>This function is called after each test case, and can be used to clean up after diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index c2cf29c530..a085f30262 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -208,9 +208,10 @@ </func> <func> - <name>Module:pre_init_per_group(GroupName, InitData, CTHState) -> Result</name> + <name>Module:pre_init_per_group(SuiteName, GroupName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>InitData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -231,13 +232,19 @@ but for function <seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso> instead.</p> + + <p>If <c>Module:pre_init_per_group/4</c> is not exported, common_test + will attempt to call <c>Module:pre_init_per_group(GroupName, + InitData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_init_per_group(GroupName, Config, Return, CTHState) -> Result</name> + <name>Module:post_init_per_group(SuiteName, GroupName, Config, Return, CTHState) -> Result</name> <fsummary>Called after init_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -258,13 +265,19 @@ but for function <seealso marker="common_test#Module:init_per_group-2"><c>init_per_group</c></seealso> instead.</p> + + <p>If <c>Module:post_init_per_group/5</c> is not exported, common_test + will attempt to call <c>Module:post_init_per_group(GroupName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_init_per_testcase(TestcaseName, InitData, CTHState) -> Result</name> + <name>Module:pre_init_per_testcase(SuiteName, TestcaseName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>InitData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -286,6 +299,11 @@ <seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso> instead.</p> + <p>If <c>Module:pre_init_per_testcase/4</c> is not exported, common_test + will attempt to call <c>Module:pre_init_per_testcase(TestcaseName, + InitData, CTHState)</c> instead. This is for backwards + compatibility.</p> + <p>CTHs cannot be added here right now. That feature may be added in a later release, but it would right now break backwards compatibility.</p> @@ -293,9 +311,10 @@ </func> <func> - <name>Module:post_init_per_testcase(TestcaseName, Config, Return, CTHState) -> Result</name> + <name>Module:post_init_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -> Result</name> <fsummary>Called after init_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -316,15 +335,21 @@ but for function <seealso marker="common_test#Module:init_per_testcase-2"><c>init_per_testcase</c></seealso> instead.</p> + + <p>If <c>Module:post_init_per_testcase/5</c> is not exported, common_test + will attempt to call <c>Module:post_init_per_testcase(TestcaseName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_end_per_testcase(TestcaseName, InitData, CTHState) -> Result</name> + <name>Module:pre_end_per_testcase(SuiteName, TestcaseName, EndData, CTHState) -> Result</name> <fsummary>Called before end_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> - <v>InitData = Config</v> + <v>EndData = Config</v> <v>Config = NewConfig = [{Key,Value}]</v> <v>CTHState = NewCTHState = term()</v> <v>Result = {NewConfig, NewCTHState}</v> @@ -345,14 +370,20 @@ <p>This function can not change the result of the test case by returning skip or fail tuples, but it may insert items in <c>Config</c> that can be read in - <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/4</c>.</p> + <c>end_per_testcase/2</c> or in <c>post_end_per_testcase/5</c>.</p> + + <p>If <c>Module:pre_end_per_testcase/4</c> is not exported, common_test + will attempt to call <c>Module:pre_end_per_testcase(TestcaseName, + EndData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_end_per_testcase(TestcaseName, Config, Return, CTHState) -> Result</name> + <name>Module:post_end_per_testcase(SuiteName, TestcaseName, Config, Return, CTHState) -> Result</name> <fsummary>Called after end_per_testcase.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestcaseName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -373,13 +404,19 @@ but for function <seealso marker="common_test#Module:end_per_testcase-2"><c>end_per_testcase</c></seealso> instead.</p> + + <p>If <c>Module:post_end_per_testcase/5</c> is not exported, common_test + will attempt to call <c>Module:post_end_per_testcase(TestcaseName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:pre_end_per_group(GroupName, EndData, CTHState) -> Result</name> + <name>Module:pre_end_per_group(SuiteName, GroupName, EndData, CTHState) -> Result</name> <fsummary>Called before end_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>EndData = Config | SkipOrFail</v> <v>Config = NewConfig = [{Key,Value}]</v> @@ -400,13 +437,19 @@ but for function <seealso marker="common_test#Module:end_per_group-2"><c>end_per_group</c></seealso> instead.</p> + + <p>If <c>Module:pre_end_per_group/4</c> is not exported, common_test + will attempt to call <c>Module:pre_end_per_group(GroupName, + EndData, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:post_end_per_group(GroupName, Config, Return, CTHState) -> Result</name> + <name>Module:post_end_per_group(SuiteName, GroupName, Config, Return, CTHState) -> Result</name> <fsummary>Called after end_per_group.</fsummary> <type> + <v>SuiteName = atom()</v> <v>GroupName = atom()</v> <v>Config = [{Key,Value}]</v> <v>Return = NewReturn = Config | SkipOrFail | term()</v> @@ -427,6 +470,11 @@ but for function <seealso marker="common_test#Module:end_per_group-2">end_per_group</seealso> instead.</p> + + <p>If <c>Module:post_end_per_group/5</c> is not exported, common_test + will attempt to call <c>Module:post_end_per_group(GroupName, + Config, Return, CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> @@ -485,9 +533,10 @@ </func> <func> - <name>Module:on_tc_fail(TestName, Reason, CTHState) -> NewCTHState</name> + <name>Module:on_tc_fail(SuiteName, TestName, Reason, CTHState) -> NewCTHState</name> <fsummary>Called after the CTH scope ends.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v> <v>FuncName = atom()</v> <v>GroupName = atom()</v> @@ -505,7 +554,7 @@ <item><p>If <c>init_per_suite</c> fails, this function is called after <seealso marker="#Module:post_init_per_suite-4"><c>post_init_per_suite</c></seealso>.</p></item> <item><p>If a test case fails, this funcion is called after - <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item> + <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item> </list> <p>If the failed test case belongs to a test case group, the first @@ -519,13 +568,19 @@ For details, see section <seealso marker="event_handler_chapter#events">Event Handling</seealso> in the User's Guide.</p> + + <p>If <c>Module:on_tc_fail/4</c> is not exported, common_test + will attempt to call <c>Module:on_tc_fail(TestName, Reason, + CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> <func> - <name>Module:on_tc_skip(TestName, Reason, CTHState) -> NewCTHState</name> + <name>Module:on_tc_skip(SuiteName, TestName, Reason, CTHState) -> NewCTHState</name> <fsummary>Called after the CTH scope ends.</fsummary> <type> + <v>SuiteName = atom()</v> <v>TestName = init_per_suite | end_per_suite | {init_per_group,GroupName} | {end_per_group,GroupName} | {FuncName,GroupName} | FuncName</v> <v>FuncName = atom()</v> <v>GroupName = atom()</v> @@ -542,9 +597,9 @@ <list type="bulleted"> <item><p>If <c>init_per_group</c> is skipped, this function is called after - <seealso marker="#Module:post_init_per_group-4"><c>post_init_per_group</c></seealso>.</p></item> + <seealso marker="#Module:post_init_per_group-5"><c>post_init_per_group</c></seealso>.</p></item> <item><p>If a test case is skipped, this function is called after - <seealso marker="#Module:post_end_per_testcase-4"><c>post_end_per_testcase</c></seealso>.</p></item> + <seealso marker="#Module:post_end_per_testcase-5"><c>post_end_per_testcase</c></seealso>.</p></item> </list> <p>If the skipped test case belongs to a test case group, the first @@ -559,6 +614,11 @@ For details, see section <seealso marker="event_handler_chapter#events">Event Handling</seealso> in the User's Guide.</p> + + <p>If <c>Module:on_tc_skip/4</c> is not exported, common_test + will attempt to call <c>Module:on_tc_skip(TestName, Reason, + CTHState)</c> instead. This is for backwards + compatibility.</p> </desc> </func> diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index 0e4c35e11f..bfad96e489 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -38,7 +38,7 @@ extensions of the default behavior of <c>Common Test</c> using hooks before and after all test suite calls. CTHs allow advanced <c>Common Test</c> users to abstract out behavior that is common to multiple test suites - without littering all test suites with library calls. this can be used + without littering all test suites with library calls. This can be used for logging, starting, and monitoring external systems, building C files needed by the tests, and so on.</p> @@ -175,10 +175,10 @@ <row> <cell><seealso marker="common_test#Module:init_per_group-2"> init_per_group/2</seealso></cell> - <cell><seealso marker="ct_hooks#Module:post_init_per_group-4"> - post_init_per_group/4</seealso> is called</cell> - <cell><seealso marker="ct_hooks#Module:post_end_per_suite-4"> - post_end_per_group/4</seealso> has been called for that group</cell> + <cell><seealso marker="ct_hooks#Module:post_init_per_group-5"> + post_init_per_group/5</seealso> is called</cell> + <cell><seealso marker="ct_hooks#Module:post_end_per_group-5"> + post_end_per_group/5</seealso> has been called for that group</cell> </row> <tcaption>Scope of a CTH</tcaption> </table> @@ -245,16 +245,18 @@ </list> <p> - This is done in the CTH functions called pre_<name of function>. - These functions take the same three arguments, <c>Name</c>, + This is done in the CTH functions called <c>pre_<name of function></c>. + These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable), <c>Config</c>, and <c>CTHState</c>. The return value of the CTH function is always a combination of a result for the suite/group/test and an updated <c>CTHState</c>.</p> <p>To let the test suite continue on executing, return the configuration - list that you want the test to use as the result. To skip or - fail the test, return a tuple with <c>skip</c> or <c>fail</c>, and a reason - as the result.</p> + list that you want the test to use as the result.</p> + + <p>All pre hooks, except <c>pre_end_per_testcase/4</c>, can + skip or fail the test by returning a tuple with <c>skip</c> or + <c>fail</c>, and a reason as the result.</p> <p><em>Example:</em></p> <code> @@ -290,7 +292,7 @@ <p> This is done in the CTH functions called <c>post_<name of function></c>. - These functions take the same four arguments, <c>Name</c>, + These functions take the arguments <c>SuiteName</c>, <c>Name</c> (group or test case name, if applicable), <c>Config</c>, <c>Return</c>, and <c>CTHState</c>. <c>Config</c> in this case is the same <c>Config</c> as the testcase is called with. <c>Return</c> is the value returned by the testcase. If the testcase @@ -308,7 +310,7 @@ <p><em>Example:</em></p> <code> - post_end_per_testcase(_TC, Config, {'EXIT',{_,_}}, CTHState) -> + post_end_per_testcase(_Suite, _TC, Config, {'EXIT',{_,_}}, CTHState) -> case db:check_consistency() of true -> %% DB is good, pass the test. @@ -317,7 +319,7 @@ %% DB is not good, mark as skipped instead of failing {{skip, "DB is inconsisten!"}, CTHState} end; - post_end_per_testcase(_TC, Config, Return, CTHState) -> + post_end_per_testcase(_Suite, _TC, Config, Return, CTHState) -> %% Do nothing if tc does not crash. {Return, CTHState}.</code> @@ -331,8 +333,8 @@ <title>Skip and Fail Hooks</title> <p> After any post hook has been executed for all installed CTHs, - <seealso marker="ct_hooks#Module:on_tc_fail-3">on_tc_fail</seealso> - or <seealso marker="ct_hooks#Module:on_tc_skip-3">on_tc_skip</seealso> + <seealso marker="ct_hooks#Module:on_tc_fail-4">on_tc_fail</seealso> + or <seealso marker="ct_hooks#Module:on_tc_skip-4">on_tc_skip</seealso> is called if the testcase failed or was skipped, respectively. You cannot affect the outcome of the tests any further at this point. </p> @@ -389,18 +391,18 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). - -export([pre_init_per_group/3]). - -export([post_init_per_group/4]). - -export([pre_end_per_group/3]). - -export([post_end_per_group/4]). + -export([pre_init_per_group/4]). + -export([post_init_per_group/5]). + -export([pre_end_per_group/4]). + -export([post_end_per_group/5]). - -export([pre_init_per_testcase/3]). - -export([post_init_per_testcase/4]). - -export([pre_end_per_testcase/3]). - -export([post_end_per_testcase/4]). + -export([pre_init_per_testcase/4]). + -export([post_init_per_testcase/5]). + -export([pre_end_per_testcase/4]). + -export([post_end_per_testcase/5]). - -export([on_tc_fail/3]). - -export([on_tc_skip/3]). + -export([on_tc_fail/4]). + -export([on_tc_skip/4]). -export([terminate/1]). @@ -435,46 +437,46 @@ total = State#state.total + State#state.suite_total } }. %% @doc Called before each init_per_group. - pre_init_per_group(Group,Config,State) -> + pre_init_per_group(Suite,Group,Config,State) -> {Config, State}. %% @doc Called after each init_per_group. - post_init_per_group(Group,Config,Return,State) -> + post_init_per_group(Suite,Group,Config,Return,State) -> {Return, State}. %% @doc Called before each end_per_group. - pre_end_per_group(Group,Config,State) -> + pre_end_per_group(Suite,Group,Config,State) -> {Config, State}. %% @doc Called after each end_per_group. - post_end_per_group(Group,Config,Return,State) -> + post_end_per_group(Suite,Group,Config,Return,State) -> {Return, State}. %% @doc Called before each init_per_testcase. - pre_init_per_testcase(TC,Config,State) -> + pre_init_per_testcase(Suite,TC,Config,State) -> {Config, State#state{ ts = now(), total = State#state.suite_total + 1 } }. %% Called after each init_per_testcase (immediately before the test case). - post_init_per_testcase(TC,Config,Return,State) -> + post_init_per_testcase(Suite,TC,Config,Return,State) -> {Return, State} %% @doc Called before each end_per_testcase (immediately after the test case). - pre_end_per_testcase(TC,Config,State) -> + pre_end_per_testcase(Suite,TC,Config,State) -> {Config, State}. %% @doc Called after each end_per_testcase. - post_end_per_testcase(TC,Config,Return,State) -> - TCInfo = {testcase, TC, Return, timer:now_diff(now(), State#state.ts)}, + post_end_per_testcase(Suite,TC,Config,Return,State) -> + TCInfo = {testcase, Suite, TC, Return, timer:now_diff(now(), State#state.ts)}, {Return, State#state{ ts = undefined, tcs = [TCInfo | State#state.tcs] } }. %% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group, %% post_end_per_group and post_end_per_testcase if the suite, group or test case failed. - on_tc_fail(TC, Reason, State) -> + on_tc_fail(Suite, TC, Reason, State) -> State. %% @doc Called when a test case is skipped by either user action %% or due to an init function failing. - on_tc_skip(TC, Reason, State) -> + on_tc_skip(Suite, TC, Reason, State) -> State. %% @doc Called when the scope of the CTH is done diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index f70bdb16c5..6a0d87bcaf 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -566,7 +566,7 @@ for the test cases in the group. After execution of the group is finished, function <seealso marker="common_test#Module:end_per_group-2"><c>end_per_group(GroupName, Config)</c></seealso> is called. This function is meant to be used for cleaning up after - <c>init_per_group/2</c>.</p> + <c>init_per_group/2</c>. If the init function is defined, so must the end function be.</p> <p>Whenever a group is executed, if <c>init_per_group</c> and <c>end_per_group</c> do not exist in the suite, <c>Common Test</c> calls diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 291a4d716c..43f1c9de0f 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -52,6 +52,10 @@ %%% %%% @doc Test server framework callback, called by the test_server %%% when a new test case is started. +init_tc(_,{end_per_testcase_not_run,_},[Config]) -> + %% Testcase is completed (skipped or failed), but end_per_testcase + %% is not run - don't call pre-hook. + {ok,[Config]}; init_tc(Mod,EPTC={end_per_testcase,_},[Config]) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Config), @@ -62,7 +66,7 @@ init_tc(Mod,EPTC={end_per_testcase,_},[Config]) -> Other end; -init_tc(Mod,Func0,Args) -> +init_tc(Mod,Func0,Args) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), {Func,HookFunc} = case Func0 of @@ -84,12 +88,15 @@ init_tc(Mod,Func0,Args) -> andalso Func=/=end_per_group andalso ct_util:get_testdata(skip_rest) of true -> + initialize(false,Mod,Func,Args), {auto_skip,"Repeated test stopped by force_stop option"}; _ -> case ct_util:get_testdata(curr_tc) of {Suite,{suite0_failed,{require,Reason}}} -> + initialize(false,Mod,Func,Args), {auto_skip,{require_failed_in_suite0,Reason}}; {Suite,{suite0_failed,_}=Failure} -> + initialize(false,Mod,Func,Args), {fail,Failure}; _ -> ct_util:update_testdata(curr_tc, @@ -118,16 +125,14 @@ init_tc(Mod,Func0,Args) -> end, init_tc1(Mod,Suite,Func,HookFunc,Args); {failed,Seq,BadFunc} -> - {auto_skip,{sequence_failed,Seq,BadFunc}} + initialize(false,Mod,Func,Args), + {auto_skip,{sequence_failed,Seq,BadFunc}} end end end. init_tc1(?MODULE,_,error_in_suite,_,[Config0]) when is_list(Config0) -> - ct_logs:init_tc(false), - ct_event:notify(#event{name=tc_start, - node=node(), - data={?MODULE,error_in_suite}}), + initialize(false,?MODULE,error_in_suite), _ = ct_suite_init(?MODULE,error_in_suite,[],Config0), case ?val(error,Config0) of undefined -> @@ -177,27 +182,21 @@ init_tc1(Mod,Suite,Func,HookFunc,[Config0]) when is_list(Config0) -> ct_config:delete_default_config(testcase), HookFunc end, - Initialize = fun() -> - ct_logs:init_tc(false), - ct_event:notify(#event{name=tc_start, - node=node(), - data={Mod,FuncSpec}}) - end, case add_defaults(Mod,Func,AllGroups) of Error = {suite0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), ct_util:set_testdata({curr_tc,{Suite,Error}}), {error,Error}; Error = {group0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), {auto_skip,Error}; Error = {testcase0_failed,_} -> - Initialize(), + initialize(false,Mod,FuncSpec), {auto_skip,Error}; {SuiteInfo,MergeResult} -> case MergeResult of {error,Reason} -> - Initialize(), + initialize(false,Mod,FuncSpec), {fail,Reason}; _ -> init_tc2(Mod,Suite,Func,HookFunc1, @@ -236,11 +235,8 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) -> Conns -> ct_util:silence_connections(Conns) end, - ct_logs:init_tc(Func == init_per_suite), FuncSpec = group_or_func(Func,Config), - ct_event:notify(#event{name=tc_start, - node=node(), - data={Mod,FuncSpec}}), + initialize((Func==init_per_suite),Mod,FuncSpec), case catch configure(MergedInfo,MergedInfo,SuiteInfo, FuncSpec,[],Config) of @@ -268,6 +264,18 @@ init_tc2(Mod,Suite,Func,HookFunc,SuiteInfo,MergeResult,Config) -> end end. +initialize(RefreshLogs,Mod,Func,[Config]) when is_list(Config) -> + initialize(RefreshLogs,Mod,group_or_func(Func,Config)); +initialize(RefreshLogs,Mod,Func,_) -> + initialize(RefreshLogs,Mod,Func). + +initialize(RefreshLogs,Mod,FuncSpec) -> + ct_logs:init_tc(RefreshLogs), + ct_event:notify(#event{name=tc_start, + node=node(), + data={Mod,FuncSpec}}). + + ct_suite_init(Suite,HookFunc,PostInitHook,Config) when is_list(Config) -> case ct_hooks:init_tc(Suite,HookFunc,Config) of NewConfig when is_list(NewConfig) -> @@ -675,22 +683,35 @@ end_tc(Mod,Func,{Result,[Args]}, Return) -> end_tc(Mod,Func,self(),Result,Args,Return). end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) -> - %% in case Mod == ct_framework, lookup the suite name - Suite = get_suite_name(Mod, Args), - case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of - '$ct_no_change' -> - ok; - HookResult -> - HookResult + case end_hook_func(IPTC,Return,IPTC) of + undefined -> ok; + _ -> + %% in case Mod == ct_framework, lookup the suite name + Suite = get_suite_name(Mod, Args), + case ct_hooks:end_tc(Suite,IPTC,Args,Result,Return) of + '$ct_no_change' -> + ok; + HookResult -> + HookResult + end end; end_tc(Mod,Func0,TCPid,Result,Args,Return) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), - {EPTC,Func} = case Func0 of - {end_per_testcase,F} -> {true,F}; - _ -> {false,Func0} - end, + {Func,FuncSpec,HookFunc} = + case Func0 of + {end_per_testcase_not_run,F} -> + %% Testcase is completed (skipped or failed), but + %% end_per_testcase is not run - don't call post-hook. + {F,F,undefined}; + {end_per_testcase,F} -> + {F,F,Func0}; + _ -> + FS = group_or_func(Func0,Args), + HF = end_hook_func(Func0,Return,FS), + {Func0,FS,HF} + end, test_server:timetrap_cancel(), @@ -717,20 +738,18 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, ct_util:delete_suite_data(last_saved_config), - {FuncSpec,HookFunc} = - if not EPTC -> - FS = group_or_func(Func,Args), - {FS,FS}; - true -> - {Func,Func0} - end, {Result1,FinalNotify} = - case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of - '$ct_no_change' -> - {ok,Result}; - HookResult -> - {HookResult,HookResult} - end, + case HookFunc of + undefined -> + {ok,Result}; + _ -> + case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of + '$ct_no_change' -> + {ok,Result}; + HookResult -> + {HookResult,HookResult} + end + end, FinalResult = case get('$test_server_framework_test') of undefined -> @@ -821,6 +840,34 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, FinalResult. +%% This is to make sure that no post_init_per_* is ever called if the +%% corresponding pre_init_per_* was not called. +%% The skip or fail reasons are those that can be returned from +%% init_tc above in situations where we never came to call +%% ct_hooks:init_tc/3, e.g. if suite/0 fails, then we never call +%% ct_hooks:init_tc for init_per_suite, and thus we must not call +%% ct_hooks:end_tc for init_per_suite either. +end_hook_func({init_per_testcase,_},{auto_skip,{sequence_failed,_,_}},_) -> + undefined; +end_hook_func({init_per_testcase,_},{auto_skip,"Repeated test stopped by force_stop option"},_) -> + undefined; +end_hook_func({init_per_testcase,_},{fail,{config_name_already_in_use,_}},_) -> + undefined; +end_hook_func({init_per_testcase,_},{auto_skip,{InfoFuncError,_}},_) + when InfoFuncError==testcase0_failed; + InfoFuncError==require_failed -> + undefined; +end_hook_func(init_per_group,{auto_skip,{InfoFuncError,_}},_) + when InfoFuncError==group0_failed; + InfoFuncError==require_failed -> + undefined; +end_hook_func(init_per_suite,{auto_skip,{require_failed_in_suite0,_}},_) -> + undefined; +end_hook_func(init_per_suite,{auto_skip,{failed,{error,{suite0_failed,_}}}},_) -> + undefined; +end_hook_func(_,_,Default) -> + Default. + %% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | %% {testcase_aborted,Reason} | testcase_aborted_or_killed | %% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} | @@ -1339,25 +1386,25 @@ report(What,Data) -> ok; tc_done -> {Suite,{Func,GrName},Result} = Data, - Data1 = if GrName == undefined -> {Suite,Func,Result}; - true -> Data - end, + FuncSpec = if GrName == undefined -> Func; + true -> {Func,GrName} + end, %% Register the group leader for the process calling the report %% function, making it possible for a hook function to print %% in the test case log file ReportingPid = self(), ct_logs:register_groupleader(ReportingPid, group_leader()), case Result of - {failed, _} -> - ct_hooks:on_tc_fail(What, Data1); - {skipped,{failed,{_,init_per_testcase,_}}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); - {skipped,{require_failed,_}} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); - {skipped,_} -> - ct_hooks:on_tc_skip(tc_user_skip, Data1); - {auto_skipped,_} -> - ct_hooks:on_tc_skip(tc_auto_skip, Data1); + {failed, Reason} -> + ct_hooks:on_tc_fail(What, {Suite,FuncSpec,Reason}); + {skipped,{failed,{_,init_per_testcase,_}}=Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); + {skipped,{require_failed,_}=Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); + {skipped,Reason} -> + ct_hooks:on_tc_skip(tc_user_skip, {Suite,FuncSpec,Reason}); + {auto_skipped,Reason} -> + ct_hooks:on_tc_skip(tc_auto_skip, {Suite,FuncSpec,Reason}); _Else -> ok end, diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index 1375e7dcc7..1c9faf6a70 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -442,17 +442,21 @@ make_conf(Mod, Name, Props, TestSpec) -> ok end, {InitConf,EndConf,ExtraProps} = - case erlang:function_exported(Mod,init_per_group,2) of - true -> - {{Mod,init_per_group},{Mod,end_per_group},[]}; - false -> + case {erlang:function_exported(Mod,init_per_group,2), + erlang:function_exported(Mod,end_per_group,2)} of + {false,false} -> ct_logs:log("TEST INFO", "init_per_group/2 and " "end_per_group/2 missing for group " "~w in ~w, using default.", [Name,Mod]), {{ct_framework,init_per_group}, {ct_framework,end_per_group}, - [{suite,Mod}]} + [{suite,Mod}]}; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + {{Mod,init_per_group},{Mod,end_per_group},[]} end, {conf,[{name,Name}|Props++ExtraProps],InitConf,TestSpec,EndConf}. diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index c9a4abb5ee..60d1ea2b1c 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -92,15 +92,17 @@ init_tc(Mod, end_per_suite, Config) -> call(fun call_generic/3, Config, [pre_end_per_suite, Mod]); init_tc(Mod, {init_per_group, GroupName, Properties}, Config) -> maybe_start_locker(Mod, GroupName, Properties), - call(fun call_generic/3, Config, [pre_init_per_group, GroupName]); -init_tc(_Mod, {end_per_group, GroupName, _}, Config) -> - call(fun call_generic/3, Config, [pre_end_per_group, GroupName]); -init_tc(_Mod, {init_per_testcase,TC}, Config) -> - call(fun call_generic/3, Config, [pre_init_per_testcase, TC]); -init_tc(_Mod, {end_per_testcase,TC}, Config) -> - call(fun call_generic/3, Config, [pre_end_per_testcase, TC]); -init_tc(_Mod, TC = error_in_suite, Config) -> - call(fun call_generic/3, Config, [pre_init_per_testcase, TC]). + call(fun call_generic_fallback/3, Config, + [pre_init_per_group, Mod, GroupName]); +init_tc(Mod, {end_per_group, GroupName, _}, Config) -> + call(fun call_generic_fallback/3, Config, + [pre_end_per_group, Mod, GroupName]); +init_tc(Mod, {init_per_testcase,TC}, Config) -> + call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]); +init_tc(Mod, {end_per_testcase,TC}, Config) -> + call(fun call_generic_fallback/3, Config, [pre_end_per_testcase, Mod, TC]); +init_tc(Mod, TC = error_in_suite, Config) -> + call(fun call_generic_fallback/3, Config, [pre_init_per_testcase, Mod, TC]). %% @doc Called as each test case is completed. This includes all configuration %% tests. @@ -126,23 +128,23 @@ end_tc(Mod, init_per_suite, Config, _Result, Return) -> end_tc(Mod, end_per_suite, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_suite, Mod, Config], '$ct_no_change'); -end_tc(_Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> - call(fun call_generic/3, Return, [post_init_per_group, GroupName, Config], - '$ct_no_change'); +end_tc(Mod, {init_per_group, GroupName, _}, Config, _Result, Return) -> + call(fun call_generic_fallback/3, Return, + [post_init_per_group, Mod, GroupName, Config], '$ct_no_change'); end_tc(Mod, {end_per_group, GroupName, Properties}, Config, Result, _Return) -> - Res = call(fun call_generic/3, Result, - [post_end_per_group, GroupName, Config], '$ct_no_change'), + Res = call(fun call_generic_fallback/3, Result, + [post_end_per_group, Mod, GroupName, Config], '$ct_no_change'), maybe_stop_locker(Mod, GroupName, Properties), Res; -end_tc(_Mod, {init_per_testcase,TC}, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_init_per_testcase, TC, Config], - '$ct_no_change'); -end_tc(_Mod, {end_per_testcase,TC}, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], - '$ct_no_change'); -end_tc(_Mod, TC = error_in_suite, Config, Result, _Return) -> - call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], - '$ct_no_change'). +end_tc(Mod, {init_per_testcase,TC}, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_init_per_testcase, Mod, TC, Config], '$ct_no_change'); +end_tc(Mod, {end_per_testcase,TC}, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_end_per_testcase, Mod, TC, Config], '$ct_no_change'); +end_tc(Mod, TC = error_in_suite, Config, Result, _Return) -> + call(fun call_generic_fallback/3, Result, + [post_end_per_testcase, Mod, TC, Config], '$ct_no_change'). %% Case = TestCase | {TestCase,GroupName} @@ -181,15 +183,21 @@ call_terminate(#ct_hook_config{ module = Mod, state = State} = Hook, _, _) -> {[],Hook}. call_cleanup(#ct_hook_config{ module = Mod, state = State} = Hook, - Reason, [Function, _Suite | Args]) -> + Reason, [Function | Args]) -> NewState = catch_apply(Mod,Function, Args ++ [Reason, State], - State), + State, true), {Reason, Hook#ct_hook_config{ state = NewState } }. -call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, - Value, [Function | Args]) -> +call_generic(Hook, Value, Meta) -> + do_call_generic(Hook, Value, Meta, false). + +call_generic_fallback(Hook, Value, Meta) -> + do_call_generic(Hook, Value, Meta, true). + +do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, + Value, [Function | Args], Fallback) -> {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], - {Value,State}), + {Value,State}, Fallback), {NewValue, Hook#ct_hook_config{ state = NewState } }. %% Generic call function @@ -257,15 +265,15 @@ remove(Key,List) when is_list(List) -> remove(_, Else) -> Else. -%% Translate scopes, i.e. init_per_group,group1 -> end_per_group,group1 etc -scope([pre_init_per_testcase, TC|_]) -> - [post_init_per_testcase, TC]; -scope([pre_end_per_testcase, TC|_]) -> - [post_end_per_testcase, TC]; -scope([pre_init_per_group, GroupName|_]) -> - [post_end_per_group, GroupName]; -scope([post_init_per_group, GroupName|_]) -> - [post_end_per_group, GroupName]; +%% Translate scopes, i.e. is_tuplenit_per_group,group1 -> end_per_group,group1 etc +scope([pre_init_per_testcase, SuiteName, TC|_]) -> + [post_init_per_testcase, SuiteName, TC]; +scope([pre_end_per_testcase, SuiteName, TC|_]) -> + [post_end_per_testcase, SuiteName, TC]; +scope([pre_init_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; +scope([post_init_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; scope([pre_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; scope([post_init_per_suite, SuiteName|_]) -> @@ -273,14 +281,29 @@ scope([post_init_per_suite, SuiteName|_]) -> scope(init) -> none. -terminate_if_scope_ends(HookId, [on_tc_skip,_Suite,{end_per_group,Name}], +strip_config([post_init_per_testcase, SuiteName, TC|_]) -> + [post_init_per_testcase, SuiteName, TC]; +strip_config([post_end_per_testcase, SuiteName, TC|_]) -> + [post_end_per_testcase, SuiteName, TC]; +strip_config([post_init_per_group, SuiteName, GroupName|_]) -> + [post_init_per_group, SuiteName, GroupName]; +strip_config([post_end_per_group, SuiteName, GroupName|_]) -> + [post_end_per_group, SuiteName, GroupName]; +strip_config([post_init_per_suite, SuiteName|_]) -> + [post_init_per_suite, SuiteName]; +strip_config([post_end_per_suite, SuiteName|_]) -> + [post_end_per_suite, SuiteName]; +strip_config(Other) -> + Other. + + +terminate_if_scope_ends(HookId, [on_tc_skip,Suite,{end_per_group,Name}], Hooks) -> - terminate_if_scope_ends(HookId, [post_end_per_group, Name], Hooks); + terminate_if_scope_ends(HookId, [post_end_per_group, Suite, Name], Hooks); terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) -> terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks); -terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] -> - terminate_if_scope_ends(HookId,[Function,Tag],Hooks); -terminate_if_scope_ends(HookId, Function, Hooks) -> +terminate_if_scope_ends(HookId, Function0, Hooks) -> + Function = strip_config(Function0), case lists:keyfind(HookId, #ct_hook_config.id, Hooks) of #ct_hook_config{ id = HookId, scope = Function} = Hook -> terminate([Hook]), @@ -384,21 +407,29 @@ pos(Id,[_|Rest],Num) -> catch_apply(M,F,A, Default) -> + catch_apply(M,F,A,Default,false). +catch_apply(M,F,A, Default, Fallback) -> + not erlang:module_loaded(M) andalso (catch M:module_info()), + case erlang:function_exported(M,F,length(A)) of + false when Fallback -> + catch_apply(M,F,tl(A),Default,false); + false -> + Default; + true -> + catch_apply(M,F,A) + end. + +catch_apply(M,F,A) -> try - erlang:apply(M,F,A) + erlang:apply(M,F,A) catch _:Reason -> - case erlang:get_stacktrace() of - %% Return the default if it was the CTH module which did not have the function. - [{M,F,A,_}|_] when Reason == undef -> - Default; - Trace -> - ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p", - [error,{Reason,Trace}]), - throw({error_in_cth_call, - lists:flatten( - io_lib:format("~w:~w/~w CTH call failed", - [M,F,length(A)]))}) - end + Trace = erlang:get_stacktrace(), + ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p", + [error,{Reason,Trace}]), + throw({error_in_cth_call, + lists:flatten( + io_lib:format("~w:~w/~w CTH call failed", + [M,F,length(A)]))}) end. diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl index d783f8d04e..c53e72ee88 100644 --- a/lib/common_test/src/ct_release_test.erl +++ b/lib/common_test/src/ct_release_test.erl @@ -132,7 +132,7 @@ %%----------------------------------------------------------------- -define(testnode, 'ct_release_test-upgrade'). --define(exclude_apps, [hipe, typer, dialyzer]). % never include these apps +-define(exclude_apps, [hipe, dialyzer]). % never include these apps %%----------------------------------------------------------------- -record(ct_data, {from,to}). diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index a049ef5695..cac176de3a 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -76,8 +76,8 @@ abort_if_missing_suites, silent_connections = [], stylesheet, - multiply_timetraps = 1, - scale_timetraps = false, + multiply_timetraps, + scale_timetraps, create_priv_dir, testspec_files = [], current_testspec, @@ -264,11 +264,11 @@ script_start1(Parent, Args) -> [], Args), Verbosity = verbosity_args2opts(Args), MultTT = get_start_opt(multiply_timetraps, - fun([MT]) -> list_to_integer(MT) end, 1, Args), + fun([MT]) -> list_to_integer(MT) end, Args), ScaleTT = get_start_opt(scale_timetraps, fun([CT]) -> list_to_atom(CT); ([]) -> true - end, false, Args), + end, Args), CreatePrivDir = get_start_opt(create_priv_dir, fun([PD]) -> list_to_atom(PD); ([]) -> auto_per_tc @@ -1055,8 +1055,8 @@ run_test2(StartOpts) -> CoverStop = get_start_opt(cover_stop, value, StartOpts), %% timetrap manipulation - MultiplyTT = get_start_opt(multiply_timetraps, value, 1, StartOpts), - ScaleTT = get_start_opt(scale_timetraps, value, false, StartOpts), + MultiplyTT = get_start_opt(multiply_timetraps, value, StartOpts), + ScaleTT = get_start_opt(scale_timetraps, value, StartOpts), %% create unique priv dir names CreatePrivDir = get_start_opt(create_priv_dir, value, StartOpts), @@ -2280,8 +2280,19 @@ do_run_test(Tests, Skip, Opts0) -> _Lower -> ok end, - test_server_ctrl:multiply_timetraps(Opts0#opts.multiply_timetraps), - test_server_ctrl:scale_timetraps(Opts0#opts.scale_timetraps), + + case Opts0#opts.multiply_timetraps of + undefined -> MultTT = 1; + MultTT -> MultTT + end, + case Opts0#opts.scale_timetraps of + undefined -> ScaleTT = false; + ScaleTT -> ScaleTT + end, + ct_logs:log("TEST INFO","Timetrap time multiplier = ~w~n" + "Timetrap scaling enabled = ~w", [MultTT,ScaleTT]), + test_server_ctrl:multiply_timetraps(MultTT), + test_server_ctrl:scale_timetraps(ScaleTT), test_server_ctrl:create_priv_dir(choose_val( Opts0#opts.create_priv_dir, diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 16001ce4c8..466a2c7658 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1158,6 +1158,11 @@ handle_data(verbosity,Node,VLvls,_Spec) when is_list(VLvls) -> VLvls1 = lists:map(fun(VLvl = {_Cat,_Lvl}) -> VLvl; (Lvl) -> {'$unspecified',Lvl} end, VLvls), [{Node,VLvls1}]; +handle_data(multiply_timetraps,Node,Mult,_Spec) when is_integer(Mult) -> + [{Node,Mult}]; +handle_data(scale_timetraps,Node,Scale,_Spec) when Scale == true; + Scale == false -> + [{Node,Scale}]; handle_data(silent_connections,Node,all,_Spec) -> [{Node,[all]}]; handle_data(silent_connections,Node,Conn,_Spec) when is_atom(Conn) -> @@ -1176,6 +1181,8 @@ should_be_added(Tag,Node,_Data,Spec) -> Tag == label; Tag == auto_compile; Tag == abort_if_missing_suites; Tag == stylesheet; Tag == verbosity; + Tag == multiply_timetraps; + Tag == scale_timetraps; Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, read_field(Spec,Tag)) == false; diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index 883da0da0a..ce8852b3ea 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -54,8 +54,8 @@ -include_lib("common_test/include/ct.hrl"). -export([init/2, - pre_init_per_testcase/3, - post_end_per_testcase/4]). + pre_init_per_testcase/4, + post_end_per_testcase/5]). %%---------------------------------------------------------------------- %% Exported types @@ -104,7 +104,7 @@ get_log_opts(Mod,Opts) -> Hosts = proplists:get_value(hosts,Opts,[]), {LogType,Hosts}. -pre_init_per_testcase(TestCase,Config,CthState) -> +pre_init_per_testcase(_Suite,TestCase,Config,CthState) -> Logs = lists:map( fun({ConnMod,{LogType,Hosts}}) -> @@ -158,7 +158,7 @@ pre_init_per_testcase(TestCase,Config,CthState) -> ct_util:update_testdata(?MODULE, Update, [create]), {Config,CthState}. -post_end_per_testcase(TestCase,_Config,Return,CthState) -> +post_end_per_testcase(_Suite,TestCase,_Config,Return,CthState) -> Update = fun(PrevUsers) -> case lists:delete(TestCase, PrevUsers) of diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 6d77d7ee9e..eda090d4f5 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -28,10 +28,10 @@ %% CTH Callbacks -export([id/1, init/2, pre_init_per_suite/3, pre_end_per_suite/3, post_end_per_suite/4, - pre_init_per_group/3, post_init_per_group/4, - pre_end_per_group/3, post_end_per_group/4, - pre_init_per_testcase/3, post_init_per_testcase/4, - pre_end_per_testcase/3, post_end_per_testcase/4]). + pre_init_per_group/4, post_init_per_group/5, + pre_end_per_group/4, post_end_per_group/5, + pre_init_per_testcase/4, post_init_per_testcase/5, + pre_end_per_testcase/4, post_end_per_testcase/5]). %% Event handler Callbacks -export([init/1, @@ -71,11 +71,11 @@ post_end_per_suite(_Suite, Config, Return, State) -> set_curr_func(undefined, Config), {Return, State}. -pre_init_per_group(Group, Config, State) -> +pre_init_per_group(_Suite, Group, Config, State) -> set_curr_func({group,Group,init_per_group}, Config), {Config, State}. -post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) -> +post_init_per_group(_Suite, Group, Config, Result, tc_log_async) when is_list(Config) -> case lists:member(parallel,proplists:get_value( tc_group_properties,Config,[])) of true -> @@ -83,33 +83,33 @@ post_init_per_group(Group, Config, Result, tc_log_async) when is_list(Config) -> false -> {Result, tc_log_async} end; -post_init_per_group(_Group, _Config, Result, State) -> +post_init_per_group(_Suite, _Group, _Config, Result, State) -> {Result, State}. -pre_init_per_testcase(TC, Config, State) -> +pre_init_per_testcase(_Suite, TC, Config, State) -> set_curr_func(TC, Config), {Config, State}. -post_init_per_testcase(_TC, _Config, Return, State) -> +post_init_per_testcase(_Suite, _TC, _Config, Return, State) -> {Return, State}. -pre_end_per_testcase(_TC, Config, State) -> +pre_end_per_testcase(_Suite, _TC, Config, State) -> {Config, State}. -post_end_per_testcase(_TC, _Config, Result, State) -> +post_end_per_testcase(_Suite, _TC, _Config, Result, State) -> %% Make sure that the event queue is flushed %% before ending this test case. gen_event:call(error_logger, ?MODULE, flush, 300000), {Result, State}. -pre_end_per_group(Group, Config, {tc_log, Group}) -> +pre_end_per_group(_Suite, Group, Config, {tc_log, Group}) -> set_curr_func({group,Group,end_per_group}, Config), {Config, set_log_func(tc_log_async)}; -pre_end_per_group(Group, Config, State) -> +pre_end_per_group(_Suite, Group, Config, State) -> set_curr_func({group,Group,end_per_group}, Config), {Config, State}. -post_end_per_group(_Group, Config, Return, State) -> +post_end_per_group(_Suite, _Group, Config, Return, State) -> set_curr_func({group,undefined}, Config), {Return, State}. diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 59b916851e..c4941948cc 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -33,16 +33,16 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). --export([pre_init_per_group/3]). --export([post_init_per_group/4]). --export([pre_end_per_group/3]). --export([post_end_per_group/4]). +-export([pre_init_per_group/4]). +-export([post_init_per_group/5]). +-export([pre_end_per_group/4]). +-export([post_end_per_group/5]). --export([pre_init_per_testcase/3]). --export([post_end_per_testcase/4]). +-export([pre_init_per_testcase/4]). +-export([post_end_per_testcase/5]). --export([on_tc_fail/3]). --export([on_tc_skip/3]). +-export([on_tc_fail/4]). +-export([on_tc_skip/4]). -export([terminate/1]). @@ -116,29 +116,29 @@ pre_end_per_suite(_Suite,Config,State) -> post_end_per_suite(_Suite,Config,Result,State) -> {Result, end_tc(end_per_suite,Config,Result,State)}. -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(_Suite,Group,Config,State) -> {Config, init_tc(State#state{ curr_group = [Group|State#state.curr_group]}, Config)}. -post_init_per_group(_Group,Config,Result,State) -> +post_init_per_group(_Suite,_Group,Config,Result,State) -> {Result, end_tc(init_per_group,Config,Result,State)}. -pre_end_per_group(_Group,Config,State) -> +pre_end_per_group(_Suite,_Group,Config,State) -> {Config, init_tc(State, Config)}. -post_end_per_group(_Group,Config,Result,State) -> +post_end_per_group(_Suite,_Group,Config,Result,State) -> NewState = end_tc(end_per_group, Config, Result, State), {Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}. -pre_init_per_testcase(_TC,Config,State) -> +pre_init_per_testcase(_Suite,_TC,Config,State) -> {Config, init_tc(State, Config)}. -post_end_per_testcase(TC,Config,Result,State) -> +post_end_per_testcase(_Suite,TC,Config,Result,State) -> {Result, end_tc(TC,Config, Result,State)}. -on_tc_fail(_TC, _Res, State = #state{test_cases = []}) -> +on_tc_fail(_Suite,_TC, _Res, State = #state{test_cases = []}) -> State; -on_tc_fail(_TC, Res, State) -> +on_tc_fail(_Suite,_TC, Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ @@ -146,10 +146,9 @@ on_tc_fail(_TC, Res, State) -> {fail,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. -on_tc_skip({ConfigFunc,_GrName},{Type,_Reason} = Res, State0) - when Type == tc_auto_skip; Type == tc_user_skip -> - on_tc_skip(ConfigFunc, Res, State0); -on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> +on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) -> + on_tc_skip(Suite,ConfigFunc, Res, State); +on_tc_skip(Suite,Tc, Res, State0) -> TcStr = atom_to_list(Tc), State = case State0#state.test_cases of @@ -158,11 +157,7 @@ on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> _ -> State0 end, - do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[]))); -on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) -> - State; -on_tc_skip(_Tc, Res, State) -> - do_tc_skip(Res, State). + do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(set_suite(Suite,State),[]))). do_tc_skip(Res, State) -> TCs = State#state.test_cases, @@ -209,6 +204,12 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, result = passed }| State#state.test_cases], tc_log = ""}. % so old tc_log is not set if next is on_tc_skip + +set_suite(Suite,#state{curr_suite=undefined}=State) -> + State#state{curr_suite=Suite, curr_suite_ts=?now}; +set_suite(_,State) -> + State. + close_suite(#state{ test_cases = [] } = State) -> State; close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> @@ -228,7 +229,8 @@ close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> testcases = lists:reverse(TCs), log = SuiteLog, url = SuiteUrl}, - State#state{ test_cases = [], + State#state{ curr_suite = undefined, + test_cases = [], test_suites = [Suite | State#state.test_suites]}. terminate(State = #state{ test_cases = [] }) -> diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 924086f2bd..be49191f2e 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -778,9 +778,9 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid, %% if init_per_testcase fails, the test case %% should be skipped try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[CurrConf]}, Why), - do_init_tc_call(Mod,{end_per_testcase,Func}, + do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, [CurrConf],{ok,[CurrConf]}), - do_end_tc_call(Mod,{end_per_testcase,Func}, + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, {Pid,Skip,[CurrConf]}, Why) end of _ -> ok catch @@ -1151,14 +1151,14 @@ do_end_tc_call(Mod, IPTC={init_per_testcase,Func}, Res, Return) -> Args end, EPTCInitRes = - case do_init_tc_call(Mod,{end_per_testcase,Func}, + case do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, IPTCEndRes,Return) of {ok,EPTCInitConfig} when is_list(EPTCInitConfig) -> {Return,EPTCInitConfig}; _ -> - Return + {Return,IPTCEndRes} end, - do_end_tc_call1(Mod, {end_per_testcase,Func}, + do_end_tc_call1(Mod, {end_per_testcase_not_run,Func}, EPTCInitRes, Return); _Ok -> do_end_tc_call1(Mod, IPTC, Res, Return) diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index b52e4bef9b..39c523f8b3 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -2051,17 +2051,21 @@ add_init_and_end_per_suite([], _LastMod, skipped_suite, _FwMod) -> add_init_and_end_per_suite([], LastMod, LastRef, FwMod) -> %% we'll add end_per_suite here even if it's not exported %% (and simply let the call fail if it's missing) - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - [{conf,LastRef,[],{LastMod,end_per_suite}}]; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> %% let's call a "fake" end_per_suite if it exists case erlang:function_exported(FwMod, end_per_suite, 1) of true -> [{conf,LastRef,[{suite,LastMod}],{FwMod,end_per_suite}}]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}] - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + [{conf,LastRef,[],{LastMod,end_per_suite}}] end. do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> @@ -2070,11 +2074,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> _ -> ok end, {Init,NextMod,NextRef} = - case erlang:function_exported(Mod, init_per_suite, 1) of - true -> - Ref = make_ref(), - {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref}; - false -> + case {erlang:function_exported(Mod, init_per_suite, 1), + erlang:function_exported(Mod, end_per_suite, 1)} of + {false,false} -> %% let's call a "fake" init_per_suite if it exists case erlang:function_exported(FwMod, init_per_suite, 1) of true -> @@ -2083,8 +2085,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> {FwMod,init_per_suite}}],Mod,Ref}; false -> {[],Mod,undefined} - end - + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + Ref = make_ref(), + {[{conf,Ref,[],{Mod,init_per_suite}}],Mod,Ref} end, Cases = if LastRef==undefined -> @@ -2094,10 +2101,9 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> true -> %% we'll add end_per_suite here even if it's not exported %% (and simply let the call fail if it's missing) - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - [{conf,LastRef,[],{LastMod,end_per_suite}}|Init]; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> %% let's call a "fake" end_per_suite if it exists case erlang:function_exported(FwMod, end_per_suite, 1) of true -> @@ -2105,8 +2111,13 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> {FwMod,end_per_suite}}|Init]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] - end - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] + end end, {Cases,NextMod,NextRef}. @@ -2115,11 +2126,9 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> No when No==undefined ; No==skipped_suite -> {[],Mod,skipped_suite}; _Ref -> - case erlang:function_exported(LastMod, end_per_suite, 1) of - true -> - {[{conf,LastRef,[],{LastMod,end_per_suite}}], - Mod,skipped_suite}; - false -> + case {erlang:function_exported(LastMod, end_per_suite, 1), + erlang:function_exported(LastMod, init_per_suite, 1)} of + {false,false} -> case erlang:function_exported(FwMod, end_per_suite, 1) of true -> %% let's call "fake" end_per_suite if it exists @@ -2128,7 +2137,13 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> false -> {[{conf,LastRef,[],{LastMod,end_per_suite}}], Mod,skipped_suite} - end + end; + _ -> + %% If any of these exist, the other should too + %% (required and documented). If it isn't, it will fail + %% with reason 'undef'. + {[{conf,LastRef,[],{LastMod,end_per_suite}}], + Mod,skipped_suite} end end. @@ -2924,22 +2939,21 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) exit(framework_error); %% sequential execution of test case finished {Time,RetVal,_} -> + RetTag = + if is_tuple(RetVal) -> element(1,RetVal); + true -> undefined + end, {Failed,Status1} = - case Time of - died -> - {true,update_status(failed, Mod, Func, Status)}; - _ when is_tuple(RetVal) -> - case element(1, RetVal) of - R when R=='EXIT'; R==failed -> - {true,update_status(failed, Mod, Func, Status)}; - R when R==skip; R==skipped -> - {false,update_status(skipped, Mod, Func, Status)}; - _ -> - {false,update_status(ok, Mod, Func, Status)} - end; - _ -> - {false,update_status(ok, Mod, Func, Status)} - end, + case RetTag of + Skip when Skip==skip; Skip==skipped -> + {false,update_status(skipped, Mod, Func, Status)}; + Fail when Fail=='EXIT'; Fail==failed -> + {true,update_status(failed, Mod, Func, Status)}; + _ when Time==died, RetVal=/=ok -> + {true,update_status(failed, Mod, Func, Status)}; + _ -> + {false,update_status(ok, Mod, Func, Status)} + end, case check_prop(sequence, Mode) of false -> stop_minor_log_file(), @@ -3794,7 +3808,15 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, {died,{timetrap_timeout,TimetrapTimeout}} -> progress(failed, Num, Mod, Func, GrName, Loc, timetrap_timeout, TimetrapTimeout, Comment, Style); - {died,Reason} -> + {died,{Skip,Reason}} when Skip==skip; Skip==skipped -> + %% died in init_per_testcase + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); + {died,Reason} when Reason=/=ok -> + %% (If Reason==ok it means that process died in + %% end_per_testcase after successfully completing the + %% test case itself - then we shall not fail, but a + %% warning will be issued in the comment field.) progress(failed, Num, Mod, Func, GrName, Loc, Reason, Time, Comment, Style); {_,{'EXIT',{Skip,Reason}}} when Skip==skip; Skip==skipped; @@ -3943,6 +3965,9 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, {ReportTag,Reason1}}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), ReasonStr = escape_chars(reason_to_string(Reason1)), ReasonStr1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ReasonStr,[$\n])]), @@ -3957,10 +3982,10 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, _ -> xhtml("<br>(","<br />(") ++ to_string(Comment) ++ ")" end, print(html, - "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>" "<td><font color=\"~ts\">SKIPPED</font></td>" "<td>~ts~ts</td></tr>\n", - [Time,Color,ReasonStr2,Comment1]), + [TimeStr,Color,ReasonStr2,Comment1]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== Location: ~ts", [FormatLoc]), print(minor, "=== Reason: ~ts", [ReasonStr1]), @@ -4098,6 +4123,9 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, Comment0, {St0,St1}) -> print(minor, "successfully completed test case", []), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},ok}]), + TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; + true -> "~w" + end, [Time]), Comment = case RetVal of {comment,RetComment} -> @@ -4116,10 +4144,10 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, end, print(major, "=elapsed ~p", [Time]), print(html, - "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" + "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>" "<td><font color=\"green\">Ok</font></td>" "~ts</tr>\n", - [Time,Comment]), + [TimeStr,Comment]), print(minor, escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])), []), diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index fae23484e6..621f3b6d2d 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -1531,17 +1531,17 @@ test_events(config_func_errors) -> {?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}}, - {?eh,test_stats,{0,1,{0,0}}}, + {?eh,test_stats,{0,0,{0,1}}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}}, - {?eh,test_stats,{0,2,{0,0}}}, + {?eh,test_stats,{1,0,{0,1}}}, [{?eh,tc_start,{config_func_error_1_SUITE,{init_per_group,g1,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g1,[]},ok}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_iptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_iptc,'_'}}, - {?eh,test_stats,{0,3,{0,0}}}, + {?eh,test_stats,{1,0,{0,2}}}, {?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g1,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g1,[]},ok}}], @@ -1549,7 +1549,7 @@ test_events(config_func_errors) -> {?eh,tc_done,{config_func_error_1_SUITE,{init_per_group,g2,[]},ok}}, {?eh,tc_start,{config_func_error_1_SUITE,exit_in_eptc}}, {?eh,tc_done,{config_func_error_1_SUITE,exit_in_eptc,'_'}}, - {?eh,test_stats,{0,4,{0,0}}}, + {?eh,test_stats,{2,0,{0,2}}}, {?eh,tc_start,{config_func_error_1_SUITE,{end_per_group,g2,[]}}}, {?eh,tc_done,{config_func_error_1_SUITE,{end_per_group,g2,[]},ok}}], diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index bc716fb5e3..93bcb8fe52 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -82,10 +82,13 @@ all(suite) -> scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, + skip_pre_init_tc_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, - data_dir, cth_log + no_init_suite_config, no_init_config, no_end_config, + failed_sequence, repeat_force_stop, config_clash, + callbacks_on_skip, fallback, data_dir, cth_log ] ). @@ -190,6 +193,10 @@ skip_post_suite_cth(Config) when is_list(Config) -> do_test(skip_post_suite_cth, "ct_cth_empty_SUITE.erl", [skip_post_suite_cth],Config). +skip_pre_init_tc_cth(Config) -> + do_test(skip_pre_init_tc_cth, "ct_cth_empty_SUITE.erl", + [skip_pre_init_tc_cth],Config). + recover_post_suite_cth(Config) when is_list(Config) -> do_test(recover_post_suite_cth, "ct_cth_fail_per_suite_SUITE.erl", [recover_post_suite_cth],Config). @@ -223,6 +230,16 @@ no_config(Config) when is_list(Config) -> do_test(no_config, "ct_no_config_SUITE.erl", [verify_config_cth],Config). +no_init_suite_config(Config) when is_list(Config) -> + do_test(no_init_suite_config, "ct_no_init_suite_config_SUITE.erl", + [empty_cth],Config). + +no_init_config(Config) when is_list(Config) -> + do_test(no_init_config, "ct_no_init_config_SUITE.erl",[empty_cth],Config). + +no_end_config(Config) when is_list(Config) -> + do_test(no_end_config, "ct_no_end_config_SUITE.erl",[empty_cth],Config). + data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). @@ -254,24 +271,53 @@ cth_log(Config) when is_list(Config) -> end, UnexpIoLogs), ok. +%% OTP-10599 adds the Suite argument as first argument to all hook +%% callbacks that did not have a Suite argument from before. This test +%% checks that ct_hooks will fall back to old versions of callbacks if +%% new versions are not exported. +fallback(Config) -> + do_test(fallback, "all_hook_callbacks_SUITE.erl",[fallback_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped in different ways +callbacks_on_skip(Config) -> + do_test(callbacks_on_skip, {spec,"skip.spec"},[skip_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped due to failed sequence +failed_sequence(Config) -> + do_test(failed_sequence, "seq_SUITE.erl", [skip_cth], Config). + +%% Test that expected callbacks, and only those, are called when tests +%% are skipped due to {force_stop,skip_rest} option +repeat_force_stop(Config) -> + do_test(repeat_force_stop, "repeat_SUITE.erl", [skip_cth], Config, ok, 2, + [{force_stop,skip_rest},{duration,"000009"}]). + +%% Test that expected callbacks, and only those, are called when a test +%% are fails due to clash in config alias names +config_clash(Config) -> + do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config). %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- -do_test(Tag, SWC, CTHs, Config) -> - do_test(Tag, SWC, CTHs, Config, ok). -do_test(Tag, SWC, CTHs, Config, {error,_} = Res) -> - do_test(Tag, SWC, CTHs, Config, Res, 1); -do_test(Tag, SWC, CTHs, Config, Res) -> - do_test(Tag, SWC, CTHs, Config, Res, 2). +do_test(Tag, WTT, CTHs, Config) -> + do_test(Tag, WTT, CTHs, Config, ok). +do_test(Tag, WTT, CTHs, Config, {error,_} = Res) -> + do_test(Tag, WTT, CTHs, Config, Res, 1,[]); +do_test(Tag, WTT, CTHs, Config, Res) -> + do_test(Tag, WTT, CTHs, Config, Res, 2,[]). -do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> +do_test(Tag, WhatToTest, CTHs, Config, Res, EC, ExtraOpts) when is_list(WhatToTest) -> + do_test(Tag, {suite,WhatToTest}, CTHs, Config, Res, EC, ExtraOpts); +do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) -> DataDir = ?config(data_dir, Config), - Suites = filelib:wildcard( - filename:join([DataDir,"cth/tests",SuiteWildCard])), - {Opts,ERPid} = setup([{suite,Suites}, - {ct_hooks,CTHs},{label,Tag}], Config), + Files = filelib:wildcard( + filename:join([DataDir,"cth/tests",Wildcard])), + {Opts,ERPid} = + setup([{WhatTag,Files},{ct_hooks,CTHs},{label,Tag}|ExtraOpts], Config), Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), @@ -323,10 +369,10 @@ test_events(one_empty_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{empty_cth,post_init_per_testcase,[test_case,'$proplist','_',[]]}}, - {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, @@ -355,10 +401,10 @@ test_events(two_empty_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, @@ -423,8 +469,8 @@ test_events(minimal_and_maximal_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, @@ -512,8 +558,8 @@ test_events(scope_per_suite_cth) -> {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}}, @@ -538,8 +584,8 @@ test_events(scope_suite_cth) -> {?eh,tc_done,{ct_scope_suite_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_suite_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}}, @@ -561,17 +607,17 @@ test_events(scope_per_group_cth) -> [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1, '$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}], @@ -592,8 +638,8 @@ test_events(scope_per_suite_state_cth) -> {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}}, @@ -618,8 +664,8 @@ test_events(scope_suite_state_cth) -> {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_suite_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}}, @@ -641,17 +687,17 @@ test_events(scope_per_group_state_cth) -> [{?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[test]]}}, {?eh,cth,{'_',init,['_',[test]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','$proplist',[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}}, {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_state_cth_SUITE,test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist',[test]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_state_cth_SUITE,group1,'$proplist','_',[test]]}}, {?eh,cth,{'_',terminate,[[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}], @@ -674,14 +720,14 @@ test_events(fail_pre_suite_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed, {error,"Test failure"}}}}, {?eh,cth,{'_',on_tc_fail, - [init_per_suite,{failed,"Test failure"},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,"Test failure",[]]}}, {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip, - [test_case, {tc_auto_skip, + [ct_cth_empty_SUITE,test_case, {tc_auto_skip, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, @@ -690,7 +736,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip, - [end_per_suite, {tc_auto_skip, + [ct_cth_empty_SUITE,end_per_suite, {tc_auto_skip, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, @@ -727,17 +773,17 @@ test_events(fail_post_suite_cth) -> {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed,{error,"Test failure"}}}}, - {?eh,cth,{'_',on_tc_fail,[init_per_suite, {failed,"Test failure"}, []]}}, + {?eh,cth,{'_',on_tc_fail,[ct_cth_empty_SUITE,init_per_suite, "Test failure", []]}}, {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}}, + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_auto_skip,'_'},[]]}}, {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, - {?eh,cth,{'_',on_tc_skip,[end_per_suite,{tc_auto_skip,'_'},[]]}}, + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,end_per_suite,{tc_auto_skip,'_'},[]]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, @@ -754,10 +800,10 @@ test_events(skip_pre_suite_cth) -> {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}}, {?eh,cth,{'_',on_tc_skip, - [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, @@ -776,27 +822,29 @@ test_events(skip_pre_end_cth) -> [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, + {?eh,cth,{'_',post_init_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_scope_per_group_cth_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, - {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, + {?eh,cth,{'_',pre_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_group,[ct_scope_per_group_cth_SUITE,group1,'$proplist','_',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}, {skipped,"Test skip"}}}], - {?eh,cth,{'_',on_tc_skip,[{end_per_group,group1}, - {tc_user_skip,{skipped,"Test skip"}}, + {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE, + {end_per_group,group1}, + {tc_user_skip,"Test skip"}, []]}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite, {skipped,"Test skip"}}}, - {?eh,cth,{'_',on_tc_skip,[end_per_suite, - {tc_user_skip,{skipped,"Test skip"}}, + {?eh,cth,{'_',on_tc_skip,[ct_scope_per_group_cth_SUITE, + end_per_suite, + {tc_user_skip,"Test skip"}, []]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, @@ -814,10 +862,10 @@ test_events(skip_post_suite_cth) -> {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,{skipped,"Test skip"}}}, {?eh,cth,{'_',on_tc_skip, - [init_per_suite,{tc_user_skip,{skipped,"Test skip"}},[]]}}, + [ct_cth_empty_SUITE,init_per_suite,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, - {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, + {?eh,cth,{'_',on_tc_skip,[ct_cth_empty_SUITE,test_case,{tc_user_skip,"Test skip"},[]]}}, {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, @@ -826,6 +874,41 @@ test_events(skip_post_suite_cth) -> {?eh,stop_logging,[]} ]; +test_events(skip_pre_init_tc_cth) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [ct_cth_empty_SUITE,test_case,'$proplist', + {skip,"Skipped in pre_init_per_testcase"}, + []]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,test_case, + {skipped,"Skipped in pre_init_per_testcase"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_cth_empty_SUITE,test_case, + {tc_user_skip,"Skipped in pre_init_per_testcase"}, + []]}}, + {?eh,test_stats,{0,0,{1,0}}}, + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_cth_empty_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(recover_post_suite_cth) -> Suite = ct_cth_fail_per_suite_SUITE, [ @@ -840,9 +923,9 @@ test_events(recover_post_suite_cth) -> {?eh,tc_start,{Suite,test_case}}, {?eh,cth,{'_',pre_init_per_testcase, - [test_case, not_contains([tc_status]),[]]}}, + [Suite,test_case, not_contains([tc_status]),[]]}}, {?eh,cth,{'_',post_end_per_testcase, - [test_case, contains([tc_status]),'_',[]]}}, + [Suite,test_case, contains([tc_status]),'_',[]]}}, {?eh,tc_done,{Suite,test_case,ok}}, {?eh,tc_start,{Suite,end_per_suite}}, @@ -876,13 +959,15 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE, {init_per_group,group1,[]}}}, {?eh,cth,{'_',pre_init_per_group, - [group1,contains( + [ct_update_config_SUITE, + group1,contains( [post_init_per_suite, init_per_suite, pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_init_per_group, - [group1, + [ct_update_config_SUITE, + group1, contains( [post_init_per_suite, init_per_suite, @@ -898,7 +983,8 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase, - [test_case,contains( + [ct_update_config_SUITE, + test_case,contains( [post_init_per_group, init_per_group, pre_init_per_group, @@ -907,7 +993,8 @@ test_events(update_config_cth) -> pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_end_per_testcase, - [test_case,contains( + [ct_update_config_SUITE, + test_case,contains( [init_per_testcase, pre_init_per_testcase, post_init_per_group, @@ -921,7 +1008,8 @@ test_events(update_config_cth) -> {?eh,tc_start,{ct_update_config_SUITE, {end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group, - [group1,contains( + [ct_update_config_SUITE, + group1,contains( [post_init_per_group, init_per_group, pre_init_per_group, @@ -930,7 +1018,8 @@ test_events(update_config_cth) -> pre_init_per_suite]), []]}}, {?eh,cth,{'_',post_end_per_group, - [group1, + [ct_update_config_SUITE, + group1, contains( [pre_end_per_group, post_init_per_group, @@ -1018,8 +1107,8 @@ test_events(options_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}}, - {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}}, + {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[test]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[test]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, @@ -1051,12 +1140,12 @@ test_events(same_id_cth) -> {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}}, {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, {negative, - {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}}, + {?eh,cth,{'_',pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}}, {negative, - {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, + {?eh,cth,{'_',post_end_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}}, {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, @@ -1094,11 +1183,13 @@ test_events(fail_n_skip_with_minimal_cth) -> {?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case2,{skipped,"skip it"}}}, {?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,test_case3}}, {?eh,tc_done,{ct_cth_fail_one_skip_one_SUITE,test_case3,{skipped,"skip it"}}}, - {?eh,cth,{empty_cth,on_tc_skip,[{test_case2,group2}, - {tc_user_skip,{skipped,"skip it"}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE, + {test_case2,group2}, + {tc_user_skip,"skip it"}, []]}}, - {?eh,cth,{empty_cth,on_tc_skip,[{test_case3,group2}, - {tc_user_skip,{skipped,"skip it"}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_cth_fail_one_skip_one_SUITE, + {test_case3,group2}, + {tc_user_skip,"skip it"}, []]}}, {?eh,tc_start,{ct_cth_fail_one_skip_one_SUITE,{end_per_group, group2,[parallel]}}}, @@ -1115,13 +1206,24 @@ test_events(fail_n_skip_with_minimal_cth) -> ]; test_events(prio_cth) -> - GenPre = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_',State]}} || State <- States] + GenPre = fun(Func,States) when Func==pre_init_per_suite; + Func==pre_end_per_suite -> + [{?eh,cth,{'_',Func,['_','_',State]}} || + State <- States]; + (Func,States) -> + [{?eh,cth,{'_',Func,['_','_','_',State]}} || + State <- States] end, - GenPost = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States] - end, + GenPost = fun(Func,States) when Func==post_init_per_suite; + Func==post_end_per_suite -> + [{?eh,cth,{'_',Func,['_','_','_',State]}} || + State <- States]; + (Func,States) -> + [{?eh,cth,{'_',Func,['_','_','_','_',State]}} || + State <- States] + + end, [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ @@ -1197,30 +1299,30 @@ test_events(no_config) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ct_no_config_SUITE,test_case_1}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_1,'$proplist',[]]}}, + [ct_no_config_SUITE,test_case_1,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_1,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_case_1,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_no_config_SUITE,test_case_1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_init_per_group, - [test_group,'$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_init_per_group, - [test_group,'$proplist','$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_framework, {init_per_group,test_group,'$proplist'},ok}}, {?eh,tc_start,{ct_no_config_SUITE,test_case_2}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_2,'$proplist',[]]}}, + [ct_no_config_SUITE,test_case_2,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_2,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_case_2,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_no_config_SUITE,test_case_2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_end_per_group, - [test_group,'$proplist',[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_group, - [test_group,'$proplist',ok,[]]}}, + [ct_no_config_SUITE,test_group,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, @@ -1233,6 +1335,166 @@ test_events(no_config) -> {?eh,stop_logging,[]} ]; +test_events(no_init_suite_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_no_init_suite_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_init_suite_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_init_suite_config_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_init_suite_config_SUITE,init_per_suite, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_suite_config_SUITE, + init_per_suite, + {undef,'_'},[]]}}, + {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,test_case, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_no_init_suite_config_SUITE, + test_case, + {tc_auto_skip, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_stats,{0,0,{0,1}}}, + {?eh,tc_auto_skip,{ct_no_init_suite_config_SUITE,end_per_suite, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [ct_no_init_suite_config_SUITE, + end_per_suite, + {tc_auto_skip, + {failed,{ct_no_init_suite_config_SUITE,init_per_suite, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(no_init_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_no_init_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_init_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_init_config_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_no_init_config_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_init_config_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_init_config_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + [{?eh,tc_start,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [ct_no_init_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [ct_no_init_config_SUITE,test_group,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,{init_per_group,test_group,[]}, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_init_config_SUITE, + {init_per_group,test_group}, + {undef,'_'},[]]}}, + {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{test_case_2,test_group}, + {failed,{ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE, + {test_case_2,test_group}, + {tc_auto_skip, + {failed, + {ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}, + []]}}, + {?eh,test_stats,{1,0,{0,1}}}, + {?eh,tc_auto_skip,{ct_no_init_config_SUITE,{end_per_group,test_group}, + {failed,{ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}}, + {?eh,cth,{empty_cth,on_tc_skip,[ct_no_init_config_SUITE, + {end_per_group,test_group}, + {tc_auto_skip, + {failed, + {ct_no_init_config_SUITE,init_per_group, + {'EXIT',{undef,'_'}}}}}, + []]}}], + {?eh,tc_start,{ct_no_init_config_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [ct_no_init_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_no_init_config_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_init_config_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(no_end_config) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_no_end_config_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [ct_no_end_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [ct_no_end_config_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{ct_no_end_config_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_end_config_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_end_config_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + [{?eh,tc_start,{ct_no_end_config_SUITE, + {init_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE, + {init_per_group,test_group,'$proplist'},ok}}, + {?eh,tc_start,{ct_no_end_config_SUITE,test_case_2}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [ct_no_end_config_SUITE,test_case_2,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [ct_no_end_config_SUITE,test_case_2,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,test_case_2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_start,{ct_no_end_config_SUITE, + {end_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_end_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_group, + [ct_no_end_config_SUITE,test_group,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,{end_per_group,test_group,[]}, + {failed,{error,{undef,'_'}}}}}, + {?eh,cth,{empty_cth,on_tc_fail,[ct_no_end_config_SUITE, + {end_per_group,test_group}, + {undef,'_'},[]]}}], + {?eh,tc_start,{ct_no_end_config_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [ct_no_end_config_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [ct_no_end_config_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{ct_no_end_config_SUITE,end_per_suite, + {failed,{error,{undef,'_'}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(data_dir) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, @@ -1247,30 +1509,30 @@ test_events(data_dir) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ct_data_dir_SUITE,test_case_1}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_1,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_1,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_data_dir_SUITE,test_case_1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_init_per_group, - [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_init_per_group, - [test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist','$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_framework, {init_per_group,test_group,'$proplist'},ok}}, {?eh,tc_start,{ct_data_dir_SUITE,test_case_2}}, {?eh,cth,{empty_cth,pre_init_per_testcase, - [test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_2,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_testcase, - [test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_case_2,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_data_dir_SUITE,test_case_2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, {?eh,cth,{empty_cth,pre_end_per_group, - [test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,cth,{empty_cth,post_end_per_group, - [test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, + [ct_data_dir_SUITE,test_group,'$proplist',ok,[{data_dir_name,"ct_data_dir_SUITE_data"}]]}}, {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, @@ -1303,6 +1565,645 @@ test_events(cth_log) -> {?eh,stop_logging,[]} ]; +test_events(fallback) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [all_hook_callbacks_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [all_hook_callbacks_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,init_per_suite,ok}}, + + [{?eh,tc_start,{ct_framework,{init_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [fallback_nosuite,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [fallback_nosuite,test_group,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework, + {init_per_group,test_group,'$proplist'},ok}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [fallback_nosuite,test_case,'$proplist',ok,[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{ct_framework,{end_per_group,test_group,'$proplist'}}}, + {?eh,cth,{empty_cth,pre_end_per_group, + [fallback_nosuite,test_group,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_group, + [fallback_nosuite,test_group,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,{end_per_group,test_group,'$proplist'},ok}}], + {?eh,tc_start,{all_hook_callbacks_SUITE,test_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [fallback_nosuite,test_case,'$proplist','_',[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [fallback_nosuite,test_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [fallback_nosuite,test_case,'$proplist','_',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,test_case,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,skip_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [fallback_nosuite,skip_case,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [fallback_nosuite,skip_case,'$proplist', + {skip,"Skipped in init_per_testcase/2"},[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,skip_case, + {skipped,"Skipped in init_per_testcase/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [fallback_nosuite,skip_case, + {tc_user_skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,test_stats,{2,0,{1,0}}}, + {?eh,tc_start,{all_hook_callbacks_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [all_hook_callbacks_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [all_hook_callbacks_SUITE,'$proplist','_',[]]}}, + {?eh,tc_done,{all_hook_callbacks_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(callbacks_on_skip) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{6,6,15}}, + + %% all_hook_callbacks_SUITE is skipped in spec + %% Only the on_tc_skip callback shall be called + {?eh,tc_user_skip,{all_hook_callbacks_SUITE,all,"Skipped in spec"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [all_hook_callbacks_SUITE,all, + {tc_user_skip,"Skipped in spec"}, + []]}}, + {?eh,test_stats,{0,0,{1,0}}}, + + %% skip_init_SUITE is skipped in its init_per_suite function + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_init_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_init_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_init_SUITE, + '$proplist', + {skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,tc_done,{skip_init_SUITE,init_per_suite, + {skipped,"Skipped in init_per_suite/1"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,init_per_suite, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,tc_user_skip,{skip_init_SUITE,test_case,"Skipped in init_per_suite/1"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,test_case, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + {?eh,test_stats,{0,0,{2,0}}}, + {?eh,tc_user_skip,{skip_init_SUITE,end_per_suite, + "Skipped in init_per_suite/1"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_init_SUITE,end_per_suite, + {tc_user_skip,"Skipped in init_per_suite/1"}, + []]}}, + + %% skip_req_SUITE is auto-skipped since a 'require' statement + %% returned by suite/0 is not fulfilled. + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_req_SUITE,init_per_suite}}, + {?eh,tc_done,{skip_req_SUITE,init_per_suite, + {auto_skipped,{require_failed_in_suite0, + {not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,init_per_suite, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + {?eh,tc_auto_skip,{skip_req_SUITE,test_case,{require_failed_in_suite0, + {not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,test_case, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + {?eh,test_stats,{0,0,{2,1}}}, + {?eh,tc_auto_skip,{skip_req_SUITE,end_per_suite, + {require_failed_in_suite0, + {not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_req_SUITE,end_per_suite, + {tc_auto_skip,{require_failed_in_suite0, + {not_available,whatever}}}, + []]}}, + + %% skip_fail_SUITE is auto-skipped since the suite/0 function + %% retuns a faluty format. + %% No group- or testcase-functions shall be called. + {?eh,tc_start,{skip_fail_SUITE,init_per_suite}}, + {?eh,tc_done,{skip_fail_SUITE,init_per_suite, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,init_per_suite, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + {?eh,tc_auto_skip,{skip_fail_SUITE,test_case, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,test_case, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + {?eh,test_stats,{0,0,{2,2}}}, + {?eh,tc_auto_skip,{skip_fail_SUITE,end_per_suite, + {failed,{error,{suite0_failed,bad_return_value}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_fail_SUITE,end_per_suite, + {tc_auto_skip, + {failed,{error,{suite0_failed,bad_return_value}}}}, + []]}}, + + %% skip_group_SUITE + {?eh,tc_start,{skip_group_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_group_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_group_SUITE, + '$proplist', + '_', + []]}}, + {?eh,tc_done,{skip_group_SUITE,init_per_suite,ok}}, + + %% test_group_1 - auto_skip due to require failed + [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_1,[]}}}, + {?eh,tc_done, + {skip_group_SUITE,{init_per_group,test_group_1,[]}, + {auto_skipped,{require_failed,{not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_1}, + {require_failed,{not_available,whatever}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,test_stats,{0,0,{2,3}}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_1}, + {require_failed,{not_available,whatever}}}}], + %% The following appears to be outside of the group, but + %% that's only an implementation detail in + %% ct_test_support.erl - it does not know about events from + %% test suite specific hooks and regards the group ended with + %% the above tc_auto_skip-event for end_per_group. + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_1}, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + + %% test_group_2 - auto_skip due to failed return from group/1 + [{?eh,tc_start,{skip_group_SUITE,{init_per_group,test_group_2,[]}}}, + {?eh,tc_done, + {skip_group_SUITE,{init_per_group,test_group_2,[]}, + {auto_skipped,{group0_failed,bad_return_value}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{test_case,test_group_2}, + {group0_failed,bad_return_value}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + {?eh,test_stats,{0,0,{2,4}}}, + {?eh,tc_auto_skip,{skip_group_SUITE,{end_per_group,test_group_2}, + {group0_failed,bad_return_value}}}], + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_2}, + {tc_auto_skip,{group0_failed,bad_return_value}}, + []]}}, + %% test_group_3 - user_skip in init_per_group/2 + [{?eh,tc_start, + {skip_group_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,cth,{empty_cth,pre_init_per_group, + [skip_group_SUITE,test_group_3,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_group, + [skip_group_SUITE,test_group_3,'$proplist', + {skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,tc_done,{skip_group_SUITE, + {init_per_group,test_group_3,[]}, + {skipped,"Skipped in init_per_group/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {init_per_group,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,tc_user_skip,{skip_group_SUITE, + {test_case,test_group_3}, + "Skipped in init_per_group/2"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {test_case,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + {?eh,test_stats,{0,0,{3,4}}}, + {?eh,tc_user_skip,{skip_group_SUITE, + {end_per_group,test_group_3}, + "Skipped in init_per_group/2"}}], + {?eh,cth,{empty_cth,on_tc_skip, + [skip_group_SUITE, + {end_per_group,test_group_3}, + {tc_user_skip,"Skipped in init_per_group/2"}, + []]}}, + + {?eh,tc_start,{skip_group_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [skip_group_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [skip_group_SUITE, + '$proplist', + ok,[]]}}, + {?eh,tc_done,{skip_group_SUITE,end_per_suite,ok}}, + + + %% skip_case_SUITE has 4 test cases which are all skipped in + %% different ways + {?eh,tc_start,{skip_case_SUITE,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [skip_case_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [skip_case_SUITE, + '$proplist', + '_', + []]}}, + {?eh,tc_done,{skip_case_SUITE,init_per_suite,ok}}, + + %% Skip in spec -> only on_tc_skip shall be called + {?eh,tc_user_skip,{skip_case_SUITE,skip_in_spec,"Skipped in spec"}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_spec, + {tc_user_skip,"Skipped in spec"}, + []]}}, + {?eh,test_stats,{0,0,{4,4}}}, + + %% Skip in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,skip_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,skip_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,skip_in_init, + '$proplist', + {skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,skip_in_init, + {skipped,"Skipped in init_per_testcase/2"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_init, + {tc_user_skip,"Skipped in init_per_testcase/2"}, + []]}}, + {?eh,test_stats,{0,0,{5,4}}}, + + %% Fail in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,fail_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,fail_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,fail_in_init, + '$proplist', + {skip,{failed,'_'}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,fail_in_init, + {auto_skipped,{failed,'_'}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,fail_in_init, + {tc_auto_skip,{failed,'_'}}, + []]}}, + {?eh,test_stats,{0,0,{5,5}}}, + + %% Exit in init_per_testcase -> pre/post_end_per_testcase + %% shall not be called + {?eh,tc_start,{skip_case_SUITE,exit_in_init}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,exit_in_init, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,exit_in_init, + '$proplist', + {skip,{failed,'_'}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,exit_in_init, + {auto_skipped,{failed,'_'}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,exit_in_init, + {tc_auto_skip,{failed,'_'}}, + []]}}, + {?eh,test_stats,{0,0,{5,6}}}, + + %% Fail in end_per_testcase -> all hooks shall be called and + %% test shall succeed. + {?eh,tc_start,{skip_case_SUITE,fail_in_end}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + ok, + []]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,fail_in_end, + '$proplist', + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT', + {test_case_failed,"Failed in end_per_testcase/2"}}}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,fail_in_end, + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT', + {test_case_failed,"Failed in end_per_testcase/2"}}}}}}, + {?eh,test_stats,{1,0,{5,6}}}, + + %% Exit in end_per_testcase -> all hooks shall be called and + %% test shall succeed. + {?eh,tc_start,{skip_case_SUITE,exit_in_end}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + ok, + []]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,exit_in_end, + '$proplist', + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT',"Exit in end_per_testcase/2"}}}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,exit_in_end, + {failed, + {skip_case_SUITE,end_per_testcase, + {'EXIT',"Exit in end_per_testcase/2"}}}}}, + {?eh,test_stats,{2,0,{5,6}}}, + + %% Skip in testcase function -> all callbacks shall be called + {?eh,tc_start,{skip_case_SUITE,skip_in_case}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [skip_case_SUITE,skip_in_case, + '$proplist', + {skip,"Skipped in test case function"}, + []]}}, + {?eh,tc_done,{skip_case_SUITE,skip_in_case, + {skipped,"Skipped in test case function"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,skip_in_case, + {tc_user_skip,"Skipped in test case function"}, + []]}}, + {?eh,test_stats,{2,0,{6,6}}}, + + %% Auto skip due to failed 'require' -> only the on_tc_skip + %% callback shall be called + {?eh,tc_start,{skip_case_SUITE,req_auto_skip}}, + {?eh,tc_done,{skip_case_SUITE,req_auto_skip, + {auto_skipped,{require_failed,{not_available,whatever}}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,req_auto_skip, + {tc_auto_skip,{require_failed,{not_available,whatever}}}, + []]}}, + {?eh,test_stats,{2,0,{6,7}}}, + + %% Auto skip due to failed testcase/0 function -> only the + %% on_tc_skip callback shall be called + {?eh,tc_start,{skip_case_SUITE,fail_auto_skip}}, + {?eh,tc_done,{skip_case_SUITE,fail_auto_skip, + {auto_skipped,{testcase0_failed,bad_return_value}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [skip_case_SUITE,fail_auto_skip, + {tc_auto_skip,{testcase0_failed,bad_return_value}}, + []]}}, + {?eh,test_stats,{2,0,{6,8}}}, + + {?eh,tc_start,{skip_case_SUITE,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [skip_case_SUITE, + '$proplist', + []]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [skip_case_SUITE, + '$proplist', + ok,[]]}}, + {?eh,tc_done,{skip_case_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(failed_sequence) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[seq_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [seq_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{seq_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [seq_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [seq_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [seq_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [seq_SUITE,test_case_1,'$proplist', + {error,failed_on_purpose},[]]}}, + {?eh,tc_done,{seq_SUITE,test_case_1,{failed,{error,failed_on_purpose}}}}, + {?eh,cth,{empty_cth,on_tc_fail, + [seq_SUITE,test_case_1,failed_on_purpose,[]]}}, + {?eh,test_stats,{0,1,{0,0}}}, + {?eh,tc_start,{seq_SUITE,test_case_2}}, + {?eh,tc_done,{seq_SUITE,test_case_2, + {auto_skipped,{sequence_failed,seq1,test_case_1}}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [seq_SUITE,test_case_2, + {tc_auto_skip,{sequence_failed,seq1,test_case_1}}, + []]}}, + {?eh,test_stats,{0,1,{0,1}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[seq_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite,[seq_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(repeat_force_stop) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events= + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite,[repeat_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [repeat_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{repeat_SUITE,test_case_1}}, + {?eh,cth,{empty_cth,pre_init_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,cth,{empty_cth,pre_end_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_testcase, + [repeat_SUITE,test_case_1,'$proplist',ok,[]]}}, + {?eh,tc_done,{repeat_SUITE,test_case_1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{repeat_SUITE,test_case_2}}, + {?eh,tc_done,{repeat_SUITE,test_case_2, + {auto_skipped, + "Repeated test stopped by force_stop option"}}}, + {?eh,cth,{empty_cth,on_tc_skip, + [repeat_SUITE,test_case_2, + {tc_auto_skip,"Repeated test stopped by force_stop option"}, + []]}}, + {?eh,test_stats,{1,0,{0,1}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite,[repeat_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [repeat_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + +test_events(config_clash) -> + %% skip_cth.erl will send a 'cth_error' event if a hook is + %% erroneously called. Therefore, all Events are changed to + %% {negative,{?eh,cth_error,'_'},Event} + %% at the end of this function. + Events = + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,cth,{empty_cth,pre_init_per_suite, + [config_clash_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_init_per_suite, + [config_clash_SUITE,'$proplist','$proplist',[]]}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{config_clash_SUITE,test_case_1}}, + {?eh,tc_done,{config_clash_SUITE,test_case_1, + {failed,{error,{config_name_already_in_use,[aa]}}}}}, + {?eh,cth,{empty_cth,on_tc_fail, + [config_clash_SUITE,test_case_1, + {config_name_already_in_use,[aa]}, + []]}}, + {?eh,test_stats,{0,1,{0,0}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,cth,{empty_cth,pre_end_per_suite, + [config_clash_SUITE,'$proplist',[]]}}, + {?eh,cth,{empty_cth,post_end_per_suite, + [config_clash_SUITE,'$proplist',ok,[]]}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ], + %% Make sure no 'cth_error' events are received! + [{negative,{?eh,cth_error,'_'},E} || E <- Events]; + test_events(ok) -> ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl new file mode 100644 index 0000000000..5b50548694 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_hook_callbacks_SUITE.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(all_hook_callbacks_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +%% Test server callback functions +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(Config) -> + Config. + +end_per_group(_Config) -> + ok. + +init_per_testcase(skip_case, Config) -> + {skip,"Skipped in init_per_testcase/2"}; +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [{group,test_group},test_case,skip_case]. + +groups() -> + [{test_group,[test_case]}]. + +%% Test cases starts here. +test_case(Config) -> + ok. + +skip_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl new file mode 100644 index 0000000000..f74c757cc1 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/config_clash_SUITE.erl @@ -0,0 +1,43 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(config_clash_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + [{require,aa,yy},{default_config,yy,"this is a default value"}]. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case_1]. + +%% Test cases starts here. +test_case_1() -> + [{require,aa,xx}]. +test_case_1(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl new file mode 100644 index 0000000000..7cdaf2024b --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_end_config_SUITE.erl @@ -0,0 +1,51 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(ct_no_end_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that all pre/post_end_per_* callbacks +%%% are called with correct SuiteName even if no end_per_* config +%%% function exist in the suite, and that the non-exported config +%%% functions fail with 'undef'. + +init_per_suite(Config) -> + Config. + +init_per_group(_Group,Config) -> + Config. + +init_per_testcase(_TC,Config) -> + Config. + +all() -> + [test_case_1, {group,test_group}]. + +groups() -> + [{test_group,[],[test_case_2]}]. + +test_case_1(Config) -> + ok. + +test_case_2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl new file mode 100644 index 0000000000..43c062d66f --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_config_SUITE.erl @@ -0,0 +1,54 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(ct_no_init_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that all +%%% pre/post_init_per_group/testcase callbacks are called with correct +%%% SuiteName even if no init_per_group/testcase function exist in the +%%% suite, and that the non-exported config functions fail with 'undef'. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +end_per_group(_Group,Config) -> + Config. + +end_per_testcase(_TC,Config) -> + Config. + +all() -> + [test_case_1, {group,test_group}]. + +groups() -> + [{test_group,[],[test_case_2]}]. + +test_case_1(Config) -> + ok. + +test_case_2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl new file mode 100644 index 0000000000..85dfe8ca4b --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_no_init_suite_config_SUITE.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(ct_no_init_suite_config_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +%%% This suite is used to verify that pre/post_init_per_suite +%%% callbacks are called with correct SuiteName even if no +%%% init_per_suite function exist in the suite, and that the +%%% non-exported config function fails with 'undef'. + +end_per_suite(Config) -> + Config. + +all() -> + [test_case]. + +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index c00eb5cf93..37742f0d20 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -44,18 +44,18 @@ -export([pre_end_per_suite/3]). -export([post_end_per_suite/4]). --export([pre_init_per_group/3]). --export([post_init_per_group/4]). --export([pre_end_per_group/3]). --export([post_end_per_group/4]). +-export([pre_init_per_group/4]). +-export([post_init_per_group/5]). +-export([pre_end_per_group/4]). +-export([post_end_per_group/5]). --export([pre_init_per_testcase/3]). --export([post_init_per_testcase/4]). --export([pre_end_per_testcase/3]). --export([post_end_per_testcase/4]). +-export([pre_init_per_testcase/4]). +-export([post_init_per_testcase/5]). +-export([pre_end_per_testcase/4]). +-export([post_end_per_testcase/5]). --export([on_tc_fail/3]). --export([on_tc_skip/3]). +-export([on_tc_fail/4]). +-export([on_tc_skip/4]). -export([terminate/1]). @@ -154,150 +154,160 @@ post_end_per_suite(Suite,Config,Return,State) -> %% @doc Called before each init_per_group. %% You can change the config in this function. --spec pre_init_per_group(Group :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_init_per_group(Suite :: atom(), + Group :: atom(), + Config :: config(), + State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_init_per_group, - [Group,Config,State]}}), - ct:log("~w:pre_init_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,State]}}), + ct:log("~w:pre_init_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Config, State}. %% @doc Called after each init_per_group. %% You can change the return value in this function. --spec post_init_per_group(Group :: atom(), +-spec post_init_per_group(Suite :: atom(), + Group :: atom(), Config :: config(), Return :: config() | skip_or_fail(), State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_init_per_group, - [Group,Config,Return,State]}}), - ct:log("~w:post_init_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,Return,State]}}), + ct:log("~w:post_init_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Return, State}. %% @doc Called after each end_per_group. The config/state can be changed here, %% though it will only affect the *end_per_group functions. --spec pre_end_per_group(Group :: atom(), +-spec pre_end_per_group(Suite :: atom(), + Group :: atom(), Config :: config() | skip_or_fail(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_end_per_group, - [Group,Config,State]}}), - ct:log("~w:pre_end_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,State]}}), + ct:log("~w:pre_end_per_group(~w~w) called", [?MODULE,Suite,Group]), {Config, State}. %% @doc Called after each end_per_group. Note that the config cannot be %% changed here, only the status of the group. --spec post_end_per_group(Group :: atom(), +-spec post_end_per_group(Suite :: atom(), + Group :: atom(), Config :: config(), Return :: term(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_end_per_group, - [Group,Config,Return,State]}}), - ct:log("~w:post_end_per_group(~w) called", [?MODULE,Group]), + [Suite,Group,Config,Return,State]}}), + ct:log("~w:post_end_per_group(~w,~w) called", [?MODULE,Suite,Group]), {Return, State}. %% @doc Called before init_per_testcase/2 for each test case. %% You can change the config in this function. --spec pre_init_per_testcase(TC :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_init_per_testcase(Suite :: atom(), + TC :: atom(), + Config :: config(), + State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_init_per_testcase, - [TC,Config,State]}}), - ct:log("~w:pre_init_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,State]}}), + ct:log("~w:pre_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Config, State}. %% @doc Called after init_per_testcase/2, and before the test case. --spec post_init_per_testcase(TC :: atom(), +-spec post_init_per_testcase(Suite :: atom(), + TC :: atom(), Config :: config(), Return :: config() | skip_or_fail(), State :: #state{}) -> {config() | skip_or_fail(), NewState :: #state{}}. -post_init_per_testcase(TC,Config,Return,State) -> +post_init_per_testcase(Suite,TC,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_init_per_testcase, - [TC,Config,Return,State]}}), - ct:log("~w:post_init_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,Return,State]}}), + ct:log("~w:post_init_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Return, State}. %% @doc Called before end_per_testacse/2. No skip or fail allowed here, %% only config additions. --spec pre_end_per_testcase(TC :: atom(), - Config :: config(), - State :: #state{}) -> +-spec pre_end_per_testcase(Suite :: atom(), + TC :: atom(), + Config :: config(), + State :: #state{}) -> {config(), NewState :: #state{}}. -pre_end_per_testcase(TC,Config,State) -> +pre_end_per_testcase(Suite,TC,Config,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, pre_end_per_testcase, - [TC,Config,State]}}), - ct:log("~w:pre_end_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,State]}}), + ct:log("~w:pre_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Config, State}. %% @doc Called after end_per_testcase/2 for each test case. Note that %% the config cannot be changed here, only the status of the test case. --spec post_end_per_testcase(TC :: atom(), +-spec post_end_per_testcase(Suite :: atom(), + TC :: atom(), Config :: config(), Return :: term(), State :: #state{}) -> {ok | skip_or_fail(), NewState :: #state{}}. -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, post_end_per_testcase, - [TC,Config,Return,State]}}), - ct:log("~w:post_end_per_testcase(~w) called", [?MODULE,TC]), + [Suite,TC,Config,Return,State]}}), + ct:log("~w:post_end_per_testcase(~w,~w) called", [?MODULE,Suite,TC]), {Return, State}. %% @doc Called after post_init_per_suite, post_end_per_suite, post_init_per_group, %% post_end_per_group and post_end_per_tc if the suite, group or test case failed. %% This function should be used for extra cleanup which might be needed. %% It is not possible to modify the config or the status of the test run. --spec on_tc_fail(TC :: init_per_suite | end_per_suite | +-spec on_tc_fail(Suite :: atom(), + TC :: init_per_suite | end_per_suite | init_per_group | end_per_group | atom() | {Function :: atom(), GroupName :: atom()}, Reason :: term(), State :: #state{}) -> NewState :: #state{}. -on_tc_fail(TC, Reason, State) -> +on_tc_fail(Suite, TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, on_tc_fail, - [TC,Reason,State]}}), - ct:log("~w:on_tc_fail(~w) called", [?MODULE,TC]), + [Suite,TC,Reason,State]}}), + ct:log("~w:on_tc_fail(~w,~w) called", [?MODULE,Suite,TC]), State. %% @doc Called when a test case is skipped by either user action %% or due to an init function failing. Test case can be %% end_per_suite, init_per_group, end_per_group and the actual test cases. --spec on_tc_skip(TC :: end_per_suite | +-spec on_tc_skip(Suite :: atom(), + TC :: end_per_suite | init_per_group | end_per_group | atom() | {Function :: atom(), GroupName :: atom()}, {tc_auto_skip, {failed, {Mod :: atom(), Function :: atom(), Reason :: term()}}} | {tc_user_skip, {skipped, Reason :: term()}}, State :: #state{}) -> NewState :: #state{}. -on_tc_skip(TC, Reason, State) -> +on_tc_skip(Suite, TC, Reason, State) -> gen_event:notify( ?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, on_tc_skip, - [TC,Reason,State]}}), - ct:log("~w:on_tc_skip(~w) called", [?MODULE,TC]), + [Suite,TC,Reason,State]}}), + ct:log("~w:on_tc_skip(~w,~w) called", [?MODULE,Suite,TC]), State. %% @doc Called when the scope of the CTH is done, this depends on diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl index 559b22bc9f..141b933697 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_post_suite_cth.erl @@ -45,29 +45,29 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State).
-pre_init_per_group(Group,Config,State) ->
- empty_cth:pre_init_per_group(Group,Config,State).
+pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) ->
- empty_cth:post_init_per_group(Group,Config,Return,State).
+post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) ->
- empty_cth:pre_end_per_group(Group,Config,State).
+pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) ->
- empty_cth:post_end_per_group(Group,Config,Return,State).
+post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) ->
- empty_cth:pre_init_per_testcase(TC,Config,State).
+pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) ->
- empty_cth:post_end_per_testcase(TC,Config,Return,State).
+post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) ->
- empty_cth:on_tc_fail(TC,Reason,State).
+on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) ->
- empty_cth:on_tc_skip(TC,Reason,State).
+on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) ->
empty_cth:terminate(State).
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl index 51202443bf..07d7c84ed5 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fail_pre_suite_cth.erl @@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl new file mode 100644 index 0000000000..59a3d5cbf9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/fallback_cth.erl @@ -0,0 +1,81 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(fallback_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Group,Config,State) -> + empty_cth:pre_init_per_group(fallback_nosuite,Group,Config,State). + +post_init_per_group(Group,Config,Return,State) -> + empty_cth:post_init_per_group(fallback_nosuite,Group,Config,Return,State). + +pre_end_per_group(Group,Config,State) -> + empty_cth:pre_end_per_group(fallback_nosuite,Group,Config,State). + +post_end_per_group(Group,Config,Return,State) -> + empty_cth:post_end_per_group(fallback_nosuite,Group,Config,Return,State). + +pre_init_per_testcase(TC,Config,State) -> + empty_cth:pre_init_per_testcase(fallback_nosuite,TC,Config,State). + +post_init_per_testcase(TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(fallback_nosuite,TC,Config,Return,State). + +pre_end_per_testcase(TC,Config,State) -> + empty_cth:pre_end_per_testcase(fallback_nosuite,TC,Config,State). + +post_end_per_testcase(TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(fallback_nosuite,TC,Config,Return,State). + +on_tc_fail(TC, Reason, State) -> + empty_cth:on_tc_fail(fallback_nosuite,TC,Reason,State). + +on_tc_skip(TC, Reason, State) -> + empty_cth:on_tc_skip(fallback_nosuite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl index b49cbe7fb4..679f076f3a 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/minimal_terminate_cth.erl @@ -29,13 +29,13 @@ %% CT Hooks -export([init/2]). -export([terminate/1]). --export([on_tc_skip/3]). +-export([on_tc_skip/4]). init(Id, Opts) -> empty_cth:init(Id, Opts). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite, TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl index a687743641..95bb76b4c1 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/prio_cth.erl @@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl index 4d9c60f1ca..3562d39967 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/recover_post_suite_cth.erl @@ -47,35 +47,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/typer/src/typer.appup.src b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl index 3b7464a97c..fded4c02ab 100644 --- a/lib/typer/src/typer.appup.src +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/repeat_SUITE.erl @@ -1,7 +1,7 @@ -%% -*- erlang -*- +%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. 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. @@ -16,7 +16,27 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"%VSN%", - [{<<".*">>,[{restart_application, typer}]}], - [{<<".*">>,[{restart_application, typer}]}] -}. +%% + +-module(repeat_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case_1, test_case_2]. + +%% Test cases starts here. +test_case_1(_Config) -> + timer:sleep(10000), + ok. + +test_case_2(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl index 494f398fc1..b9d9d4cec1 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/same_id_cth.erl @@ -48,35 +48,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl new file mode 100644 index 0000000000..6d1302fd35 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/seq_SUITE.erl @@ -0,0 +1,45 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(seq_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [{sequence,seq1}]. + +sequences() -> + [{seq1,[test_case_1,test_case_2]}]. + +%% Test cases starts here. +test_case_1(_Config) -> + exit(failed_on_purpose). + +test_case_2(_Config) -> + ct:fail("This test shall never be run since test_case_1 fails " + "and they are run in sequence"). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec new file mode 100644 index 0000000000..a271c5e8b2 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip.spec @@ -0,0 +1,8 @@ +{suites,".",[all_hook_callbacks_SUITE, + skip_init_SUITE, + skip_req_SUITE, + skip_fail_SUITE, + skip_group_SUITE, + skip_case_SUITE]}. +{skip_suites,".",all_hook_callbacks_SUITE,"Skipped in spec"}. +{skip_cases,".",skip_case_SUITE,skip_in_spec,"Skipped in spec"}. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl new file mode 100644 index 0000000000..dad80ae914 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_case_SUITE.erl @@ -0,0 +1,106 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_case_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(skip_in_init,Config) -> + {skip,"Skipped in init_per_testcase/2"}; +init_per_testcase(fail_in_init,Config) -> + ct:fail("Failed in init_per_testcase/2"); +init_per_testcase(exit_in_init,Config) -> + exit(self(),"Exit in init_per_testcase/2"); +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(fail_in_end,_) -> + ct:fail("Failed in end_per_testcase/2"); +end_per_testcase(exit_in_end,_) -> + exit(self(),"Exit in end_per_testcase/2"); +end_per_testcase(_,_) -> + ok. + +all() -> + [skip_in_spec, + skip_in_init, + fail_in_init, + exit_in_init, + fail_in_end, + exit_in_end, + skip_in_case, + req_auto_skip, + fail_auto_skip + ]. + +%% Test cases starts here. +skip_in_spec(Config) -> + ct:fail("This test shall never be run. " + "It shall be skipped in the test spec."). + +skip_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall be skipped in init_per_testcase/2."). + +fail_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall fail in init_per_testcase/2."). + +exit_in_init(Config) -> + ct:fail("This test shall never be run. " + "It shall exit in init_per_testcase/2."). + +fail_in_end(Config) -> + ok. + +exit_in_end(Config) -> + ok. + +skip_in_case(Config) -> + {skip,"Skipped in test case function"}. + +req_auto_skip() -> + [{require,whatever}]. +req_auto_skip(Config) -> + ct:fail("This test shall never be run due to " + "failed require"). + +fail_auto_skip() -> + faulty_return_value. +fail_auto_skip(Config) -> + ct:fail("This test shall never be run due to " + "faulty return from info function"). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl new file mode 100644 index 0000000000..16f015fe7a --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_cth.erl @@ -0,0 +1,182 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +%% Send a cth_error event if a callback is called with unexpected arguments +-define(fail(Info), + gen_event:notify( + ?CT_EVMGR_REF, + #event{ name = cth_error, + node = node(), + data = {illegal_hook_callback,{?MODULE,?FUNCTION_NAME,Info}}})). + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + Suite==skip_init_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==skip_case_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + Suite==skip_init_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==skip_case_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + Suite==skip_case_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + Suite==skip_case_SUITE + orelse Suite==skip_group_SUITE + orelse Suite==seq_SUITE + orelse Suite==repeat_SUITE + orelse Suite==config_clash_SUITE + orelse ?fail(Suite), + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + (Suite==skip_group_SUITE andalso Group==test_group_3) + orelse ?fail({Suite,Group}), + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + (Suite==skip_group_SUITE andalso Group==test_group_3) + orelse ?fail({Suite,Group}), + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + ?fail({Suite,Group}), + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + ?fail({Suite,Group}), + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_init + orelse TC==fail_in_init + orelse TC==exit_in_init + orelse TC==fail_in_end + orelse TC==exit_in_end + orelse TC==skip_in_case)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). + +post_init_per_testcase(Suite,TC,Config,Return,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_init + orelse TC==fail_in_init + orelse TC==exit_in_init + orelse TC==fail_in_end + orelse TC==exit_in_end + orelse TC==skip_in_case)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_case + orelse TC==fail_in_end + orelse TC==exit_in_end)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + (Suite==skip_case_SUITE andalso (TC==skip_in_case + orelse TC==fail_in_end + orelse TC==exit_in_end)) + orelse (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==repeat_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC,Reason,State) -> + (Suite==seq_SUITE andalso TC==test_case_1) + orelse (Suite==config_clash_SUITE andalso TC==test_case_1) + orelse ?fail({Suite,TC}), + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(all_hook_callbacks_SUITE=Suite,all=TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) + when (Suite==skip_init_SUITE + orelse Suite==skip_req_SUITE + orelse Suite==skip_fail_SUITE) + andalso + (TC==init_per_suite + orelse TC==test_case + orelse TC==end_per_suite) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(skip_group_SUITE=Suite,TC={C,G},Reason,State) + when (C==init_per_group orelse C==test_case orelse C==end_per_group) andalso + (G==test_group_1 orelse G==test_group_2 orelse G==test_group_3) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(skip_case_SUITE=Suite,TC,Reason,State) + when TC==skip_in_spec; + TC==skip_in_init; + TC==fail_in_init; + TC==exit_in_init; + TC==skip_in_case; + TC==req_auto_skip; + TC==fail_auto_skip -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) + when (Suite==seq_SUITE andalso TC==test_case_2) + orelse (Suite==repeat_SUITE andalso TC==test_case_2) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State); +on_tc_skip(Suite,TC,Reason,State) -> + ?fail({Suite,TC}), + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl new file mode 100644 index 0000000000..9f5dfee6b9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_fail_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_fail_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + faulty_return_value. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl new file mode 100644 index 0000000000..d3b848bfbd --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_group_SUITE.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_group_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +group(test_group_1) -> + [{require,whatever}]; +group(test_group_2) -> + faulty_return_value; +group(_) -> + []. + +init_per_group(test_group_3,Config) -> + {skip,"Skipped in init_per_group/2"}; +init_per_group(_,Config) -> + ct:fail("This shall never be run due to auto_skip from group/1"). + +end_per_group(_,_) -> + ct:fail("This shall never be run"). + +all() -> + [{group,test_group_1}, + {group,test_group_2}, + {group,test_group_3}]. + +groups() -> + [{test_group_1,[test_case]}, + {test_group_2,[test_case]}, + {test_group_3,[test_case]}]. + +%% Test cases starts here. +test_case(_Config) -> + ct:fail("This test case shall never be run due to skip on group level"). + diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl new file mode 100644 index 0000000000..70305421ac --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_init_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_init_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + []. + +init_per_suite(Config) -> + {skip,"Skipped in init_per_suite/1"}. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl index d5b347e723..48a2d70e22 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_post_suite_cth.erl @@ -45,35 +45,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl index 36abac0bf8..d638954d3c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_end_cth.erl @@ -46,36 +46,36 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {{skip, "Test skip"}, State}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl new file mode 100644 index 0000000000..e1d261d59a --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_init_tc_cth.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_pre_init_tc_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + + +%% CT Hooks +-compile(export_all). + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), + {{skip, "Skipped in pre_init_per_testcase"}, State}. + +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl index fa510b2d54..d7b07ee33c 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_pre_suite_cth.erl @@ -46,35 +46,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl new file mode 100644 index 0000000000..bc69dd5ea4 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/skip_req_SUITE.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. 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(skip_req_SUITE). + +-compile(export_all). + +-include("ct.hrl"). + +suite() -> + [{require,whatever}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + ok. + +init_per_group(_,Config) -> + Config. + +end_per_group(_,_) -> + ok. + +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_) -> + ok. + +all() -> + [test_case]. + +%% Test cases starts here. +test_case(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl index 7ec0d458b6..c6e0419c50 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/state_update_cth.erl @@ -48,44 +48,44 @@ post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State), {Return, [post_end_per_suite|State]}. -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State), +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State), {Config, [pre_init_per_group|State]}. -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State), +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State), {Return, [post_init_per_group|State]}. -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {Config, [pre_end_per_group|State]}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State), +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State), {Return, [post_end_per_group|State]}. -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State), +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), {Config, [pre_init_per_testcase|State]}. -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State), +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State), {Return, [post_init_per_testcase|State]}. -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State), +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State), {Config, [pre_end_per_testcase|State]}. -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State), +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State), {Return, [post_end_per_testcase|State]}. -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State), +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State), [on_tc_fail|State]. -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State), +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State), [on_tc_skip|State]. terminate(State) -> diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl index 2b9e726819..10a7047899 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/undef_cth.erl @@ -44,35 +44,35 @@ pre_end_per_suite(Suite,Config,State) -> post_end_per_suite(Suite,Config,Return,State) -> empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State). +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State). +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State). +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State). +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State). +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State). +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index d48981f667..f933c7702e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -50,43 +50,43 @@ post_end_per_suite(Suite,Config,Return,State) -> NewConfig = [{post_end_per_suite,?now}|Config], {NewConfig,NewConfig}. -pre_init_per_group(Group,Config,State) -> - empty_cth:pre_init_per_group(Group,Config,State), +pre_init_per_group(Suite, Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State), {[{pre_init_per_group,?now}|Config],State}. -post_init_per_group(Group,Config,Return,State) -> - empty_cth:post_init_per_group(Group,Config,Return,State), +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State), {[{post_init_per_group,?now}|Return],State}. -pre_end_per_group(Group,Config,State) -> - empty_cth:pre_end_per_group(Group,Config,State), +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State), {[{pre_end_per_group,?now}|Config],State}. -post_end_per_group(Group,Config,Return,State) -> - empty_cth:post_end_per_group(Group,Config,Return,State), +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State), {[{post_end_per_group,?now}|Config],State}. -pre_init_per_testcase(TC,Config,State) -> - empty_cth:pre_init_per_testcase(TC,Config,State), +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State), {[{pre_init_per_testcase,?now}|Config],State}. -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State), +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State), {[{post_init_per_testcase,?now}|Config],State}. -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State), +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State), {[{pre_end_per_testcase,?now}|Config],State}. -post_end_per_testcase(TC,Config,Return,State) -> - empty_cth:post_end_per_testcase(TC,Config,Return,State), +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State), {[{post_end_per_testcase,?now}|Config],State}. -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl index 71d84781e0..b29256a77e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_config_cth.erl @@ -60,37 +60,37 @@ post_end_per_suite(Suite,Config,Return,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> true = ?val(post_init_per_suite, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:pre_init_per_group(Group, + empty_cth:pre_init_per_group(Suite,Group, [{pre_init_per_group,true} | Config], State). -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> true = ?val(pre_init_per_group, Return), test_group = ct:get_config(group_cfg), - empty_cth:post_init_per_group(Group, + empty_cth:post_init_per_group(Suite,Group, Config, [{post_init_per_group,true} | Return], State). -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> true = ?val(post_init_per_group, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:pre_end_per_group(Group, + empty_cth:pre_end_per_group(Suite,Group, [{pre_end_per_group,true} | Config], State). -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> true = ?val(pre_end_per_group, Config), ct_no_config_SUITE = ct:get_config(suite_cfg), test_group = ct:get_config(group_cfg), - empty_cth:post_end_per_group(Group,Config,Return,State). + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> true = ?val(post_init_per_suite, Config), case ?val(name, ?val(tc_group_properties, Config)) of undefined -> @@ -102,19 +102,19 @@ pre_init_per_testcase(TC,Config,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"), TC = ct:get_config(CfgKey), - empty_cth:pre_init_per_testcase(TC, + empty_cth:pre_init_per_testcase(Suite,TC, [{pre_init_per_testcase,true} | Config], State). %%! TODO: Verify Config also in post_init and pre_end! -post_init_per_testcase(TC,Config,Return,State) -> - empty_cth:post_init_per_testcase(TC,Config,Return,State). +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> - empty_cth:pre_end_per_testcase(TC,Config,State). +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> true = ?val(post_init_per_suite, Config), true = ?val(pre_init_per_testcase, Config), case ?val(name, ?val(tc_group_properties, Config)) of @@ -127,13 +127,13 @@ post_end_per_testcase(TC,Config,Return,State) -> ct_no_config_SUITE = ct:get_config(suite_cfg), CfgKey = list_to_atom(atom_to_list(TC) ++ "_cfg"), TC = ct:get_config(CfgKey), - empty_cth:post_end_per_testcase(TC,Config,Return,State). + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl index 9abd2e5e83..42e086b96e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/verify_data_dir_cth.erl @@ -62,43 +62,43 @@ post_end_per_suite(Suite,Config,Return,State) -> check_dirs(State,Config), empty_cth:post_end_per_suite(Suite,Config,Return,State). -pre_init_per_group(Group,Config,State) -> +pre_init_per_group(Suite,Group,Config,State) -> check_dirs(State,Config), - empty_cth:pre_init_per_group(Group,Config,State). + empty_cth:pre_init_per_group(Suite,Group,Config,State). -post_init_per_group(Group,Config,Return,State) -> +post_init_per_group(Suite,Group,Config,Return,State) -> check_dirs(State,Return), - empty_cth:post_init_per_group(Group,Config,Return,State). + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). -pre_end_per_group(Group,Config,State) -> +pre_end_per_group(Suite,Group,Config,State) -> check_dirs(State,Config), - empty_cth:pre_end_per_group(Group,Config,State). + empty_cth:pre_end_per_group(Suite,Group,Config,State). -post_end_per_group(Group,Config,Return,State) -> +post_end_per_group(Suite,Group,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_end_per_group(Group,Config,Return,State). + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). -pre_init_per_testcase(TC,Config,State) -> +pre_init_per_testcase(Suite,TC,Config,State) -> check_dirs(State,Config), - empty_cth:pre_init_per_testcase(TC,Config,State). + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). -post_init_per_testcase(TC,Config,Return,State) -> +post_init_per_testcase(Suite,TC,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_init_per_testcase(TC,Config,Return,State). + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). -pre_end_per_testcase(TC,Config,State) -> +pre_end_per_testcase(Suite,TC,Config,State) -> check_dirs(State,Config), - empty_cth:pre_end_per_testcase(TC,Config,State). + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). -post_end_per_testcase(TC,Config,Return,State) -> +post_end_per_testcase(Suite,TC,Config,Return,State) -> check_dirs(State,Config), - empty_cth:post_end_per_testcase(TC,Config,Return,State). + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). -on_tc_fail(TC, Reason, State) -> - empty_cth:on_tc_fail(TC,Reason,State). +on_tc_fail(Suite,TC, Reason, State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). -on_tc_skip(TC, Reason, State) -> - empty_cth:on_tc_skip(TC,Reason,State). +on_tc_skip(Suite,TC, Reason, State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). terminate(State) -> empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE.erl index f8b6a379f6..76611a2db3 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE.erl @@ -363,14 +363,17 @@ skip_first_tc1(Suite) -> {?eh,tc_start,{Suite,tc1}}, {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{'_',0,{0,0}}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,1}}}, + {?eh,tc_start,{Suite,{init_per_group,g,[]}}}, {?eh,tc_done,{Suite,{init_per_group,g,[]},?skipped}}, {?eh,tc_auto_skip,{Suite,{tc1,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,2}}}, {?eh,tc_auto_skip,{Suite,{tc2,g},?skip_reason}}, {?eh,test_stats,{'_',0,{0,3}}}, {?eh,tc_auto_skip,{Suite,{end_per_group,g},?skip_reason}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,4}}}, {?eh,tc_start,{Suite,end_per_suite}}, @@ -390,10 +393,12 @@ skip_tc1_in_group(Suite) -> {?eh,tc_start,{Suite,tc1}}, {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{'_',0,{0,0}}}, + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,1}}}, {?eh,tc_start,{Suite,{end_per_group,g,[]}}}, {?eh,tc_done,{Suite,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{Suite,tc2}}, {?eh,tc_done,{Suite,tc2,?skipped}}, {?eh,test_stats,{'_',0,{0,2}}}, {?eh,tc_start,{Suite,end_per_suite}}, diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index 42ec685c16..884217afc2 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -73,7 +73,9 @@ all() -> relative_path, url, logdir, - fail_pre_init_per_suite + fail_pre_init_per_suite, + skip_case_in_spec, + skip_suite_in_spec ]. %%-------------------------------------------------------------------- @@ -119,6 +121,18 @@ fail_pre_init_per_suite(Config) when is_list(Config) -> run(fail_pre_init_per_suite,[fail_pre_init_per_suite, {cth_surefire,[{path,Path}]}],Path,Config,[],Suites). +skip_case_in_spec(Config) -> + DataDir = ?config(data_dir,Config), + Spec = filename:join(DataDir,"skip_one_case.spec"), + Path = "skip_case_in_spec.xml", + run_spec(skip_case_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec). + +skip_suite_in_spec(Config) -> + DataDir = ?config(data_dir,Config), + Spec = filename:join(DataDir,"skip_one_suite.spec"), + Path = "skip_suite_in_spec.xml", + run_spec(skip_suite_in_spec,[{cth_surefire,[{path,Path}]}],Path,Config,Spec). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -129,8 +143,15 @@ run(Case,CTHs,Report,Config,ExtraOpts) -> Suite = filename:join(DataDir, "surefire_SUITE"), run(Case,CTHs,Report,Config,ExtraOpts,Suite). run(Case,CTHs,Report,Config,ExtraOpts,Suite) -> - {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], - Config), + Test = [{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], + do_run(Case, Report, Test, Config). + +run_spec(Case,CTHs,Report,Config,Spec) -> + Test = [{spec,Spec},{ct_hooks,CTHs},{label,Case}], + do_run(Case, Report, Test, Config). + +do_run(Case, Report, Test, Config) -> + {Opts,ERPid} = setup(Test, Config), ok = execute(Case, Opts, ERPid, Config), LogDir = case lists:keyfind(logdir,1,Opts) of @@ -201,7 +222,10 @@ test_suite_events(pass_SUITE) -> {?eh,test_stats,{1,0,{0,0}}}, {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,tc_done,{ct_framework,end_per_suite,ok}}]; -test_suite_events(_) -> +test_suite_events(skip_all_surefire_SUITE) -> + [{?eh,tc_user_skip,{skip_all_surefire_SUITE,all,"skipped in spec"}}, + {?eh,test_stats,{0,0,{1,0}}}]; +test_suite_events(Test) -> [{?eh,tc_start,{surefire_SUITE,init_per_suite}}, {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, {?eh,tc_start,{surefire_SUITE,tc_ok}}, @@ -210,46 +234,55 @@ test_suite_events(_) -> {?eh,tc_start,{surefire_SUITE,tc_fail}}, {?eh,tc_done,{surefire_SUITE,tc_fail, {failed,{error,{test_case_failed,"this test should fail"}}}}}, - {?eh,test_stats,{1,1,{0,0}}}, - {?eh,tc_start,{surefire_SUITE,tc_skip}}, - {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, - {?eh,test_stats,{1,1,{1,0}}}, - {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, - {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, - {auto_skipped,{require_failed,'_'}}}}, - {?eh,test_stats,{1,1,{1,1}}}, - [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}}, - {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}}, - {?eh,tc_start,{surefire_SUITE,tc_ok}}, - {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, - {?eh,test_stats,{2,1,{1,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_fail}}, - {?eh,tc_done,{surefire_SUITE,tc_fail, - {failed,{error,{test_case_failed,"this test should fail"}}}}}, - {?eh,test_stats,{2,2,{1,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_skip}}, - {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, - {?eh,test_stats,{2,2,{2,1}}}, - {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, - {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, - {auto_skipped,{require_failed,'_'}}}}, - {?eh,test_stats,{2,2,{2,2}}}, - {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}}, - {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}], - [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, - {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, - {failed,{error,all_cases_should_be_skipped}}}}, - {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail}, - {failed, - {surefire_SUITE,init_per_group, - {'EXIT',all_cases_should_be_skipped}}}}}, - {?eh,test_stats,{2,2,{2,3}}}, - {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail}, - {failed, - {surefire_SUITE,init_per_group, - {'EXIT',all_cases_should_be_skipped}}}}}], - {?eh,tc_start,{surefire_SUITE,end_per_suite}}, - {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + {?eh,test_stats,{1,1,{0,0}}}] ++ + tc_skip_events(Test,undefined) ++ + [{?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {auto_skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{1,1,{1,1}}}, + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{surefire_SUITE,tc_ok}}, + {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, + {?eh,test_stats,{2,1,{1,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_fail}}, + {?eh,tc_done,{surefire_SUITE,tc_fail, + {failed,{error,{test_case_failed,"this test should fail"}}}}}, + {?eh,test_stats,{2,2,{1,1}}}] ++ + tc_skip_events(Test,g) ++ + [{?eh,test_stats,{2,2,{2,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {auto_skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{2,2,{2,2}}}, + {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}], + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, + {failed,{error,all_cases_should_be_skipped}}}}, + {?eh,tc_auto_skip,{surefire_SUITE,{tc_ok,g_fail}, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}, + {?eh,test_stats,{2,2,{2,3}}}, + {?eh,tc_auto_skip,{surefire_SUITE,{end_per_group,g_fail}, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}], + {?eh,tc_start,{surefire_SUITE,end_per_suite}}, + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + +tc_skip_events(skip_case_in_spec,Group) -> + [{?eh,tc_user_skip,{surefire_SUITE,tc_skip_name(Group),"skipped in spec"}}]; +tc_skip_events(_Test,_Group) -> + [{?eh,tc_start,{surefire_SUITE,tc_skip}}, + {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}]. + +tc_skip_name(undefined) -> + tc_skip; +tc_skip_name(Group) -> + {tc_skip,Group}. test_events(fail_pre_init_per_suite) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, @@ -257,6 +290,10 @@ test_events(fail_pre_init_per_suite) -> test_suite_events(pass_SUITE) ++ test_suite_events(fail_SUITE, {1,0,{0,1}}) ++ [{?eh,stop_logging,[]}]; +test_events(skip_suite_in_spec) -> + [{?eh,start_logging,'_'},{?eh,start_info,{1,1,0}}] ++ + test_suite_events(skip_all_surefire_SUITE) ++ + [{?eh,stop_logging,[]}]; test_events(Test) -> [{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++ test_suite_events(Test) ++ @@ -364,6 +401,8 @@ failed_or_skipped([]) -> events_to_result(E) -> events_to_result(E, []). +events_to_result([{?eh,tc_user_skip,{_Suite,all,_}}|E], Result) -> + events_to_result(E, [[[s]]|Result]); events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) -> {Suite,Rest} = events_to_result1(E), events_to_result(Rest, [[[s]|Suite]|Result]); @@ -382,7 +421,7 @@ events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) -> events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> {Suite,Rest} = events_to_result1(E), {[result(R)|Suite],Rest}; -events_to_result1([{?eh,tc_auto_skip,_}|E]) -> +events_to_result1([{?eh,Skip,_}|E]) when Skip==tc_auto_skip; Skip==tc_user_skip -> {Suite,Rest} = events_to_result1(E), {[[s]|Suite],Rest}; events_to_result1([_|E]) -> diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec new file mode 100644 index 0000000000..42df8a7d1a --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_case.spec @@ -0,0 +1,2 @@ +{suites,".",surefire_SUITE}. +{skip_cases,".",surefire_SUITE,tc_skip,"skipped in spec"}. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec new file mode 100644 index 0000000000..57966328ab --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/skip_one_suite.spec @@ -0,0 +1,2 @@ +{suites,".",[skip_all_surefire_SUITE]}. +{skip_suites,".",skip_all_surefire_SUITE,"skipped in spec"}. diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index 228d900545..ea8a1a5662 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -161,6 +161,7 @@ test_events(ts_if_1) -> {?eh,tc_start,{ts_if_1_SUITE,tc4}}, {?eh,tc_done,{ts_if_1_SUITE,tc4,{failed,{error,failed_on_purpose}}}}, {?eh,test_stats,{1,2,{0,1}}}, + {?eh,tc_start,{ts_if_1_SUITE,tc5}}, {?eh,tc_done,{ts_if_1_SUITE,tc5,{auto_skipped,{sequence_failed,seq1,tc4}}}}, {?eh,test_stats,{1,2,{0,2}}}, diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index e926abd885..05a452b99d 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -765,23 +765,23 @@ locate({parallel,TEvs}, Node, Evs, Config) -> {Done,RemEvs2,length(RemEvs2)} end; %% end_per_group auto- or user skipped - (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize}) + (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize}) when AutoOrUserSkip == tc_auto_skip; AutoOrUserSkip == tc_user_skip -> RemEvs1 = lists:dropwhile( fun({EH,#event{name=tc_auto_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G -> case match_data(R, Reason) of match -> false; _ -> true end; ({EH,#event{name=tc_user_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G -> case match_data(R, Reason) of match -> false; _ -> true @@ -1008,20 +1008,20 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> {Done,RemEvs2,length(RemEvs2)} end; %% end_per_group auto-or user skipped - (TEv={TEH,AutoOrUserSkip,{M,end_per_group,R}}, {Done,RemEvs,_RemSize}) + (TEv={TEH,AutoOrUserSkip,{M,{end_per_group,G},R}}, {Done,RemEvs,_RemSize}) when AutoOrUserSkip == tc_auto_skip; AutoOrUserSkip == tc_user_skip -> RemEvs1 = lists:dropwhile( fun({EH,#event{name=tc_auto_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M, Reason == R -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R -> false; ({EH,#event{name=tc_user_skip, node=EvNode, - data={Mod,end_per_group,Reason}}}) when - EH == TEH, EvNode == Node, Mod == M, Reason == R -> + data={Mod,{end_per_group,EvGroupName},Reason}}}) when + EH == TEH, EvNode == Node, Mod == M, EvGroupName == G, Reason == R -> false; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when @@ -1264,10 +1264,10 @@ log_events1([E={_EH,tc_done,{_M,{end_per_group,_GrName,Props},_R}} | Evs], Dev, io:format(Dev, "~s~p]},~n", [Ind,E]), log_events1(Evs, Dev, Ind--" ") end; -log_events1([E={_EH,tc_auto_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) -> +log_events1([E={_EH,tc_auto_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) -> io:format(Dev, "~s~p],~n", [Ind,E]), log_events1(Evs, Dev, Ind--" "); -log_events1([E={_EH,tc_user_skip,{_M,end_per_group,_Reason}} | Evs], Dev, Ind) -> +log_events1([E={_EH,tc_user_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) -> io:format(Dev, "~s~p],~n", [Ind,E]), log_events1(Evs, Dev, Ind--" "); log_events1([E], Dev, Ind) -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 44c3fc4f06..9b5e1736a8 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -71,6 +71,46 @@ PACKED_OPENSSL_VERSION(MAJ,MIN,FIX,('a'-1)) +/* LibreSSL was cloned from OpenSSL 1.0.1g and claims to be API and BPI compatible + * with 1.0.1. + * + * LibreSSL has the same names on include files and symbols as OpenSSL, but defines + * the OPENSSL_VERSION_NUMBER to be >= 2.0.0 + * + * Therefor works tests like this as intendend: + * OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) + * (The test is for example "2.4.2" >= "1.0.0" although the test + * with the cloned OpenSSL test would be "1.0.1" >= "1.0.0") + * + * But tests like this gives wrong result: + * OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) + * (The test is false since "2.4.2" < "1.1.0". It should have been + * true because the LibreSSL API version is "1.0.1") + * + */ + +#ifdef LIBRESSL_VERSION_NUMBER +/* A macro to test on in this file */ +#define HAS_LIBRESSL +#endif + +#ifdef HAS_LIBRESSL +/* LibreSSL dislikes FIPS */ +# ifdef FIPS_SUPPORT +# undef FIPS_SUPPORT +# endif + +/* LibreSSL wants the 1.0.1 API */ +# define NEED_EVP_COMPATIBILITY_FUNCTIONS +#endif + + +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) +# define NEED_EVP_COMPATIBILITY_FUNCTIONS +#endif + + + #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) #include <openssl/modes.h> #endif @@ -120,7 +160,9 @@ #endif #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) -# define HAVE_CHACHA20_POLY1305 +# ifndef HAS_LIBRESSL +# define HAVE_CHACHA20_POLY1305 +# endif #endif #if OPENSSL_VERSION_NUMBER <= PACKED_OPENSSL_VERSION(0,9,8,'l') @@ -205,8 +247,8 @@ do { \ } \ } while (0) -#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) +#ifdef NEED_EVP_COMPATIBILITY_FUNCTIONS /* * In OpenSSL 1.1.0, most structs are opaque. That means that * the structs cannot be allocated as automatic variables on the diff --git a/lib/crypto/c_src/crypto_callback.h b/lib/crypto/c_src/crypto_callback.h index 2641cc0c8b..489810116f 100644 --- a/lib/crypto/c_src/crypto_callback.h +++ b/lib/crypto/c_src/crypto_callback.h @@ -19,7 +19,7 @@ */ #include <openssl/crypto.h> -#if OPENSSL_VERSION_NUMBER < 0x10100000L +#ifdef NEED_EVP_COMPATIBILITY_FUNCTIONS # define CCB_FILE_LINE_ARGS #else # define CCB_FILE_LINE_ARGS , const char *file, int line diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 5b28f7ae86..f517c51ec1 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-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. @@ -48,5 +48,5 @@ {applications, [compiler, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.0", - "kernel-5.0","hipe-3.15.1","erts-8.0", + "kernel-5.0","hipe-3.15.4","erts-8.0", "compiler-7.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index dc2238e63a..4c29b4f1eb 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -1344,8 +1344,6 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) -> {Msg, Force} = case t_is_none(ArgType0) of true -> - PatString = format_patterns(Pats), - PatTypes = [PatString, format_type(OrigArgType, State1)], %% See if this is covered by an earlier clause or if it %% simply cannot match OrigArgTypes = @@ -1353,14 +1351,24 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) -> true -> Any = t_any(), [Any || _ <- Pats]; false -> t_to_tlist(OrigArgType) end, + PatString = format_patterns(Pats), + ArgTypeString = format_type(OrigArgType, State1), + BindResOrig = + bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1), Tag = - case bind_pat_vars(Pats, OrigArgTypes, [], Map1, State1) of + case BindResOrig of {error, bind, _, _, _} -> pattern_match; {error, record, _, _, _} -> record_match; {error, opaque, _, _, _} -> opaque_match; {_, _} -> pattern_match_cov end, - {{Tag, PatTypes}, false}; + PatTypes = case BindResOrig of + {error, opaque, _, _, OpaqueType} -> + [PatString, ArgTypeString, + format_type(OpaqueType, State1)]; + _ -> [PatString, ArgTypeString] + end, + {{Tag, PatTypes}, false}; false -> %% Try to find out if this is a default clause in a list %% comprehension and suppress this. A real Hack(tm) diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index eb63e9e695..bfd3f84fc5 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -233,12 +233,8 @@ contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) -> get_default_plt() -> case os:getenv("DIALYZER_PLT") of false -> - case os:getenv("HOME") of - false -> - plt_error("The HOME environment variable needs to be set " ++ - "so that Dialyzer knows where to find the default PLT"); - HomeDir -> filename:join(HomeDir, ".dialyzer_plt") - end; + {ok,[[HomeDir]]} = init:get_argument(home), + filename:join(HomeDir, ".dialyzer_plt"); UserSpecPlt -> UserSpecPlt end. diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index c4f8adf7ee..c3ba44fde7 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2080,8 +2080,6 @@ v2_solve_disjunct(Disj, Map, V2State0) -> var_occurs_everywhere(V, Masks, NotFailed) -> ordsets:is_subset(NotFailed, get_mask(V, Masks)). --dialyzer({no_improper_lists, [v2_solve_disj/10, v2_solve_conj/12]}). - v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval, Failed0) -> Id = C#constraint_list.id, @@ -2100,10 +2098,10 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval, end; v2_solve_disj([], [], _I, _Map, V2State, UL, MapL, Eval, Uneval, Failed) -> {ok, V2State, lists:reverse(Eval), UL, MapL, lists:reverse(Uneval), Failed}; -v2_solve_disj(every_i, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) -> +v2_solve_disj([every_i], Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed) -> NewIs = case Cs of [] -> []; - _ -> [I|every_i] + _ -> [I, every_i] end, v2_solve_disj(NewIs, Cs, I, Map, V2State, UL, MapL, Eval, Uneval, Failed); v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) -> @@ -2199,11 +2197,11 @@ v2_solve_conj([], _Cs, _I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, v2_solve_conj(NewFlags, Cs, 1, Map, Conj, IsFlat, V2State, [], [], [U|VarsUp], Map, NewFlags) end; -v2_solve_conj(every_i, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, +v2_solve_conj([every_i], Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, LastMap, LastFlags) -> NewIs = case Cs of [] -> []; - _ -> [I|every_i] + _ -> [I, every_i] end, v2_solve_conj(NewIs, Cs, I, Map, Conj, IsFlat, V2State, UL, NewFs, VarsUp, LastMap, LastFlags); @@ -2225,8 +2223,8 @@ add_mask_to_flags(Flags, [Im|M], I, L) when I > Im -> add_mask_to_flags(Flags, [_|M], _I, L) -> {umerge_mask(Flags, M), lists:reverse(L)}. -umerge_mask(every_i, _F) -> - every_i; +umerge_mask([every_i]=Is, _F) -> + Is; umerge_mask(Is, F) -> lists:umerge(Is, F). @@ -2242,7 +2240,7 @@ get_flags(#v2_state{constr_data = ConData}=V2State0, C) -> error -> ?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]), V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)}, - {V2State, every_i}; + {V2State, [every_i]}; {ok, failed} -> {V2State0, failed_list}; {ok, {Part,U}} when U =/= [] -> diff --git a/lib/dialyzer/test/abstract_SUITE.erl b/lib/dialyzer/test/abstract_SUITE.erl index 269db3e836..0e84dfab24 100644 --- a/lib/dialyzer/test/abstract_SUITE.erl +++ b/lib/dialyzer/test/abstract_SUITE.erl @@ -7,7 +7,7 @@ -include_lib("common_test/include/ct.hrl"). -include("dialyzer_test_constants.hrl"). --export([suite/0, all/0, init_per_suite/0, init_per_suite/1]). +-export([suite/0, all/0, init_per_suite/0, init_per_suite/1, end_per_suite/1]). -export([generated_case/1]). suite() -> @@ -24,6 +24,10 @@ init_per_suite(Config) -> ok -> [{dialyzer_options, []}|Config] end. +end_per_suite(_Config) -> + %% This function is required since init_per_suite/1 exists. + ok. + generated_case(Config) when is_list(Config) -> %% Equivalent to: %% diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/weird b/lib/dialyzer/test/opaque_SUITE_data/results/weird new file mode 100644 index 0000000000..d7f57cd152 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/weird @@ -0,0 +1,6 @@ + +weird_warning1.erl:15: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #b{q::queue:queue(_)} +weird_warning2.erl:13: Matching of pattern <{'b', Queue}, Key, Value> tagged with a record name violates the declared type of <#a{d::dict:dict(_,_)},'my_key','my_value'> +weird_warning3.erl:14: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') does not have a term of type #a{d::dict:dict(_,_)} | #b{q::queue:queue(_)} (with opaque subterms) as 1st argument +weird_warning3.erl:16: The attempt to match a term of type #a{d::queue:queue(_)} against the pattern {'a', Dict} breaks the opacity of queue:queue(_) +weird_warning3.erl:18: Matching of pattern {'b', Queue} tagged with a record name violates the declared type of #a{d::queue:queue(_)} diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl new file mode 100644 index 0000000000..094138e72b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning1.erl @@ -0,0 +1,18 @@ +-module(weird_warning1). +-export([public_func/0]). + +-record(a, { + d = dict:new() :: dict:dict() + }). + +-record(b, { + q = queue:new() :: queue:queue() + }). + +public_func() -> + add_element(#b{}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl new file mode 100644 index 0000000000..4e4512157b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning2.erl @@ -0,0 +1,14 @@ +-module(weird_warning2). +-export([public_func/0]). + +-record(a, {d = dict:new() :: dict:dict()}). + +-record(b, {q = queue:new() :: queue:queue()}). + +public_func() -> + add_element(#a{}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl new file mode 100644 index 0000000000..b70ca645cb --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/weird/weird_warning3.erl @@ -0,0 +1,19 @@ +-module(weird_warning3). +-export([public_func/0]). + +-record(a, { + d = dict:new() :: dict:dict() + }). + +-record(b, { + q = queue:new() :: queue:queue() + }). + +public_func() -> + %% Notice that t_to_string() will create "#a{d::queue:queue(_)}". + add_element({a, queue:new()}, my_key, my_value). + +add_element(#a{d = Dict}, Key, Value) -> + dict:store(Key, Value, Dict); +add_element(#b{q = Queue}, Key, Value) -> + queue:in({Key, Value}, Queue). diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/httpd_response.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/httpd_response.erl index 47c7fc1b8d..50e0e42786 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/httpd_response.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/httpd_response.erl @@ -34,7 +34,7 @@ -define(PROCEED_RESPONSE(StatusCode, Info), {proceed, [{response,{already_sent, StatusCode, - httpd_util:key1search(Info#mod.data,content_lenght)}}]}). + httpd_util:key1search(Info#mod.data,content_length)}}]}). -include("httpd.hrl"). diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index e8f2f63f86..253f64133c 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -377,6 +377,7 @@ call(SvcName, App, Message) -> | {capabilities, [capability()]} | {capabilities_cb, evaluable()} | {capx_timeout, 'Unsigned32'()} + | {capx_strictness, boolean()} | {disconnect_cb, evaluable()} | {dpr_timeout, 'Unsigned32'()} | {dpa_timeout, 'Unsigned32'()} diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 1b48c0431f..e10804c931 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -580,6 +580,9 @@ opt({K, Tmo}) K == dpa_timeout -> ?IS_UINT32(Tmo); +opt({capx_strictness, B}) -> + is_boolean(B); + opt({length_errors, T}) -> lists:member(T, [exit, handle, discard]); diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 4b394a2dbe..46d231da74 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -128,6 +128,7 @@ %% outgoing DPR; boolean says whether or not %% the request was sent explicitly with %% diameter:call/4. + strict :: boolean(), length_errors :: exit | handle | discard, incoming_maxlen :: integer() | infinity}). @@ -233,6 +234,7 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> proplists:get_value(dpa_timeout, Opts, ?DPA_TIMEOUT)}), Tmo = proplists:get_value(capx_timeout, Opts, ?CAPX_TIMEOUT), + Strictness = proplists:get_value(capx_strictness, Opts, true), OnLengthErr = proplists:get_value(length_errors, Opts, exit), {TPid, Addrs} = start_transport(T, Rest, Svc), @@ -246,6 +248,7 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> mode = M, service = svc(Svc, Addrs), length_errors = OnLengthErr, + strict = Strictness, incoming_maxlen = Maxlen}. %% The transport returns its local ip addresses so that different %% transports on the same service can use different local addresses. @@ -454,6 +457,9 @@ transition({timeout, _}, _) -> %% Outgoing message. transition({send, Msg}, S) -> outgoing(Msg, S); +transition({send, Msg, Route}, S) -> + put_route(Route), + outgoing(Msg, S); %% Request for graceful shutdown at remove_transport, stop_service of %% application shutdown. @@ -483,8 +489,10 @@ transition({'DOWN', _, process, TPid, _}, = S) -> start_next(S); -%% Transport has died after connection timeout. -transition({'DOWN', _, process, _, _}, _) -> +%% Transport has died after connection timeout, or handler process has +%% died. +transition({'DOWN', _, process, Pid, _}, _) -> + erase_route(Pid), ok; %% State query. @@ -494,6 +502,40 @@ transition({state, Pid}, #state{state = S, transport = TPid}) -> %% Crash on anything unexpected. +%% put_route/1 +%% +%% Map identifiers in an outgoing request to be able to lookup the +%% handler process when the answer is received. + +put_route({Pid, Ref, Seqs}) -> + MRef = monitor(process, Pid), + put(Pid, Seqs), + put(Seqs, {Pid, Ref, MRef}). + +%% get_route/1 + +get_route(#diameter_packet{header = #diameter_header{is_request = false}} + = Pkt) -> + Seqs = diameter_codec:sequence_numbers(Pkt), + case erase(Seqs) of + {Pid, Ref, MRef} -> + demonitor(MRef), + erase(Pid), + {Pid, Ref, self()}; + undefined -> + false + end; + +get_route(_) -> + false. + +%% erase_route/1 + +erase_route(Pid) -> + erase(erase(Pid)). + +%% capx/1 + capx(recv_CER) -> 'CER'; capx({'Wait-CEA', _, _}) -> @@ -576,8 +618,7 @@ incoming({Msg, NPid}, S) -> T catch {?MODULE, Name, Pkt} -> - S#state.parent ! {recv, self(), Name, {Pkt, NPid}}, - rcv(Name, Pkt, S) + incoming(Name, Pkt, NPid, S) end; incoming(Msg, S) -> @@ -585,10 +626,15 @@ incoming(Msg, S) -> recv(Msg, S) catch {?MODULE, Name, Pkt} -> - S#state.parent ! {recv, self(), Name, Pkt}, - rcv(Name, Pkt, S) + incoming(Name, Pkt, false, S) end. +%% incoming/4 + +incoming(Name, Pkt, NPid, #state{parent = Pid} = S) -> + Pid ! {recv, self(), get_route(Pkt), Name, Pkt, NPid}, + rcv(Name, Pkt, S). + %% recv/2 recv(#diameter_packet{header = #diameter_header{} = Hdr} @@ -614,6 +660,17 @@ recv1(_, when M < size(Bin) -> invalid(false, incoming_maxlen_exceeded, {size(Bin), H}); +%% Ignore anything but an expected CER/CEA if so configured. This is +%% non-standard behaviour. +recv1(Name, _, #state{state = {'Wait-CEA', _, _}, + strict = false}) + when Name /= 'CEA' -> + ok; +recv1(Name, _, #state{state = recv_CER, + strict = false}) + when Name /= 'CER' -> + ok; + %% Incoming request after outgoing DPR: discard. Don't discard DPR, so %% both ends don't do so when sending simultaneously. recv1(Name, diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index ccf68f4d93..e4f77e3a24 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -1858,13 +1858,6 @@ eq(Any, Id, PeerId) -> %% OctetString() can be specified as an iolist() so test for string %% rather then term equality. -%% transports/1 - -transports(#state{watchdogT = WatchdogT}) -> - ets:select(WatchdogT, [{#watchdog{peer = '$1', _ = '_'}, - [{'is_pid', '$1'}], - ['$1']}]). - %% --------------------------------------------------------------------------- %% # service_info/2 %% --------------------------------------------------------------------------- @@ -1887,7 +1880,6 @@ transports(#state{watchdogT = WatchdogT}) -> -define(ALL_INFO, [capabilities, applications, transport, - pending, options]). %% The rest. @@ -1981,7 +1973,6 @@ complete_info(Item, #state{service = Svc} = S) -> applications -> info_apps(S); transport -> info_transport(S); options -> info_options(S); - pending -> info_pending(S); keys -> ?ALL_INFO ++ ?CAP_INFO ++ ?OTHER_INFO; all -> service_info(?ALL_INFO, S); statistics -> info_stats(S); @@ -2189,13 +2180,6 @@ info_apps(#state{service = #diameter_service{applications = Apps}}) -> mk_app(#diameter_app{} = A) -> lists:zip(record_info(fields, diameter_app), tl(tuple_to_list(A))). -%% info_pending/1 -%% -%% One entry for each outgoing request whose answer is outstanding. - -info_pending(#state{} = S) -> - diameter_traffic:pending(transports(S)). - %% info_info/1 %% %% Extract process_info from connections info. diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl index 482289cb9a..01c51f0856 100644 --- a/lib/diameter/src/base/diameter_sup.erl +++ b/lib/diameter/src/base/diameter_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -42,7 +42,7 @@ -define(TABLES, [{diameter_sequence, [set]}, {diameter_service, [set, {keypos, 3}]}, - {diameter_request, [bag]}, + {diameter_request, [set]}, {diameter_config, [bag, {keypos, 2}]}]). %% start_link/0 diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index d93a3e71e3..bc1ccf4feb 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2016. All Rights Reserved. +%% Copyright Ericsson AB 2013-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. @@ -30,7 +30,7 @@ -export([send_request/4]). %% towards diameter_watchdog --export([receive_message/4]). +-export([receive_message/6]). %% towards diameter_peer_fsm and diameter_watchdog -export([incr/4, @@ -40,11 +40,11 @@ %% towards diameter_service -export([make_recvdata/1, peer_up/1, - peer_down/1, - pending/1]). + peer_down/1]). -%% towards ?MODULE --export([send/1]). %% send from remote node +%% internal +-export([send/1, %% send from remote node + init/1]). %% monitor process start -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). @@ -57,14 +57,12 @@ -define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests -define(DEFAULT_SPAWN_OPTS, []). -%% Table containing outgoing requests for which a reply has yet to be -%% received. +%% Table containing outgoing entries that live and die with +%% peer_up/down. The name is historic, since the table used to contain +%% information about outgoing requests for which an answer has yet to +%% be received. -define(REQUEST_TABLE, diameter_request). -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - %% Record diameter:call/4 options are parsed into. -record(options, {filter = none :: diameter:peer_filter(), @@ -72,7 +70,7 @@ timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, detach = false :: boolean()}). -%% Term passed back to receive_message/4 with every incoming message. +%% Term passed back to receive_message/6 with every incoming message. -record(recvdata, {peerT :: ets:tid(), service_name :: diameter:service_name(), @@ -87,12 +85,12 @@ %% Record stored in diameter_request for each outgoing request. -record(request, - {ref :: match(reference()), %% used to receive answer - caller :: match(pid()), %% calling process - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), %% of connection - packet :: match(#diameter_packet{})}). %% of request + {ref :: reference(), %% used to receive answer + caller :: pid() | undefined, %% calling process + handler :: pid(), %% request process + transport :: pid() | undefined, %% peer process + caps :: #diameter_caps{} | undefined, %% of connection + packet :: #diameter_packet{} | undefined}). %% of request %% --------------------------------------------------------------------------- %% # make_recvdata/1 @@ -113,26 +111,27 @@ make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) -> %% peer_up/1 %% --------------------------------------------------------------------------- -%% Insert an element that is used to detect whether or not there has -%% been a failover when inserting an outgoing request. +%% Start a process that dies with peer_down/1, on which request +%% processes can monitor. There is no other process that dies with +%% peer_down since failover doesn't imply the loss of transport in the +%% case of a watchdog transition into state SUSPECT. peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). + proc_lib:start(?MODULE, init, [TPid]). + +init(TPid) -> + ets:insert(?REQUEST_TABLE, {TPid, self()}), + proc_lib:init_ack(self()), + proc_lib:hibernate(erlang, exit, [{shutdown, TPid}]). %% --------------------------------------------------------------------------- %% peer_down/1 %% --------------------------------------------------------------------------- peer_down(TPid) -> - ets:delete_object(?REQUEST_TABLE, {TPid}), - lists:foreach(fun failover/1, ets:lookup(?REQUEST_TABLE, TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: insert_request/2 sends the notification -%% in that case. - -%% failover/1 - -failover({_TPid, {Pid, TRef}}) -> - Pid ! {failover, TRef}. + [{_, Pid}] = ets:lookup(?REQUEST_TABLE, TPid), + ets:delete(?REQUEST_TABLE, TPid), + Pid ! ok, %% make it die + Pid. %% --------------------------------------------------------------------------- %% incr/4 @@ -207,54 +206,25 @@ incr_rc(Dir, Pkt, TPid, Dict0) -> incr_rc(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}). %% --------------------------------------------------------------------------- -%% pending/1 -%% --------------------------------------------------------------------------- - -pending(TPids) -> - MatchSpec = [{{'$1', - #request{caller = '$2', - handler = '$3', - transport = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$4'} || T <- TPids])], - [{{'$1', [{{caller, '$2'}}, - {{handler, '$3'}}, - {{transport, '$4'}}]}}]}], - - try - ets:select(?REQUEST_TABLE, MatchSpec) - catch - error: badarg -> [] %% service has gone down - end. - -%% --------------------------------------------------------------------------- -%% # receive_message/4 +%% # receive_message/6 %% %% Handle an incoming Diameter message. %% --------------------------------------------------------------------------- -%% Handle an incoming Diameter message in the watchdog process. This -%% used to come through the service process but this avoids that -%% becoming a bottleneck. +%% Handle an incoming Diameter message in the watchdog process. -receive_message(TPid, {Pkt, NPid}, Dict0, RecvData) -> - NPid ! {diameter, incoming(TPid, Pkt, Dict0, RecvData)}; +receive_message(TPid, Route, Pkt, false, Dict0, RecvData) -> + incoming(TPid, Route, Pkt, Dict0, RecvData); -receive_message(TPid, Pkt, Dict0, RecvData) -> - incoming(TPid, Pkt, Dict0, RecvData). +receive_message(TPid, Route, Pkt, NPid, Dict0, RecvData) -> + NPid ! {diameter, incoming(TPid, Route, Pkt, Dict0, RecvData)}. %% incoming/4 -incoming(TPid, Pkt, Dict0, RecvData) +incoming(TPid, Route, Pkt, Dict0, RecvData) when is_pid(TPid) -> #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, - (not R) andalso lookup_request(Pkt, TPid), - TPid, - Pkt, - Dict0, - RecvData). + recv(R, Route, TPid, Pkt, Dict0, RecvData). %% recv/6 @@ -269,8 +239,8 @@ recv(true, false, TPid, Pkt, Dict0, T) -> end; %% ... answer to known request ... -recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> - Pid ! {answer, Ref, Req, Dict0, Pkt}, +recv(false, {Pid, Ref, TPid}, _, Pkt, Dict0, _) -> + Pid ! {answer, Ref, TPid, Dict0, Pkt}, {answer, Pid}; %% Note that failover could have happened prior to this message being @@ -1503,32 +1473,39 @@ send_R(Pkt0, packet = Pkt0}, incr(send, Pkt, TPid, AppDict), - TRef = send_request(TPid, Pkt, Req, SvcName, Timeout), + {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Timeout), Pid ! Ref, %% tell caller a send has been attempted handle_answer(SvcName, App, - recv_A(Timeout, SvcName, App, Opts, {TRef, Req})). + recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, Req})). %% recv_A/5 -recv_A(Timeout, SvcName, App, Opts, {TRef, #request{ref = Ref} = Req}) -> +recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, #request{ref = Ref} = Req}) -> %% Matching on TRef below ensures we ignore messages that pertain %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. + %% includes the pid of the transport on which it was received, + %% which may not be the last peer to which we've transmitted. receive - {answer = A, Ref, Rq, Dict0, Pkt} -> %% Answer from peer - {A, Rq, Dict0, Pkt}; + {answer = A, Ref, TPid, Dict0, Pkt} -> %% Answer from peer + {A, #request{} = erase(TPid), Dict0, Pkt}; {timeout = Reason, TRef, _} -> %% No timely reply {error, Req, Reason}; - {failover, TRef} -> %% Service says peer has gone down - retransmit(pick_peer(SvcName, App, Req, Opts), - Req, - Opts, - SvcName, - Timeout) + {'DOWN', MRef, process, _, _} when false /= MRef -> %% local peer_down + failover(SvcName, App, Req, Opts, Timeout); + {failover, TRef} -> %% local or remote peer_down + failover(SvcName, App, Req, Opts, Timeout) end. +%% failover/5 + +failover(SvcName, App, Req, Opts, Timeout) -> + retransmit(pick_peer(SvcName, App, Req, Opts), + Req, + Opts, + SvcName, + Timeout). + %% handle_answer/3 handle_answer(SvcName, App, {error, Req, Reason}) -> @@ -1705,44 +1682,63 @@ encode(DictT, TPid, #diameter_packet{bin = undefined} = Pkt) -> encode(_, _, #diameter_packet{} = Pkt) -> Pkt. +%% zend_requezt/5 +%% +%% Strip potentially large record fields that aren't used by the +%% processes the records can be send to, possibly on a remote node. + +zend_requezt(TPid, Pkt, Req, SvcName, Timeout) -> + put(TPid, Req), + send_request(TPid, z(Pkt), Req, SvcName, Timeout). + %% send_request/5 send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, _SvcName, Timeout) when node() == node(TPid) -> Seqs = diameter_codec:sequence_numbers(Bin), TRef = erlang:start_timer(Timeout, self(), TPid), - Entry = {Seqs, #request{handler = Pid} = Req, TRef}, - - %% Ensure that request table is cleaned even if the process is - %% killed. - spawn(fun() -> diameter_lib:wait([Pid]), delete_request(Entry) end), - - insert_request(Entry), - send(TPid, Pkt), - TRef; + send(TPid, Pkt, _Route = {self(), Req#request.ref, Seqs}), + {TRef, _MRef = peer_monitor(TPid, TRef)}; %% Send using a remote transport: spawn a process on the remote node %% to relay the answer. send_request(TPid, #diameter_packet{} = Pkt, Req, SvcName, Timeout) -> TRef = erlang:start_timer(Timeout, self(), TPid), - T = {TPid, Pkt, Req, SvcName, Timeout, TRef}, + T = {TPid, Pkt, z(Req), SvcName, Timeout, TRef}, spawn(node(TPid), ?MODULE, send, [T]), - TRef. + {TRef, false}. + +%% z/1 +%% +%% Avoid sending potentially large terms unnecessarily. The records +%% themselves are retained since they're sent between nodes in send/1 +%% and changing what's sent causes upgrade issues. + +z(#request{ref = Ref, handler = Pid}) -> + #request{ref = Ref, + handler = Pid}; + +z(#diameter_packet{header = H, bin = Bin, transport_data = T}) -> + #diameter_packet{header = H, + bin = Bin, + transport_data = T}. %% send/1 send({TPid, Pkt, #request{handler = Pid} = Req0, SvcName, Timeout, TRef}) -> Req = Req0#request{handler = self()}, - recv(TPid, Pid, TRef, send_request(TPid, Pkt, Req, SvcName, Timeout)). + recv(TPid, Pid, TRef, zend_requezt(TPid, Pkt, Req, SvcName, Timeout)). %% recv/4 %% %% Relay an answer from a remote node. -recv(TPid, Pid, TRef, LocalTRef) -> +recv(TPid, Pid, TRef, {LocalTRef, MRef}) -> receive {answer, _, _, _, _} = A -> Pid ! A; + {'DOWN', MRef, process, _, _} -> + Pid ! {failover, TRef}; {failover = T, LocalTRef} -> Pid ! {T, TRef}; T -> @@ -1751,14 +1747,13 @@ recv(TPid, Pid, TRef, LocalTRef) -> %% send/2 -send(Pid, Pkt) -> %% Strip potentially large message terms. - #diameter_packet{header = H, - bin = Bin, - transport_data = T} - = Pkt, - Pid ! {send, #diameter_packet{header = H, - bin = Bin, - transport_data = T}}. +send(Pid, Pkt) -> + Pid ! {send, Pkt}. + +%% send/3 + +send(Pid, Pkt, Route) -> + Pid ! {send, Pkt, Route}. %% retransmit/4 @@ -1768,8 +1763,8 @@ retransmit({TPid, Caps, App} = Req, SvcName, Timeout) -> - have_request(Pkt0, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. + undefined == get(TPid) %% Don't failover to a peer we've + orelse ?THROW(timeout), %% already sent to. Pkt = make_retransmit_packet(Pkt0), @@ -1822,56 +1817,20 @@ resend_request(Pkt0, ?LOG(retransmission, Pkt#diameter_packet.header), incr(TPid, {msg_id(Pkt, AppDict), send, retransmission}), - TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), - {TRef, Req}. - -%% insert_request/1 - -insert_request({_Seqs, #request{transport = TPid}, TRef} = T) -> - ets:insert(?REQUEST_TABLE, [T, {TPid, {self(), TRef}}]), - is_peer_up(TPid) - orelse (self() ! {failover, TRef}). %% failover/1 may have missed - -%% is_peer_up/1 -%% -%% Is the entry written by peer_up/1 and deleted by peer_down/1 still -%% in the request table? + {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Tmo), + {TRef, MRef, Req}. -is_peer_up(TPid) -> - Spec = [{{TPid}, [], ['$_']}], - '$end_of_table' /= ets:select(?REQUEST_TABLE, Spec, 1). +%% peer_monitor/2 -%% lookup_request/2 -%% -%% Note the match on both the key and transport pid. The latter is -%% necessary since the same Hop-by-Hop and End-to-End identifiers are -%% reused in the case of retransmission. - -lookup_request(Msg, TPid) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, '_'}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> +peer_monitor(TPid, TRef) -> + case ets:lookup(?REQUEST_TABLE, TPid) of %% at peer_up/1 + [{_, MPid}] -> + monitor(process, MPid); + [] -> %% transport has gone down + self() ! {failover, TRef}, false end. -%% delete_request/1 - -delete_request({_Seqs, #request{handler = Pid, transport = TPid}, TRef} = T) -> - Spec = [{R, [], [true]} || R <- [T, {TPid, {Pid, TRef}}]], - ets:select_delete(?REQUEST_TABLE, Spec). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - %% get_destination/2 get_destination(Dict, Msg) -> diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 2ba60a65fb..f28b8f2910 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -283,7 +283,7 @@ event(Msg, ?LOG(transition, {From, To}). data(Msg, TPid, reopen, okay) -> - {recv, TPid, 'DWA', _Pkt} = Msg, %% assert + {recv, TPid, false, 'DWA', _Pkt, _NPid} = Msg, %% assert {TPid, T} = eraser(open), [T]; @@ -447,12 +447,14 @@ transition({'DOWN', _, process, TPid, _Reason} = D, end; %% Incoming message. -transition({recv, TPid, Name, PktT}, #watchdog{transport = TPid} = S) -> +transition({recv, TPid, Route, Name, Pkt, NPid}, + #watchdog{transport = TPid} + = S) -> try - incoming(Name, PktT, S) + incoming(Name, Pkt, NPid, S) catch #watchdog{dictionary = Dict0, receive_data = T} = NS -> - diameter_traffic:receive_message(TPid, PktT, Dict0, T), + diameter_traffic:receive_message(TPid, Route, Pkt, NPid, Dict0, T), NS end; @@ -582,15 +584,17 @@ send_watchdog(#watchdog{pending = false, %% Don't count encode errors since we don't expect any on DWR/DWA. -%% incoming/3 +%% incoming/4 -incoming(Name, {Pkt, NPid}, S) -> - NS = recv(Name, Pkt, S), - NPid ! {diameter, discard}, - NS; +incoming(Name, Pkt, false, S) -> + recv(Name, Pkt, S); -incoming(Name, Pkt, S) -> - recv(Name, Pkt, S). +incoming(Name, Pkt, NPid, S) -> + try + recv(Name, Pkt, S) + after + NPid ! {diameter, discard} + end. %% recv/3 diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index b1b8e38d39..eb5a5a44f3 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-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. @@ -50,10 +50,8 @@ {"1.11", [{restart_application, diameter}]}, %% 18.1 {"1.11.1", [{restart_application, diameter}]}, %% 18.2 {"1.11.2", [{restart_application, diameter}]}, %% 18.3 - {"1.12", [{load_module, diameter_lib}, %% 19.0 - {load_module, diameter_traffic}, - {load_module, diameter_tcp}, - {load_module, diameter_sctp}]} + {"1.12", [{restart_application, diameter}]}, %% 19.0 + {"1.12.1", [{restart_application, diameter}]} %% 19.1 ], [ {"0.9", [{restart_application, diameter}]}, @@ -85,9 +83,7 @@ {"1.11", [{restart_application, diameter}]}, {"1.11.1", [{restart_application, diameter}]}, {"1.11.2", [{restart_application, diameter}]}, - {"1.12", [{load_module, diameter_sctp}, - {load_module, diameter_tcp}, - {load_module, diameter_traffic}, - {load_module, diameter_lib}]} + {"1.12", [{restart_application, diameter}]}, + {"1.12.1", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 23219950bb..94d9d72a48 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -1,6 +1,6 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2016. All Rights Reserved. +# Copyright Ericsson AB 2010-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. @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.12.1 +DIAMETER_VSN = 1.12.2 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 9d46d4ac81..ea8cc1677d 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -518,7 +518,8 @@ list_contains_opaque(List, Opaques) -> lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List). %% t_find_opaque_mismatch/2 of two types should only be used if their -%% t_inf is t_none() due to some opaque type violation. +%% t_inf is t_none() due to some opaque type violation. However, +%% 'error' is returned if a structure mismatch is found. %% %% The first argument of the function is the pattern and its second %% argument the type we are matching against the pattern. @@ -527,22 +528,30 @@ list_contains_opaque(List, Opaques) -> 'error' | {'ok', erl_type(), erl_type()}. t_find_opaque_mismatch(T1, T2, Opaques) -> - t_find_opaque_mismatch(T1, T2, T2, Opaques). + catch t_find_opaque_mismatch(T1, T2, T2, Opaques). t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error; -t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> error; +t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error); t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) -> t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques); t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) -> case is_opaque_type(T2, Opaques) of - false -> {ok, TopType, T2}; + false -> + case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of + true -> error; + false -> {ok, TopType, T2} + end; true -> t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques) end; t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) -> %% The generated message is somewhat misleading: case is_opaque_type(T1, Opaques) of - false -> {ok, TopType, T1}; + false -> + case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of + true -> error; + false -> {ok, TopType, T1} + end; true -> t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques) end; @@ -558,7 +567,11 @@ t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques); t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) -> t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques); -t_find_opaque_mismatch(_T1, _T2, _TopType, _Opaques) -> error. +t_find_opaque_mismatch(T1, T2, _TopType, Opaques) -> + case t_is_none(t_inf(T1, T2, Opaques)) of + false -> error; + true -> throw(error) + end. t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> List = lists:zipwith(fun(T1, T2) -> @@ -567,10 +580,11 @@ t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> t_find_opaque_mismatch_list(List). t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) -> - List = [t_find_opaque_mismatch(T1, T2, T2, Opaques) || T1 <- L1, T2 <- L2], + List = [catch t_find_opaque_mismatch(T1, T2, T2, Opaques) || + T1 <- L1, T2 <- L2], t_find_opaque_mismatch_list(List). -t_find_opaque_mismatch_list([]) -> error; +t_find_opaque_mismatch_list([]) -> throw(error); t_find_opaque_mismatch_list([H|T]) -> case H of {ok, _T1, _T2} -> H; @@ -3047,6 +3061,9 @@ inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) -> end end. +compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) -> + [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)]. + is_compat_opaque_names(Opaque1, Opaque2) -> #opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1, #opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2, diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 5c3b5a2d3c..1d8432ee35 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -713,7 +713,7 @@ <list> <item> <p> - Gracefully handle invalid content-lenght headers instead + Gracefully handle invalid content-length headers instead of crashing in list_to_integer.</p> <p> Own Id: OTP-12429</p> diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index 0fd5faa466..d24705a845 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -434,7 +434,7 @@ format_response({StatusLine, Headers, Body}) -> Length = list_to_integer(Headers#http_response_h.'content-length'), {NewBody, Data} = case Length of - -1 -> % When no lenght indicator is provided + -1 -> % When no length indicator is provided {Body, <<>>}; Length when (Length =< size(Body)) -> <<BodyThisReq:Length/binary, Next/binary>> = Body, diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl index 3755ed117b..2b5968ca12 100644 --- a/lib/inets/test/httpd_1_1.erl +++ b/lib/inets/test/httpd_1_1.erl @@ -405,11 +405,11 @@ getRangeSize(Head)-> {multiPart, BoundaryString}; _X1 -> case re:run(Head, ?CONTENT_RANGE "bytes=.*\r\n", [{capture, first}]) of - {match, [{Start, Lenght}]} -> + {match, [{Start, Length}]} -> %% Get the range data remove the fieldname and the %% end of line. RangeInfo = string:substr(Head, Start + 1 + 20, - Lenght - (20 +2)), + Length - (20 +2)), rangeSize(string:strip(RangeInfo)); _X2 -> error diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 1f4591a5a3..19d36a7613 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1360,9 +1360,8 @@ create_big_boot(Config) -> %% corresponding beam file (if hipe is not enabled). filter_app("hipe",_) -> false; -%% Dialyzer and typer depends on hipe +%% Dialyzer depends on hipe filter_app("dialyzer",_) -> false; -filter_app("typer",_) -> false; %% Orber requires explicit configuration filter_app("orber",_) -> false; diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 3031a1f90d..83de4fa64c 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -636,7 +636,8 @@ create_connect_dialog(connect, #state{frame = Frame}) -> wxWindow:setSizerAndFit(Dialog, VSizer), wxSizer:setSizeHints(VSizer, Dialog), - CookiePath = filename:join(os:getenv("HOME"), ".erlang.cookie"), + {ok,[[HomeDir]]} = init:get_argument(home), + CookiePath = filename:join(HomeDir, ".erlang.cookie"), DefaultCookie = case filelib:is_file(CookiePath) of true -> {ok, Bin} = file:read_file(CookiePath), diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 4239a3d0d1..e57c8162e4 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -44,7 +44,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> Ref = make_ref(), Pid = self(), Bin = list_to_binary(lists:seq(1, 255)), - SubBin = element(1, split_binary(element(2, split_binary(Bin, 8)), 17)), + <<_:2,SubBin:17/binary,_/bits>> = Bin, register(named_port,Port), diff --git a/lib/orber/src/cdr_encode.erl b/lib/orber/src/cdr_encode.erl index f922b330a0..d8d1809f9d 100644 --- a/lib/orber/src/cdr_encode.erl +++ b/lib/orber/src/cdr_encode.erl @@ -683,7 +683,7 @@ enc_fixed(_Env, Digits, Scale, Fixed, _Bytes, _Len) -> orber:dbg("[~p] cdr_encode:enc_fixed(~p, ~p, ~p)~n" "The supplied fixed type incorrect. Check that the 'digits' and 'scale' field~n" "match the definition in the IDL-specification. The value field must be~n" - "a list of Digits lenght.", + "a list of Digits length.", [?LINE, Digits, Scale, Fixed], ?DEBUG_LEVEL), corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}). diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 3b1e868757..c61c3a0c71 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -289,8 +289,8 @@ "^lib", "^releases"]). -define(EMBEDDED_EXCL_SYS_FILTERS, - ["^bin/(erlc|dialyzer|typer)(|\\.exe)\$", - "^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)\$", + ["^bin/(erlc|dialyzer)(|\\.exe)\$", + "^erts.*/bin/(erlc|dialyzer)(|\\.exe)\$", "^erts.*/bin/.*(debug|pdb)"]). -define(EMBEDDED_INCL_APP_FILTERS, ["^ebin", "^include", @@ -303,7 +303,7 @@ "^erts.*/bin", "^lib\$"]). -define(STANDALONE_EXCL_SYS_FILTERS, - ["^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)\$", + ["^erts.*/bin/(erlc|dialyzer)(|\\.exe)\$", "^erts.*/bin/(start|escript|to_erl|run_erl)(|\\.exe)\$", "^erts.*/bin/.*(debug|pdb)"]). -define(STANDALONE_INCL_APP_FILTERS, ["^ebin", diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 7ab6f22424..f826fdfd9b 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -51,6 +51,7 @@ MODULES= \ ssh_sup \ sshc_sup \ sshd_sup \ + ssh_options \ ssh_connection_sup \ ssh_connection \ ssh_connection_handler \ diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 2bb7491b0c..95d2686094 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -7,6 +7,7 @@ ssh_app, ssh_acceptor, ssh_acceptor_sup, + ssh_options, ssh_auth, ssh_message, ssh_bits, diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 68d98d3875..53aba14458 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -40,10 +40,24 @@ ]). %%% Type exports --export_type([connection_ref/0, - channel_id/0 +-export_type([ssh_daemon_ref/0, + ssh_connection_ref/0, + ssh_channel_id/0, + role/0, + subsystem_spec/0, + subsystem_name/0, + channel_callback/0, + channel_init_args/0, + algs_list/0, + alg_entry/0, + simple_algs/0, + double_algs/0 ]). +-opaque ssh_daemon_ref() :: daemon_ref() . +-opaque ssh_connection_ref() :: connection_ref() . +-opaque ssh_channel_id() :: channel_id(). + %%-------------------------------------------------------------------- -spec start() -> ok | {error, term()}. -spec start(permanent | transient | temporary) -> ok | {error, term()}. @@ -71,55 +85,63 @@ stop() -> application:stop(ssh). %%-------------------------------------------------------------------- --spec connect(port(), proplists:proplist()) -> {ok, pid()} | {error, term()}. +-spec connect(inet:socket(), proplists:proplist()) -> ok_error(connection_ref()). + +-spec connect(inet:socket(), proplists:proplist(), timeout()) -> ok_error(connection_ref()) + ; (string(), inet:port_number(), proplists:proplist()) -> ok_error(connection_ref()). --spec connect(port(), proplists:proplist(), timeout()) -> {ok, pid()} | {error, term()} - ; (string(), integer(), proplists:proplist()) -> {ok, pid()} | {error, term()}. +-spec connect(string(), inet:port_number(), proplists:proplist(), timeout()) -> ok_error(connection_ref()). --spec connect(string(), integer(), proplists:proplist(), timeout()) -> {ok, pid()} | {error, term()}. %% %% Description: Starts an ssh connection. %%-------------------------------------------------------------------- -connect(Socket, Options) -> - connect(Socket, Options, infinity). +connect(Socket, UserOptions) when is_port(Socket), + is_list(UserOptions) -> + connect(Socket, UserOptions, infinity). -connect(Socket, Options, Timeout) when is_port(Socket) -> - case handle_options(Options) of +connect(Socket, UserOptions, Timeout) when is_port(Socket), + is_list(UserOptions) -> + case ssh_options:handle_options(client, UserOptions) of {error, Error} -> {error, Error}; - {_SocketOptions, SshOptions} -> - case valid_socket_to_use(Socket, Options) of + Options -> + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> {ok, {Host,_Port}} = inet:sockname(Socket), - Opts = [{user_pid,self()}, {host,fmt_host(Host)} | SshOptions], + Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,fmt_host(Host)}], Options), ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error,SockError} -> {error,SockError} end end; -connect(Host, Port, Options) when is_integer(Port), Port>0 -> - connect(Host, Port, Options, infinity). +connect(Host, Port, UserOptions) when is_integer(Port), + Port>0, + is_list(UserOptions) -> + connect(Host, Port, UserOptions, infinity). -connect(Host, Port, Options, Timeout) -> - case handle_options(Options) of +connect(Host, Port, UserOptions, Timeout) when is_integer(Port), + Port>0, + is_list(UserOptions) -> + case ssh_options:handle_options(client, UserOptions) of {error, _Reason} = Error -> Error; - {SocketOptions, SshOptions} -> - {_, Transport, _} = TransportOpts = - proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity), - try Transport:connect(Host, Port, [ {active, false} | SocketOptions], ConnectionTimeout) of + Options -> + {_, Transport, _} = TransportOpts = ?GET_OPT(transport, Options), + ConnectionTimeout = ?GET_OPT(connect_timeout, Options), + SocketOpts = [{active,false} | ?GET_OPT(socket_options,Options)], + try Transport:connect(Host, Port, SocketOpts, ConnectionTimeout) of {ok, Socket} -> - Opts = [{user_pid,self()}, {host,Host} | SshOptions], + Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error, Reason} -> {error, Reason} catch - exit:{function_clause, _} -> + exit:{function_clause, _F} -> + io:format('function_clause ~p~n',[_F]), {error, {options, {transport, TransportOpts}}}; exit:badarg -> - {error, {options, {socket_options, SocketOptions}}} + {error, {options, {socket_options, SocketOpts}}} end end. @@ -148,9 +170,11 @@ channel_info(ConnectionRef, ChannelId, Options) -> ssh_connection_handler:channel_info(ConnectionRef, ChannelId, Options). %%-------------------------------------------------------------------- --spec daemon(integer()) -> {ok, pid()} | {error, term()}. --spec daemon(integer()|port(), proplists:proplist()) -> {ok, pid()} | {error, term()}. --spec daemon(any | inet:ip_address(), integer(), proplists:proplist()) -> {ok, pid()} | {error, term()}. +-spec daemon(inet:port_number()) -> ok_error(daemon_ref()). +-spec daemon(inet:port_number()|inet:socket(), proplists:proplist()) -> ok_error(daemon_ref()). +-spec daemon(any | inet:ip_address(), inet:port_number(), proplists:proplist()) -> ok_error(daemon_ref()) + ;(socket, inet:socket(), proplists:proplist()) -> ok_error(daemon_ref()) + . %% Description: Starts a server listening for SSH connections %% on the given port. @@ -158,19 +182,21 @@ channel_info(ConnectionRef, ChannelId, Options) -> daemon(Port) -> daemon(Port, []). -daemon(Port, Options) when is_integer(Port) -> - daemon(any, Port, Options); -daemon(Socket, Options0) when is_port(Socket) -> - Options = daemon_shell_opt(Options0), - start_daemon(Socket, Options). +daemon(Port, UserOptions) when is_integer(Port), Port >= 0 -> + daemon(any, Port, UserOptions); + +daemon(Socket, UserOptions) when is_port(Socket) -> + daemon(socket, Socket, UserOptions). -daemon(HostAddr, Port, Options0) -> - Options1 = daemon_shell_opt(Options0), - {Host, Inet, Options} = daemon_host_inet_opt(HostAddr, Options1), - start_daemon(Host, Port, Options, Inet). + +daemon(Host0, Port, UserOptions0) -> + {Host, UserOptions} = handle_daemon_args(Host0, UserOptions0), + start_daemon(Host, Port, ssh_options:handle_options(server, UserOptions)). %%-------------------------------------------------------------------- +-spec daemon_info(daemon_ref()) -> ok_error( [{atom(), term()}] ). + daemon_info(Pid) -> case catch ssh_system_sup:acceptor_supervisor(Pid) of AsupPid when is_pid(AsupPid) -> @@ -184,8 +210,8 @@ daemon_info(Pid) -> end. %%-------------------------------------------------------------------- --spec stop_listener(pid()) -> ok. --spec stop_listener(inet:ip_address(), integer()) -> ok. +-spec stop_listener(daemon_ref()) -> ok. +-spec stop_listener(inet:ip_address(), inet:port_number()) -> ok. %% %% Description: Stops the listener, but leaves %% existing connections started by the listener up and running. @@ -198,8 +224,9 @@ stop_listener(Address, Port, Profile) -> ssh_system_sup:stop_listener(Address, Port, Profile). %%-------------------------------------------------------------------- --spec stop_daemon(pid()) -> ok. --spec stop_daemon(inet:ip_address(), integer()) -> ok. +-spec stop_daemon(daemon_ref()) -> ok. +-spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok. +-spec stop_daemon(inet:ip_address(), inet:port_number(), atom()) -> ok. %% %% Description: Stops the listener and all connections started by %% the listener. @@ -210,10 +237,11 @@ stop_daemon(Address, Port) -> ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE). stop_daemon(Address, Port, Profile) -> ssh_system_sup:stop_system(Address, Port, Profile). + %%-------------------------------------------------------------------- --spec shell(port() | string()) -> _. --spec shell(port() | string(), proplists:proplist()) -> _. --spec shell(string(), integer(), proplists:proplist()) -> _. +-spec shell(inet:socket() | string()) -> _. +-spec shell(inet:socket() | string(), proplists:proplist()) -> _. +-spec shell(string(), inet:port_number(), proplists:proplist()) -> _. %% Host = string() %% Port = integer() @@ -254,6 +282,7 @@ start_shell(Error) -> Error. %%-------------------------------------------------------------------- +-spec default_algorithms() -> algs_list() . %%-------------------------------------------------------------------- default_algorithms() -> ssh_transport:default_algorithms(). @@ -261,112 +290,96 @@ default_algorithms() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -valid_socket_to_use(Socket, Options) -> - case proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}) of - {tcp,_,_} -> - %% Is this tcp-socket a valid socket? - case {is_tcp_socket(Socket), - {ok,[{active,false}]} == inet:getopts(Socket, [active]) - } - of - {true, true} -> - ok; - {true, false} -> - {error, not_passive_mode}; - _ -> - {error, not_tcp_socket} - end; - {L4,_,_} -> - {error, {unsupported,L4}} +handle_daemon_args(Host, UserOptions0) -> + case Host of + socket -> + {Host, UserOptions0}; + any -> + {ok, Host0} = inet:gethostname(), + Inet = proplists:get_value(inet, UserOptions0, inet), + {Host0, [Inet | UserOptions0]}; + {_,_,_,_} -> + {Host, [inet, {ip,Host} | UserOptions0]}; + {_,_,_,_,_,_,_,_} -> + {Host, [inet6, {ip,Host} | UserOptions0]}; + _ -> + error(badarg) end. +%%%---------------------------------------------------------------- +valid_socket_to_use(Socket, {tcp,_,_}) -> + %% Is this tcp-socket a valid socket? + case {is_tcp_socket(Socket), + {ok,[{active,false}]} == inet:getopts(Socket, [active]) + } + of + {true, true} -> + ok; + {true, false} -> + {error, not_passive_mode}; + _ -> + {error, not_tcp_socket} + end; + +valid_socket_to_use(_, {L4,_,_}) -> + {error, {unsupported,L4}}. + + is_tcp_socket(Socket) -> case inet:getopts(Socket, [delay_send]) of {ok,[_]} -> true; _ -> false end. -daemon_shell_opt(Options) -> - case proplists:get_value(shell, Options) of - undefined -> - [{shell, {shell, start, []}} | Options]; - _ -> - Options - end. - -daemon_host_inet_opt(HostAddr, Options1) -> - case HostAddr of - any -> - {ok, Host0} = inet:gethostname(), - {Host0, proplists:get_value(inet, Options1, inet), Options1}; - {_,_,_,_} -> - {HostAddr, inet, - [{ip, HostAddr} | Options1]}; - {_,_,_,_,_,_,_,_} -> - {HostAddr, inet6, - [{ip, HostAddr} | Options1]} - end. - +%%%---------------------------------------------------------------- +start_daemon(_, _, {error,Error}) -> + {error,Error}; + +start_daemon(socket, Socket, Options) -> + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of + ok -> + try + do_start_daemon(Socket, Options) + catch + throw:bad_fd -> {error,bad_fd}; + throw:bad_socket -> {error,bad_socket}; + _C:_E -> {error,{cannot_start_daemon,_C,_E}} + end; + {error,SockError} -> + {error,SockError} + end; -start_daemon(Socket, Options) -> - case handle_options(Options) of - {error, Error} -> - {error, Error}; - {SocketOptions, SshOptions} -> - case valid_socket_to_use(Socket, Options) of - ok -> - try - do_start_daemon(Socket, [{role,server}|SshOptions], SocketOptions) - catch - throw:bad_fd -> {error,bad_fd}; - throw:bad_socket -> {error,bad_socket}; - _C:_E -> {error,{cannot_start_daemon,_C,_E}} - end; - {error,SockError} -> - {error,SockError} - end +start_daemon(Host, Port, Options) -> + try + do_start_daemon(Host, Port, Options) + catch + throw:bad_fd -> {error,bad_fd}; + throw:bad_socket -> {error,bad_socket}; + _C:_E -> {error,{cannot_start_daemon,_C,_E}} end. -start_daemon(Host, Port, Options, Inet) -> - case handle_options(Options) of - {error, _Reason} = Error -> - Error; - {SocketOptions, SshOptions}-> - try - do_start_daemon(Host, Port, [{role,server}|SshOptions] , [Inet|SocketOptions]) - catch - throw:bad_fd -> {error,bad_fd}; - throw:bad_socket -> {error,bad_socket}; - _C:_E -> {error,{cannot_start_daemon,_C,_E}} - end - end. -do_start_daemon(Socket, SshOptions, SocketOptions) -> +do_start_daemon(Socket, Options) -> {ok, {IP,Port}} = try {ok,_} = inet:sockname(Socket) catch _:_ -> throw(bad_socket) end, Host = fmt_host(IP), - Profile = proplists:get_value(profile, SshOptions, ?DEFAULT_PROFILE), - Opts = [{asocket, Socket}, - {asock_owner,self()}, - {address, Host}, - {port, Port}, - {role, server}, - {socket_opts, SocketOptions}, - {ssh_opts, SshOptions}], - {_, Callback, _} = proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}), + Opts = ?PUT_INTERNAL_OPT([{asocket, Socket}, + {asock_owner,self()}, + {address, Host}, + {port, Port}, + {role, server}], Options), + + Profile = ?GET_OPT(profile, Options), case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> - %% It would proably make more sense to call the - %% address option host but that is a too big change at the - %% monent. The name is a legacy name! try sshd_sup:start_child(Opts) of {error, {already_started, _}} -> {error, eaddrinuse}; Result = {ok,_} -> - call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, Result); + call_ssh_acceptor_handle_connection(Host, Port, Opts, Socket, Result); Result = {error, _} -> Result catch @@ -379,56 +392,47 @@ do_start_daemon(Socket, SshOptions, SocketOptions) -> {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> - call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, {ok, Sup}); + call_ssh_acceptor_handle_connection(Host, Port, Opts, Socket, {ok,Sup}); Other -> Other end end. -do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> +do_start_daemon(Host0, Port0, Options0) -> {Host,Port1} = try - case proplists:get_value(fd, SocketOptions) of + case ?GET_SOCKET_OPT(fd, Options0) of undefined -> {Host0,Port0}; Fd when Port0==0 -> - find_hostport(Fd); - _ -> - {Host0,Port0} + find_hostport(Fd) end catch _:_ -> throw(bad_fd) end, - Profile = proplists:get_value(profile, SshOptions, ?DEFAULT_PROFILE), - {Port, WaitRequestControl, Opts0} = + {Port, WaitRequestControl, Options1} = case Port1 of 0 -> %% Allocate the socket here to get the port number... - {_, Callback, _} = - proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}), - {ok,LSock} = ssh_acceptor:callback_listen(Callback, 0, SocketOptions), + {ok,LSock} = ssh_acceptor:callback_listen(0, Options0), {ok,{_,LPort}} = inet:sockname(LSock), {LPort, - {LSock,Callback}, - [{lsocket,LSock},{lsock_owner,self()}] + LSock, + ?PUT_INTERNAL_OPT({lsocket,{LSock,self()}}, Options0) }; _ -> - {Port1, false, []} + {Port1, false, Options0} end, - Opts = [{address, Host}, - {port, Port}, - {role, server}, - {socket_opts, SocketOptions}, - {ssh_opts, SshOptions} | Opts0], + Options = ?PUT_INTERNAL_OPT([{address, Host}, + {port, Port}, + {role, server}], Options1), + Profile = ?GET_OPT(profile, Options0), case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> - %% It would proably make more sense to call the - %% address option host but that is a too big change at the - %% monent. The name is a legacy name! - try sshd_sup:start_child(Opts) of + try sshd_sup:start_child(Options) of {error, {already_started, _}} -> {error, eaddrinuse}; Result = {ok,_} -> - sync_request_control(WaitRequestControl), + sync_request_control(WaitRequestControl, Options), Result; Result = {error, _} -> Result @@ -436,21 +440,22 @@ do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> exit:{noproc, _} -> {error, ssh_not_started} end; - Sup -> + Sup -> AccPid = ssh_system_sup:acceptor_supervisor(Sup), - case ssh_acceptor_sup:start_child(AccPid, Opts) of + case ssh_acceptor_sup:start_child(AccPid, Options) of {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> - sync_request_control(WaitRequestControl), + sync_request_control(WaitRequestControl, Options), {ok, Sup}; Other -> Other end end. -call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, DefaultResult) -> - try ssh_acceptor:handle_connection(Callback, Host, Port, Opts, Socket) +call_ssh_acceptor_handle_connection(Host, Port, Options, Socket, DefaultResult) -> + {_, Callback, _} = ?GET_OPT(transport, Options), + try ssh_acceptor:handle_connection(Callback, Host, Port, Options, Socket) of {error,Error} -> {error,Error}; _ -> DefaultResult @@ -459,9 +464,10 @@ call_ssh_acceptor_handle_connection(Callback, Host, Port, Opts, Socket, DefaultR end. -sync_request_control(false) -> +sync_request_control(false, _Options) -> ok; -sync_request_control({LSock,Callback}) -> +sync_request_control(LSock, Options) -> + {_, Callback, _} = ?GET_OPT(transport, Options), receive {request_control,LSock,ReqPid} -> ok = Callback:controlling_process(LSock, ReqPid), @@ -477,523 +483,6 @@ find_hostport(Fd) -> ok = inet:close(S), HostPort. - -handle_options(Opts) -> - try handle_option(algs_compatibility(proplists:unfold(Opts)), [], []) of - {Inet, Ssh} -> - {handle_ip(Inet), Ssh} - catch - throw:Error -> - Error - end. - - -algs_compatibility(Os0) -> - %% Take care of old options 'public_key_alg' and 'pref_public_key_algs' - case proplists:get_value(public_key_alg, Os0) of - undefined -> - Os0; - A when is_atom(A) -> - %% Skip public_key_alg if pref_public_key_algs is defined: - Os = lists:keydelete(public_key_alg, 1, Os0), - case proplists:get_value(pref_public_key_algs,Os) of - undefined when A == 'ssh-rsa' ; A==ssh_rsa -> - [{pref_public_key_algs,['ssh-rsa','ssh-dss']} | Os]; - undefined when A == 'ssh-dss' ; A==ssh_dsa -> - [{pref_public_key_algs,['ssh-dss','ssh-rsa']} | Os]; - undefined -> - throw({error, {eoptions, {public_key_alg,A} }}); - _ -> - Os - end; - V -> - throw({error, {eoptions, {public_key_alg,V} }}) - end. - - -handle_option([], SocketOptions, SshOptions) -> - {SocketOptions, SshOptions}; -handle_option([{system_dir, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user_dir, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user_dir_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{silently_accept_hosts, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user_interaction, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{connect_timeout, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{dsa_pass_phrase, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{rsa_pass_phrase, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{password, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user_passwords, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{pwdfun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{key_cb, {Module, Options}} | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option({key_cb, Module}), - handle_ssh_priv_option({key_cb_private, Options}) | - SshOptions]); -handle_option([{key_cb, Module} | Rest], SocketOptions, SshOptions) -> - handle_option([{key_cb, {Module, []}} | Rest], SocketOptions, SshOptions); -handle_option([{keyboard_interact_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -%%Backwards compatibility -handle_option([{allow_user_interaction, Value} | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option({user_interaction, Value}) | SshOptions]); -handle_option([{infofun, _} = Opt | Rest],SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{connectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{disconnectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{unexpectedfun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{failfun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{ssh_msg_debug_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -%%Backwards compatibility should not be underscore between ip and v6 in API -handle_option([{ip_v6_disabled, Value} | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option({ipv6_disabled, Value}) | SshOptions]); -handle_option([{ipv6_disabled, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{transport, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{subsystems, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{ssh_cli, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{shell, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{exec, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{auth_methods, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{auth_method_kb_interactive_data, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{pref_public_key_algs, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{preferred_algorithms,_} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{dh_gex_groups,_} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{dh_gex_limits,_} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{quiet_mode, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{rekey_limit, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{max_sessions, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{max_channels, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{negotiation_timeout, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -%% (Is handled by proplists:unfold above:) -%% handle_option([parallel_login|Rest], SocketOptions, SshOptions) -> -%% handle_option(Rest, SocketOptions, [handle_ssh_option({parallel_login,true}) | SshOptions]); -handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{max_random_length_padding, _Bool} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{tstflg, _} = Opt|Rest], SocketOptions, SshOptions) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([Opt | Rest], SocketOptions, SshOptions) -> - handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). - - -handle_ssh_option({tstflg,_F} = Opt) -> Opt; -handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 -> - Opt; -handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) -> - check_dir(Opt); -handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) -> - check_dir(Opt); -handle_ssh_option({user_dir_fun, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -> - Opt; -handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_function(Value,2) -> - Opt; -handle_ssh_option({silently_accept_hosts, {DigestAlg,Value}} = Opt) when is_function(Value,2) -> - Algs = if is_atom(DigestAlg) -> [DigestAlg]; - is_list(DigestAlg) -> DigestAlg; - true -> throw({error, {eoptions, Opt}}) - end, - case [A || A <- Algs, - not lists:member(A, [md5, sha, sha224, sha256, sha384, sha512])] of - [_|_] = UnSup1 -> - throw({error, {{eoptions, Opt}, {not_fingerprint_algos,UnSup1}}}); - [] -> - CryptoHashAlgs = proplists:get_value(hashs, crypto:supports(), []), - case [A || A <- Algs, - not lists:member(A, CryptoHashAlgs)] of - [_|_] = UnSup2 -> - throw({error, {{eoptions, Opt}, {unsupported_algo,UnSup2}}}); - [] -> Opt - end - end; -handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) -> - Opt; -handle_ssh_option({preferred_algorithms,[_|_]} = Opt) -> - handle_pref_algs(Opt); - -handle_ssh_option({dh_gex_groups,L0}) when is_list(L0) -> - {dh_gex_groups, - collect_per_size( - lists:foldl( - fun({N,G,P}, Acc) when is_integer(N),N>0, - is_integer(G),G>0, - is_integer(P),P>0 -> - [{N,{G,P}} | Acc]; - ({N,{G,P}}, Acc) when is_integer(N),N>0, - is_integer(G),G>0, - is_integer(P),P>0 -> - [{N,{G,P}} | Acc]; - ({N,GPs}, Acc) when is_list(GPs) -> - lists:foldr(fun({Gi,Pi}, Acci) when is_integer(Gi),Gi>0, - is_integer(Pi),Pi>0 -> - [{N,{Gi,Pi}} | Acci] - end, Acc, GPs) - end, [], L0))}; - -handle_ssh_option({dh_gex_groups,{Tag,File=[C|_]}}=Opt) when is_integer(C), C>0, - Tag == file ; - Tag == ssh_moduli_file -> - {ok,GroupDefs} = - case Tag of - file -> - file:consult(File); - ssh_moduli_file -> - case file:open(File,[read]) of - {ok,D} -> - try - {ok,Moduli} = read_moduli_file(D, 1, []), - file:close(D), - {ok, Moduli} - catch - _:_ -> - throw({error, {{eoptions, Opt}, "Bad format in file "++File}}) - end; - {error,enoent} -> - throw({error, {{eoptions, Opt}, "File not found:"++File}}); - {error,Error} -> - throw({error, {{eoptions, Opt}, io_lib:format("Error reading file ~s: ~p",[File,Error])}}) - end - end, - - try - handle_ssh_option({dh_gex_groups,GroupDefs}) - catch - _:_ -> - throw({error, {{eoptions, Opt}, "Bad format in file: "++File}}) - end; - - -handle_ssh_option({dh_gex_limits,{Min,Max}} = Opt) when is_integer(Min), Min>0, - is_integer(Max), Max>=Min -> - %% Server - Opt; -handle_ssh_option({dh_gex_limits,{Min,I,Max}} = Opt) when is_integer(Min), Min>0, - is_integer(I), I>=Min, - is_integer(Max), Max>=I -> - %% Client - Opt; -handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), length(Value) >= 1 -> - case handle_user_pref_pubkey_algs(Value, []) of - {true, NewOpts} -> - {pref_public_key_algs, NewOpts}; - _ -> - throw({error, {eoptions, Opt}}) - end; -handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> - Opt; -handle_ssh_option({max_sessions, Value} = Opt) when is_integer(Value), Value>0 -> - Opt; -handle_ssh_option({max_channels, Value} = Opt) when is_integer(Value), Value>0 -> - Opt; -handle_ssh_option({negotiation_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> - Opt; -handle_ssh_option({parallel_login, Value} = Opt) when Value==true ; Value==false -> - Opt; -handle_ssh_option({user, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({dsa_pass_phrase, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({rsa_pass_phrase, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({password, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({user_passwords, Value} = Opt) when is_list(Value)-> - Opt; -handle_ssh_option({pwdfun, Value} = Opt) when is_function(Value,2) -> - Opt; -handle_ssh_option({pwdfun, Value} = Opt) when is_function(Value,4) -> - Opt; -handle_ssh_option({key_cb, Value} = Opt) when is_atom(Value) -> - Opt; -handle_ssh_option({key_cb, {CallbackMod, CallbackOptions}} = Opt) when is_atom(CallbackMod), - is_list(CallbackOptions) -> - Opt; -handle_ssh_option({keyboard_interact_fun, Value} = Opt) when is_function(Value,3) -> - Opt; -handle_ssh_option({compression, Value} = Opt) when is_atom(Value) -> - Opt; -handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module), - is_atom(Function) -> - Opt; -handle_ssh_option({exec, Function} = Opt) when is_function(Function) -> - Opt; -handle_ssh_option({auth_methods, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({auth_method_kb_interactive_data, {Name,Instruction,Prompt,Echo}} = Opt) when is_list(Name), - is_list(Instruction), - is_list(Prompt), - is_boolean(Echo) -> - Opt; -handle_ssh_option({auth_method_kb_interactive_data, F} = Opt) when is_function(F,3) -> - Opt; -handle_ssh_option({infofun, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({connectfun, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({disconnectfun, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({unexpectedfun, Value} = Opt) when is_function(Value,2) -> - Opt; -handle_ssh_option({failfun, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({ssh_msg_debug_fun, Value} = Opt) when is_function(Value,4) -> - Opt; - -handle_ssh_option({ipv6_disabled, Value} = Opt) when is_boolean(Value) -> - throw({error, {{ipv6_disabled, Opt}, option_no_longer_valid_use_inet_option_instead}}); -handle_ssh_option({transport, {Protocol, Cb, ClosTag}} = Opt) when is_atom(Protocol), - is_atom(Cb), - is_atom(ClosTag) -> - Opt; -handle_ssh_option({subsystems, Value} = Opt) when is_list(Value) -> - Opt; -handle_ssh_option({ssh_cli, {Cb, _}}= Opt) when is_atom(Cb) -> - Opt; -handle_ssh_option({ssh_cli, no_cli} = Opt) -> - Opt; -handle_ssh_option({shell, {Module, Function, _}} = Opt) when is_atom(Module), - is_atom(Function) -> - Opt; -handle_ssh_option({shell, Value} = Opt) when is_function(Value) -> - Opt; -handle_ssh_option({quiet_mode, Value} = Opt) when is_boolean(Value) -> - Opt; -handle_ssh_option({idle_time, Value} = Opt) when is_integer(Value), Value > 0 -> - Opt; -handle_ssh_option({rekey_limit, Value} = Opt) when is_integer(Value) -> - Opt; -handle_ssh_option({id_string, random}) -> - {id_string, {random,2,5}}; %% 2 - 5 random characters -handle_ssh_option({id_string, ID} = Opt) when is_list(ID) -> - Opt; -handle_ssh_option({max_random_length_padding, Value} = Opt) when is_integer(Value), - Value =< 255 -> - Opt; -handle_ssh_option({profile, Value} = Opt) when is_atom(Value) -> - Opt; -handle_ssh_option(Opt) -> - throw({error, {eoptions, Opt}}). - -handle_ssh_priv_option({key_cb_private, Value} = Opt) when is_list(Value) -> - Opt. - -handle_inet_option({active, _} = Opt) -> - throw({error, {{eoptions, Opt}, "SSH has built in flow control, " - "and active is handled internally, user is not allowed" - "to specify this option"}}); - -handle_inet_option({inet, Value}) when (Value == inet) or (Value == inet6) -> - Value; -handle_inet_option({reuseaddr, _} = Opt) -> - throw({error, {{eoptions, Opt},"Is set internally, user is not allowed" - "to specify this option"}}); -%% Option verified by inet -handle_inet_option(Opt) -> - Opt. - - -%% Check preferred algs - -handle_pref_algs({preferred_algorithms,Algs}) -> - try alg_duplicates(Algs, [], []) of - [] -> - {preferred_algorithms, - [try ssh_transport:supported_algorithms(Key) - of - DefAlgs -> handle_pref_alg(Key,Vals,DefAlgs) - catch - _:_ -> throw({error, {{eoptions, {preferred_algorithms,Key}}, - "Bad preferred_algorithms key"}}) - end || {Key,Vals} <- Algs] - }; - - Dups -> - throw({error, {{eoptions, {preferred_algorithms,Dups}}, "Duplicates found"}}) - catch - _:_ -> - throw({error, {{eoptions, preferred_algorithms}, "Malformed"}}) - end. - -alg_duplicates([{K,V}|KVs], Ks, Dups0) -> - Dups = - case lists:member(K,Ks) of - true -> - [K|Dups0]; - false -> - Dups0 - end, - case V--lists:usort(V) of - [] -> - alg_duplicates(KVs, [K|Ks], Dups); - Ds -> - alg_duplicates(KVs, [K|Ks], Dups++Ds) - end; -alg_duplicates([], _Ks, Dups) -> - Dups. - -handle_pref_alg(Key, - Vs=[{client2server,C2Ss=[_|_]},{server2client,S2Cs=[_|_]}], - [{client2server,Sup_C2Ss},{server2client,Sup_S2Cs}] - ) -> - chk_alg_vs(Key, C2Ss, Sup_C2Ss), - chk_alg_vs(Key, S2Cs, Sup_S2Cs), - {Key, Vs}; - -handle_pref_alg(Key, - Vs=[{server2client,[_|_]},{client2server,[_|_]}], - Sup=[{client2server,_},{server2client,_}] - ) -> - handle_pref_alg(Key, lists:reverse(Vs), Sup); - -handle_pref_alg(Key, - Vs=[V|_], - Sup=[{client2server,_},{server2client,_}] - ) when is_atom(V) -> - handle_pref_alg(Key, [{client2server,Vs},{server2client,Vs}], Sup); - -handle_pref_alg(Key, - Vs=[V|_], - Sup=[S|_] - ) when is_atom(V), is_atom(S) -> - chk_alg_vs(Key, Vs, Sup), - {Key, Vs}; - -handle_pref_alg(Key, Vs, _) -> - throw({error, {{eoptions, {preferred_algorithms,[{Key,Vs}]}}, "Badly formed list"}}). - -chk_alg_vs(OptKey, Values, SupportedValues) -> - case (Values -- SupportedValues) of - [] -> Values; - Bad -> throw({error, {{eoptions, {OptKey,Bad}}, "Unsupported value(s) found"}}) - end. - -handle_ip(Inet) -> %% Default to ipv4 - case lists:member(inet, Inet) of - true -> - Inet; - false -> - case lists:member(inet6, Inet) of - true -> - Inet; - false -> - [inet | Inet] - end - end. - -check_dir({_,Dir} = Opt) -> - case directory_exist_readable(Dir) of - ok -> - Opt; - {error,Error} -> - throw({error, {eoptions,{Opt,Error}}}) - end. - -directory_exist_readable(Dir) -> - case file:read_file_info(Dir) of - {ok, #file_info{type = directory, - access = Access}} -> - case Access of - read -> ok; - read_write -> ok; - _ -> {error, eacces} - end; - - {ok, #file_info{}}-> - {error, enotdir}; - - {error, Error} -> - {error, Error} - end. - - - -collect_per_size(L) -> - lists:foldr( - fun({Sz,GP}, [{Sz,GPs}|Acc]) -> [{Sz,[GP|GPs]}|Acc]; - ({Sz,GP}, Acc) -> [{Sz,[GP]}|Acc] - end, [], lists:sort(L)). - -read_moduli_file(D, I, Acc) -> - case io:get_line(D,"") of - {error,Error} -> - {error,Error}; - eof -> - {ok, Acc}; - "#" ++ _ -> read_moduli_file(D, I+1, Acc); - <<"#",_/binary>> -> read_moduli_file(D, I+1, Acc); - Data -> - Line = if is_binary(Data) -> binary_to_list(Data); - is_list(Data) -> Data - end, - try - [_Time,_Type,_Tests,_Tries,Size,G,P] = string:tokens(Line," \r\n"), - M = {list_to_integer(Size), - {list_to_integer(G), list_to_integer(P,16)} - }, - read_moduli_file(D, I+1, [M|Acc]) - catch - _:_ -> - read_moduli_file(D, I+1, Acc) - end - end. - -handle_user_pref_pubkey_algs([], Acc) -> - {true, lists:reverse(Acc)}; -handle_user_pref_pubkey_algs([H|T], Acc) -> - case lists:member(H, ?SUPPORTED_USER_KEYS) of - true -> - handle_user_pref_pubkey_algs(T, [H| Acc]); - - false when H==ssh_dsa -> handle_user_pref_pubkey_algs(T, ['ssh-dss'| Acc]); - false when H==ssh_rsa -> handle_user_pref_pubkey_algs(T, ['ssh-rsa'| Acc]); - - false -> - false - end. - fmt_host({A,B,C,D}) -> lists:concat([A,".",B,".",C,".",D]); fmt_host(T={_,_,_,_,_,_,_,_}) -> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 4cd91177f6..c1ba58ed40 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -33,6 +33,10 @@ -define(REKEY_DATA_TIMOUT, 60000). -define(DEFAULT_PROFILE, default). +-define(DEFAULT_TRANSPORT, {tcp, gen_tcp, tcp_closed} ). + +-define(MAX_RND_PADDING_LEN, 15). + -define(SUPPORTED_AUTH_METHODS, "publickey,keyboard-interactive,password"). -define(SUPPORTED_USER_KEYS, ['ssh-rsa','ssh-dss','ecdsa-sha2-nistp256','ecdsa-sha2-nistp384','ecdsa-sha2-nistp521']). @@ -64,10 +68,49 @@ -define(string_utf8(X), << ?STRING(unicode:characters_to_binary(X)) >> ). -define(binary(X), << ?STRING(X) >>). +%% Cipher details -define(SSH_CIPHER_NONE, 0). -define(SSH_CIPHER_3DES, 3). -define(SSH_CIPHER_AUTHFILE, ?SSH_CIPHER_3DES). +%% Option access macros +-define(do_get_opt(C,K,O), ssh_options:get_value(C,K,O, ?MODULE,?LINE)). +-define(do_get_opt(C,K,O,D), ssh_options:get_value(C,K,O,D,?MODULE,?LINE)). + +-define(GET_OPT(Key,Opts), ?do_get_opt(user_options, Key,Opts ) ). +-define(GET_INTERNAL_OPT(Key,Opts), ?do_get_opt(internal_options,Key,Opts ) ). +-define(GET_INTERNAL_OPT(Key,Opts,Def), ?do_get_opt(internal_options,Key,Opts,Def) ). +-define(GET_SOCKET_OPT(Key,Opts), ?do_get_opt(socket_options, Key,Opts ) ). +-define(GET_SOCKET_OPT(Key,Opts,Def), ?do_get_opt(socket_options, Key,Opts,Def) ). + +-define(do_put_opt(C,KV,O), ssh_options:put_value(C,KV,O, ?MODULE,?LINE)). + +-define(PUT_OPT(KeyVal,Opts), ?do_put_opt(user_options, KeyVal,Opts) ). +-define(PUT_INTERNAL_OPT(KeyVal,Opts), ?do_put_opt(internal_options,KeyVal,Opts) ). +-define(PUT_SOCKET_OPT(KeyVal,Opts), ?do_put_opt(socket_options, KeyVal,Opts) ). + +%% Types +-type role() :: client | server . +-type ok_error(SuccessType) :: {ok, SuccessType} | {error, any()} . +-type daemon_ref() :: pid() . + +-type subsystem_spec() :: {subsystem_name(), {channel_callback(), channel_init_args()}} . +-type subsystem_name() :: string() . +-type channel_callback() :: atom() . +-type channel_init_args() :: list() . + +-type algs_list() :: list( alg_entry() ). +-type alg_entry() :: {kex, simple_algs()} + | {public_key, simple_algs()} + | {cipher, double_algs()} + | {mac, double_algs()} + | {compression, double_algs()} . +-type simple_algs() :: list( atom() ) . +-type double_algs() :: list( {client2serverlist,simple_algs()} | {server2client,simple_algs()} ) + | simple_algs() . + + +%% Records -record(ssh, { role, %% client | server @@ -127,7 +170,7 @@ recv_sequence = 0, keyex_key, keyex_info, - random_length_padding = 15, % From RFC 4253 section 6. + random_length_padding = ?MAX_RND_PADDING_LEN, % From RFC 4253 section 6. %% User auth user, diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 13c9d9af4a..42be18f2ad 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -25,56 +25,63 @@ -include("ssh.hrl"). %% Internal application API --export([start_link/5, +-export([start_link/4, number_of_connections/1, - callback_listen/3, + callback_listen/2, handle_connection/5]). %% spawn export --export([acceptor_init/6, acceptor_loop/6]). +-export([acceptor_init/5, acceptor_loop/6]). -define(SLEEP_TIME, 200). %%==================================================================== %% Internal application API %%==================================================================== -start_link(Port, Address, SockOpts, Opts, AcceptTimeout) -> - Args = [self(), Port, Address, SockOpts, Opts, AcceptTimeout], +start_link(Port, Address, Options, AcceptTimeout) -> + Args = [self(), Port, Address, Options, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) -> - {_, Callback, _} = - proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}), - - SockOwner = proplists:get_value(lsock_owner, Opts), - LSock = proplists:get_value(lsocket, Opts), - UseExistingSocket = - case catch inet:sockname(LSock) of - {ok,{_,Port}} -> is_pid(SockOwner); - _ -> false - end, - - case UseExistingSocket of - true -> - proc_lib:init_ack(Parent, {ok, self()}), +acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) -> + {_, Callback, _} = ?GET_OPT(transport, Opts), + try + {LSock0,SockOwner0} = ?GET_INTERNAL_OPT(lsocket, Opts), + true = is_pid(SockOwner0), + {ok,{_,Port}} = inet:sockname(LSock0), + {LSock0, SockOwner0} + of + {LSock, SockOwner} -> + %% Use existing socket + proc_lib:init_ack(Parent, {ok, self()}), request_ownership(LSock, SockOwner), - acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); - - false -> - case (catch do_socket_listen(Callback, Port, SockOpts)) of - {ok, ListenSocket} -> - proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Callback, - Port, Address, Opts, ListenSocket, AcceptTimeout); - Error -> - proc_lib:init_ack(Parent, Error), - error - end + acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout) + catch + error:{badkey,lsocket} -> + %% Open new socket + try + socket_listen(Port, Opts) + of + {ok, ListenSocket} -> + proc_lib:init_ack(Parent, {ok, self()}), + {_, Callback, _} = ?GET_OPT(transport, Opts), + acceptor_loop(Callback, + Port, Address, Opts, ListenSocket, AcceptTimeout); + {error,Error} -> + proc_lib:init_ack(Parent, Error), + {error,Error} + catch + _:_ -> + {error,listen_socket_failed} + end; + + _:_ -> + {error,use_existing_socket_failed} end. + request_ownership(LSock, SockOwner) -> SockOwner ! {request_control,LSock,self()}, receive @@ -82,23 +89,25 @@ request_ownership(LSock, SockOwner) -> end. -do_socket_listen(Callback, Port0, Opts) -> - Port = - case proplists:get_value(fd, Opts) of - undefined -> Port0; - _ -> 0 - end, - callback_listen(Callback, Port, Opts). - -callback_listen(Callback, Port, Opts0) -> - Opts = [{active, false}, {reuseaddr,true} | Opts0], - case Callback:listen(Port, Opts) of +socket_listen(Port0, Opts) -> + Port = case ?GET_SOCKET_OPT(fd, Opts) of + undefined -> Port0; + _ -> 0 + end, + callback_listen(Port, Opts). + + +callback_listen(Port, Opts0) -> + {_, Callback, _} = ?GET_OPT(transport, Opts0), + Opts = ?PUT_SOCKET_OPT([{active, false}, {reuseaddr,true}], Opts0), + SockOpts = ?GET_OPT(socket_options, Opts), + case Callback:listen(Port, SockOpts) of {error, nxdomain} -> - Callback:listen(Port, lists:delete(inet6, Opts)); + Callback:listen(Port, lists:delete(inet6, SockOpts)); {error, enetunreach} -> - Callback:listen(Port, lists:delete(inet6, Opts)); + Callback:listen(Port, lists:delete(inet6, SockOpts)); {error, eafnosupport} -> - Callback:listen(Port, lists:delete(inet6, Opts)); + Callback:listen(Port, lists:delete(inet6, SockOpts)); Other -> Other end. @@ -120,21 +129,21 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> end. handle_connection(Callback, Address, Port, Options, Socket) -> - SSHopts = proplists:get_value(ssh_opts, Options, []), - Profile = proplists:get_value(profile, SSHopts, ?DEFAULT_PROFILE), + Profile = ?GET_OPT(profile, Options), SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile), - MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity), + MaxSessions = ?GET_OPT(max_sessions, Options), case number_of_connections(SystemSup) < MaxSessions of true -> {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options), ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup), - Timeout = proplists:get_value(negotiation_timeout, SSHopts, 2*60*1000), + NegTimeout = ?GET_OPT(negotiation_timeout, Options), ssh_connection_handler:start_connection(server, Socket, - [{supervisors, [{system_sup, SystemSup}, - {subsystem_sup, SubSysSup}, - {connection_sup, ConnectionSup}]} - | Options], Timeout); + ?PUT_INTERNAL_OPT( + {supervisors, [{system_sup, SystemSup}, + {subsystem_sup, SubSysSup}, + {connection_sup, ConnectionSup}]}, + Options), NegTimeout); false -> Callback:close(Socket), IPstr = if is_tuple(Address) -> inet:ntoa(Address); diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 129f85a3e0..77f7826918 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -44,14 +44,13 @@ start_link(Servers) -> supervisor:start_link(?MODULE, [Servers]). -start_child(AccSup, ServerOpts) -> - Spec = child_spec(ServerOpts), +start_child(AccSup, Options) -> + Spec = child_spec(Options), case supervisor:start_child(AccSup, Spec) of {error, already_present} -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - Profile = proplists:get_value(profile, - proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Profile = ?GET_OPT(profile, Options), stop_child(AccSup, Address, Port, Profile), supervisor:start_child(AccSup, Spec); Reply -> @@ -70,24 +69,23 @@ stop_child(AccSup, Address, Port, Profile) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init([ServerOpts]) -> +init([Options]) -> RestartStrategy = one_for_one, MaxR = 10, MaxT = 3600, - Children = [child_spec(ServerOpts)], + Children = [child_spec(Options)], {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -child_spec(ServerOpts) -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - Timeout = proplists:get_value(timeout, ServerOpts, ?DEFAULT_TIMEOUT), - Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), +child_spec(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Timeout = ?GET_INTERNAL_OPT(timeout, Options, ?DEFAULT_TIMEOUT), + Profile = ?GET_OPT(profile, Options), Name = id(Address, Port, Profile), - SocketOpts = proplists:get_value(socket_opts, ServerOpts), - StartFunc = {ssh_acceptor, start_link, [Port, Address, SocketOpts, ServerOpts, Timeout]}, + StartFunc = {ssh_acceptor, start_link, [Port, Address, Options, Timeout]}, Restart = transient, Shutdown = brutal_kill, Modules = [ssh_acceptor], diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 9b54ecb2dd..88c8144063 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -96,14 +96,14 @@ unique(L) -> password_msg([#ssh{opts = Opts, io_cb = IoCb, user = User, service = Service} = Ssh0]) -> {Password,Ssh} = - case proplists:get_value(password, Opts) of + case ?GET_OPT(password, Opts) of undefined when IoCb == ssh_no_io -> {not_ok, Ssh0}; undefined -> - {IoCb:read_password("ssh password: ",Ssh0), Ssh0}; + {IoCb:read_password("ssh password: ",Opts), Ssh0}; PW -> %% If "password" option is given it should not be tried again - {PW, Ssh0#ssh{opts = lists:keyreplace(password,1,Opts,{password,not_ok})}} + {PW, Ssh0#ssh{opts = ?PUT_OPT({password,not_ok}, Opts)}} end, case Password of not_ok -> @@ -123,7 +123,7 @@ password_msg([#ssh{opts = Opts, io_cb = IoCb, keyboard_interactive_msg([#ssh{user = User, opts = Opts, service = Service} = Ssh]) -> - case proplists:get_value(password, Opts) of + case ?GET_OPT(password, Opts) of not_ok -> {not_ok,Ssh}; % No need to use a failed pwd once more _ -> @@ -141,8 +141,9 @@ publickey_msg([Alg, #ssh{user = User, service = Service, opts = Opts} = Ssh]) -> Hash = ssh_transport:sha(Alg), - KeyCb = proplists:get_value(key_cb, Opts, ssh_file), - case KeyCb:user_key(Alg, Opts) of + {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), + UserOpts = ?GET_OPT(user_options, Opts), + case KeyCb:user_key(Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of {ok, PrivKey} -> StrAlgo = atom_to_list(Alg), case encode_public_key(StrAlgo, ssh_transport:extract_public_key(PrivKey)) of @@ -174,13 +175,19 @@ service_request_msg(Ssh) -> %%%---------------------------------------------------------------- init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> - case user_name(Opts) of - {ok, User} -> + case ?GET_OPT(user, Opts) of + undefined -> + ErrStr = "Could not determine the users name", + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, + description = ErrStr}); + + User -> Msg = #ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "none", data = <<>>}, - Algs0 = proplists:get_value(pref_public_key_algs, Opts, ?SUPPORTED_USER_KEYS), + Algs0 = ?GET_OPT(pref_public_key_algs, Opts), %% The following line is not strictly correct. The call returns the %% supported HOST key types while we are interested in USER keys. However, %% they "happens" to be the same (for now). This could change.... @@ -194,12 +201,7 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, userauth_preference = Prefs, userauth_methods = none, - service = "ssh-connection"}); - {error, no_user} -> - ErrStr = "Could not determine the users name", - ssh_connection_handler:disconnect( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, - description = ErrStr}) + service = "ssh-connection"}) end. %%%---------------------------------------------------------------- @@ -342,7 +344,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, false}, {Name, Instruction, Prompt, Echo} = - case proplists:get_value(auth_method_kb_interactive_data, Opts) of + case ?GET_OPT(auth_method_kb_interactive_data, Opts) of undefined -> Default; {_,_,_,_}=V -> @@ -407,9 +409,9 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, user = User, userauth_supported_methods = Methods} = Ssh) -> SendOneEmpty = - (proplists:get_value(tstflg,Opts) == one_empty) + (?GET_OPT(tstflg,Opts) == one_empty) orelse - proplists:get_value(one_empty, proplists:get_value(tstflg,Opts,[]), false), + proplists:get_value(one_empty, ?GET_OPT(tstflg,Opts), false), case check_password(User, unicode:characters_to_list(Password), Opts, Ssh) of {true,Ssh1} when SendOneEmpty==true -> @@ -460,27 +462,8 @@ method_preference(Algs) -> ], Algs). -user_name(Opts) -> - Env = case os:type() of - {win32, _} -> - "USERNAME"; - {unix, _} -> - "LOGNAME" - end, - case proplists:get_value(user, Opts, os:getenv(Env)) of - false -> - case os:getenv("USER") of - false -> - {error, no_user}; - User -> - {ok, User} - end; - User -> - {ok, User} - end. - check_password(User, Password, Opts, Ssh) -> - case proplists:get_value(pwdfun, Opts) of + case ?GET_OPT(pwdfun, Opts) of undefined -> Static = get_password_option(Opts, User), {Password == Static, Ssh}; @@ -510,17 +493,18 @@ check_password(User, Password, Opts, Ssh) -> end. get_password_option(Opts, User) -> - Passwords = proplists:get_value(user_passwords, Opts, []), + Passwords = ?GET_OPT(user_passwords, Opts), case lists:keysearch(User, 1, Passwords) of {value, {User, Pw}} -> Pw; - false -> proplists:get_value(password, Opts, false) + false -> ?GET_OPT(password, Opts) end. pre_verify_sig(User, Alg, KeyBlob, Opts) -> try {ok, Key} = decode_public_key_v2(KeyBlob, Alg), - KeyCb = proplists:get_value(key_cb, Opts, ssh_file), - KeyCb:is_auth_key(Key, User, Opts) + {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), + UserOpts = ?GET_OPT(user_options, Opts), + KeyCb:is_auth_key(Key, User, [{key_cb_private,KeyCbOpts}|UserOpts]) catch _:_ -> false @@ -529,9 +513,10 @@ pre_verify_sig(User, Alg, KeyBlob, Opts) -> verify_sig(SessionId, User, Service, Alg, KeyBlob, SigWLen, Opts) -> try {ok, Key} = decode_public_key_v2(KeyBlob, Alg), - KeyCb = proplists:get_value(key_cb, Opts, ssh_file), - case KeyCb:is_auth_key(Key, User, Opts) of + {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), + UserOpts = ?GET_OPT(user_options, Opts), + case KeyCb:is_auth_key(Key, User, [{key_cb_private,KeyCbOpts}|UserOpts]) of true -> PlainText = build_sig_data(SessionId, User, Service, KeyBlob, Alg), @@ -565,9 +550,9 @@ decode_keyboard_interactive_prompts(_NumPrompts, Data) -> keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos) -> NumPrompts = length(PromptInfos), - keyboard_interact_get_responses(proplists:get_value(user_interaction, Opts, true), - proplists:get_value(keyboard_interact_fun, Opts), - proplists:get_value(password, Opts, undefined), IoCb, Name, + keyboard_interact_get_responses(?GET_OPT(user_interaction, Opts), + ?GET_OPT(keyboard_interact_fun, Opts), + ?GET_OPT(password, Opts), IoCb, Name, Instr, PromptInfos, Opts, NumPrompts). diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 6f8c050486..4c4f61e036 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -499,14 +499,12 @@ start_shell(ConnectionHandler, State) -> [peer, user]), ShellFun = case is_function(Shell) of true -> - User = - proplists:get_value(user, ConnectionInfo), + User = proplists:get_value(user, ConnectionInfo), case erlang:fun_info(Shell, arity) of {arity, 1} -> fun() -> Shell(User) end; {arity, 2} -> - {_, PeerAddr} = - proplists:get_value(peer, ConnectionInfo), + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(User, PeerAddr) end; _ -> Shell @@ -525,8 +523,7 @@ start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), - User = - proplists:get_value(user, ConnectionInfo), + User = proplists:get_value(user, ConnectionInfo), ShellFun = case erlang:fun_info(Shell, arity) of {arity, 1} -> @@ -534,8 +531,7 @@ start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function {arity, 2} -> fun() -> Shell(Cmd, User) end; {arity, 3} -> - {_, PeerAddr} = - proplists:get_value(peer, ConnectionInfo), + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(Cmd, User, PeerAddr) end; _ -> Shell diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 4fb6bc39f3..c91c56435e 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -22,9 +22,9 @@ %%% Description : SSH connection protocol --type role() :: client | server . --type connection_ref() :: pid(). -type channel_id() :: pos_integer(). +-type connection_ref() :: pid(). + -define(DEFAULT_PACKET_SIZE, 65536). -define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index c7a2c92670..930ccecb4c 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -56,8 +56,8 @@ %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec session_channel(pid(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. --spec session_channel(pid(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. +-spec session_channel(connection_ref(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. +-spec session_channel(connection_ref(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. %% Description: Opens a channel for a ssh session. A session is a %% remote execution of a program. The program may be a shell, an @@ -81,7 +81,7 @@ session_channel(ConnectionHandler, InitialWindowSize, end. %%-------------------------------------------------------------------- --spec exec(pid(), channel_id(), string(), timeout()) -> +-spec exec(connection_ref(), channel_id(), string(), timeout()) -> success | failure | {error, timeout | closed}. %% Description: Will request that the server start the @@ -92,7 +92,7 @@ exec(ConnectionHandler, ChannelId, Command, TimeOut) -> true, [?string(Command)], TimeOut). %%-------------------------------------------------------------------- --spec shell(pid(), channel_id()) -> _. +-spec shell(connection_ref(), channel_id()) -> _. %% Description: Will request that the user's default shell (typically %% defined in /etc/passwd in UNIX systems) be started at the other @@ -102,7 +102,7 @@ shell(ConnectionHandler, ChannelId) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "shell", false, <<>>, 0). %%-------------------------------------------------------------------- --spec subsystem(pid(), channel_id(), string(), timeout()) -> +-spec subsystem(connection_ref(), channel_id(), string(), timeout()) -> success | failure | {error, timeout | closed}. %% %% Description: Executes a predefined subsystem. @@ -112,11 +112,11 @@ subsystem(ConnectionHandler, ChannelId, SubSystem, TimeOut) -> ChannelId, "subsystem", true, [?string(SubSystem)], TimeOut). %%-------------------------------------------------------------------- --spec send(pid(), channel_id(), iodata()) -> +-spec send(connection_ref(), channel_id(), iodata()) -> ok | {error, closed}. --spec send(pid(), channel_id(), integer()| iodata(), timeout() | iodata()) -> +-spec send(connection_ref(), channel_id(), integer()| iodata(), timeout() | iodata()) -> ok | {error, timeout} | {error, closed}. --spec send(pid(), channel_id(), integer(), iodata(), timeout()) -> +-spec send(connection_ref(), channel_id(), integer(), iodata(), timeout()) -> ok | {error, timeout} | {error, closed}. %% %% @@ -134,7 +134,7 @@ send(ConnectionHandler, ChannelId, Type, Data, TimeOut) -> ssh_connection_handler:send(ConnectionHandler, ChannelId, Type, Data, TimeOut). %%-------------------------------------------------------------------- --spec send_eof(pid(), channel_id()) -> ok | {error, closed}. +-spec send_eof(connection_ref(), channel_id()) -> ok | {error, closed}. %% %% %% Description: Sends eof on the channel <ChannelId>. @@ -143,7 +143,7 @@ send_eof(ConnectionHandler, Channel) -> ssh_connection_handler:send_eof(ConnectionHandler, Channel). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok | {error, closed}. +-spec adjust_window(connection_ref(), channel_id(), integer()) -> ok | {error, closed}. %% %% %% Description: Adjusts the ssh flowcontrol window. @@ -152,7 +152,7 @@ adjust_window(ConnectionHandler, Channel, Bytes) -> ssh_connection_handler:adjust_window(ConnectionHandler, Channel, Bytes). %%-------------------------------------------------------------------- --spec setenv(pid(), channel_id(), string(), string(), timeout()) -> +-spec setenv(connection_ref(), channel_id(), string(), string(), timeout()) -> success | failure | {error, timeout | closed}. %% %% @@ -165,7 +165,7 @@ setenv(ConnectionHandler, ChannelId, Var, Value, TimeOut) -> %%-------------------------------------------------------------------- --spec close(pid(), channel_id()) -> ok. +-spec close(connection_ref(), channel_id()) -> ok. %% %% %% Description: Sends a close message on the channel <ChannelId>. @@ -174,7 +174,7 @@ close(ConnectionHandler, ChannelId) -> ssh_connection_handler:close(ConnectionHandler, ChannelId). %%-------------------------------------------------------------------- --spec reply_request(pid(), boolean(), success | failure, channel_id()) -> ok. +-spec reply_request(connection_ref(), boolean(), success | failure, channel_id()) -> ok. %% %% %% Description: Send status replies to requests that want such replies. @@ -185,9 +185,9 @@ reply_request(_,false, _, _) -> ok. %%-------------------------------------------------------------------- --spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> +-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist()) -> success | failiure | {error, closed}. --spec ptty_alloc(pid(), channel_id(), proplists:proplist(), timeout()) -> +-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist(), timeout()) -> success | failiure | {error, timeout} | {error, closed}. %% @@ -197,16 +197,16 @@ reply_request(_,false, _, _) -> ptty_alloc(ConnectionHandler, Channel, Options) -> ptty_alloc(ConnectionHandler, Channel, Options, infinity). ptty_alloc(ConnectionHandler, Channel, Options0, TimeOut) -> - Options = backwards_compatible(Options0, []), - {Width, PixWidth} = pty_default_dimensions(width, Options), - {Height, PixHeight} = pty_default_dimensions(height, Options), + TermData = backwards_compatible(Options0, []), % FIXME + {Width, PixWidth} = pty_default_dimensions(width, TermData), + {Height, PixHeight} = pty_default_dimensions(height, TermData), pty_req(ConnectionHandler, Channel, - proplists:get_value(term, Options, os:getenv("TERM", ?DEFAULT_TERMINAL)), - proplists:get_value(width, Options, Width), - proplists:get_value(height, Options, Height), - proplists:get_value(pixel_widh, Options, PixWidth), - proplists:get_value(pixel_height, Options, PixHeight), - proplists:get_value(pty_opts, Options, []), TimeOut + proplists:get_value(term, TermData, os:getenv("TERM", ?DEFAULT_TERMINAL)), + proplists:get_value(width, TermData, Width), + proplists:get_value(height, TermData, Height), + proplists:get_value(pixel_widh, TermData, PixWidth), + proplists:get_value(pixel_height, TermData, PixHeight), + proplists:get_value(pty_opts, TermData, []), TimeOut ). %%-------------------------------------------------------------------- %% Not yet officialy supported! The following functions are part of the @@ -417,7 +417,8 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, maximum_packet_size = PacketSz}, #connection{options = SSHopts} = Connection0, server) -> - MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0), + MinAcceptedPackSz = + ?GET_OPT(minimal_remote_max_packet_size, SSHopts), if MinAcceptedPackSz =< PacketSz -> @@ -574,7 +575,6 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId, PixWidth, PixHeight, decode_pty_opts(Modes)}, Channel = ssh_channel:cache_lookup(Cache, ChannelId), - handle_cli_msg(Connection, Channel, {pty, ChannelId, WantReply, PtyRequest}); @@ -691,7 +691,6 @@ handle_cli_msg(#connection{channel_cache = Cache} = Connection, #channel{user = undefined, remote_id = RemoteId, local_id = ChannelId} = Channel0, Reply0) -> - case (catch start_cli(Connection, ChannelId)) of {ok, Pid} -> erlang:monitor(process, Pid), @@ -819,7 +818,7 @@ start_channel(Cb, Id, Args, SubSysSup, Exec, Opts) -> ssh_channel_sup:start_child(ChannelSup, ChildSpec). assert_limit_num_channels_not_exceeded(ChannelSup, Opts) -> - MaxNumChannels = proplists:get_value(max_channels, Opts, infinity), + MaxNumChannels = ?GET_OPT(max_channels, Opts), NumChannels = length([x || {_,_,worker,[ssh_channel]} <- supervisor:which_children(ChannelSup)]), if @@ -858,8 +857,8 @@ setup_session(#connection{channel_cache = Cache check_subsystem("sftp"= SsName, Options) -> - case proplists:get_value(subsystems, Options, no_subsys) of - no_subsys -> + case ?GET_OPT(subsystems, Options) of + no_subsys -> % FIXME: Can 'no_subsys' ever be matched? {SsName, {Cb, Opts}} = ssh_sftpd:subsystem_spec([]), {Cb, Opts}; SubSystems -> @@ -867,7 +866,7 @@ check_subsystem("sftp"= SsName, Options) -> end; check_subsystem(SsName, Options) -> - Subsystems = proplists:get_value(subsystems, Options, []), + Subsystems = ?GET_OPT(subsystems, Options), case proplists:get_value(SsName, Subsystems, {none, []}) of Fun when is_function(Fun) -> {Fun, []}; @@ -1022,12 +1021,13 @@ pty_req(ConnectionHandler, Channel, Term, Width, Height, ?uint32(PixWidth),?uint32(PixHeight), encode_pty_opts(PtyOpts)], TimeOut). -pty_default_dimensions(Dimension, Options) -> - case proplists:get_value(Dimension, Options, 0) of +pty_default_dimensions(Dimension, TermData) -> + case proplists:get_value(Dimension, TermData, 0) of N when is_integer(N), N > 0 -> {N, 0}; _ -> - case proplists:get_value(list_to_atom("pixel_" ++ atom_to_list(Dimension)), Options, 0) of + PixelDim = list_to_atom("pixel_" ++ atom_to_list(Dimension)), + case proplists:get_value(PixelDim, TermData, 0) of N when is_integer(N), N > 0 -> {0, N}; _ -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index dcf509ca09..b9c643c77e 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -76,7 +76,7 @@ %%-------------------------------------------------------------------- -spec start_link(role(), inet:socket(), - proplists:proplist() + ssh_options:options() ) -> {ok, pid()}. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_link(Role, Socket, Options) -> @@ -99,12 +99,10 @@ stop(ConnectionHandler)-> %% Internal application API %%==================================================================== --define(DefaultTransport, {tcp, gen_tcp, tcp_closed} ). - %%-------------------------------------------------------------------- -spec start_connection(role(), inet:socket(), - proplists:proplist(), + ssh_options:options(), timeout() ) -> {ok, connection_ref()} | {error, term()}. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . @@ -121,9 +119,8 @@ start_connection(client = Role, Socket, Options, Timeout) -> end; start_connection(server = Role, Socket, Options, Timeout) -> - SSH_Opts = proplists:get_value(ssh_opts, Options, []), try - case proplists:get_value(parallel_login, SSH_Opts, false) of + case ?GET_OPT(parallel_login, Options) of true -> HandshakerPid = spawn_link(fun() -> @@ -346,7 +343,7 @@ renegotiate_data(ConnectionHandler) -> | undefined, last_size_rekey = 0 :: non_neg_integer(), event_queue = [] :: list(), - opts :: proplists:proplist(), + opts :: ssh_options:options(), inet_initial_recbuf_size :: pos_integer() | undefined }). @@ -357,15 +354,14 @@ renegotiate_data(ConnectionHandler) -> %%-------------------------------------------------------------------- -spec init_connection_handler(role(), inet:socket(), - proplists:proplist() + ssh_options:options() ) -> no_return(). %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . init_connection_handler(Role, Socket, Opts) -> process_flag(trap_exit, true), S0 = init_process_state(Role, Socket, Opts), try - {Protocol, Callback, CloseTag} = - proplists:get_value(transport, Opts, ?DefaultTransport), + {Protocol, Callback, CloseTag} = ?GET_OPT(transport, Opts), S0#data{ssh_params = init_ssh_record(Role, Socket, Opts), transport_protocol = Protocol, transport_cb = Callback, @@ -393,7 +389,7 @@ init_process_state(Role, Socket, Opts) -> port_bindings = [], requests = [], options = Opts}, - starter = proplists:get_value(user_pid, Opts), + starter = ?GET_INTERNAL_OPT(user_pid, Opts), socket = Socket, opts = Opts }, @@ -409,13 +405,18 @@ init_process_state(Role, Socket, Opts) -> init_connection(server, C = #connection{}, Opts) -> - Sups = proplists:get_value(supervisors, Opts), - SystemSup = proplists:get_value(system_sup, Sups), - SubSystemSup = proplists:get_value(subsystem_sup, Sups), + Sups = ?GET_INTERNAL_OPT(supervisors, Opts), + + SystemSup = proplists:get_value(system_sup, Sups), + SubSystemSup = proplists:get_value(subsystem_sup, Sups), ConnectionSup = proplists:get_value(connection_sup, Sups), - Shell = proplists:get_value(shell, Opts), - Exec = proplists:get_value(exec, Opts), - CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), + + Shell = ?GET_OPT(shell, Opts), + Exec = ?GET_OPT(exec, Opts), + CliSpec = case ?GET_OPT(ssh_cli, Opts) of + undefined -> {ssh_cli, [Shell]}; + Spec -> Spec + end, C#connection{cli_spec = CliSpec, exec = Exec, system_supervisor = SystemSup, @@ -426,41 +427,38 @@ init_connection(server, C = #connection{}, Opts) -> init_ssh_record(Role, Socket, Opts) -> {ok, PeerAddr} = inet:peername(Socket), - KeyCb = proplists:get_value(key_cb, Opts, ssh_file), - AuthMethods = proplists:get_value(auth_methods, - Opts, - case Role of - server -> ?SUPPORTED_AUTH_METHODS; - client -> undefined - end), + KeyCb = ?GET_OPT(key_cb, Opts), + AuthMethods = + case Role of + server -> ?GET_OPT(auth_methods, Opts); + client -> undefined + end, S0 = #ssh{role = Role, key_cb = KeyCb, opts = Opts, userauth_supported_methods = AuthMethods, available_host_keys = supported_host_keys(Role, KeyCb, Opts), - random_length_padding = proplists:get_value(max_random_length_padding, - Opts, - (#ssh{})#ssh.random_length_padding) + random_length_padding = ?GET_OPT(max_random_length_padding, Opts) }, {Vsn, Version} = ssh_transport:versions(Role, Opts), case Role of client -> - PeerName = proplists:get_value(host, Opts), + PeerName = ?GET_INTERNAL_OPT(host, Opts), S0#ssh{c_vsn = Vsn, c_version = Version, - io_cb = case proplists:get_value(user_interaction, Opts, true) of + io_cb = case ?GET_OPT(user_interaction, Opts) of true -> ssh_io; false -> ssh_no_io end, - userauth_quiet_mode = proplists:get_value(quiet_mode, Opts, false), + userauth_quiet_mode = ?GET_OPT(quiet_mode, Opts), peer = {PeerName, PeerAddr} }; server -> S0#ssh{s_vsn = Vsn, s_version = Version, - io_cb = proplists:get_value(io_cb, Opts, ssh_io), + io_cb = ?GET_INTERNAL_OPT(io_cb, Opts, ssh_io), userauth_methods = string:tokens(AuthMethods, ","), kb_tries_left = 3, peer = {undefined, PeerAddr} @@ -849,14 +847,12 @@ handle_event(_, Msg = #ssh_msg_userauth_failure{}, {userauth_keyboard_interactiv handle_event(_, Msg=#ssh_msg_userauth_failure{}, {userauth_keyboard_interactive_info_response, client}, #data{ssh_params = Ssh0} = D0) -> Opts = Ssh0#ssh.opts, - D = case proplists:get_value(password, Opts) of + D = case ?GET_OPT(password, Opts) of undefined -> D0; _ -> D0#data{ssh_params = - Ssh0#ssh{opts = - lists:keyreplace(password,1,Opts, - {password,not_ok})}} % FIXME:intermodule dependency + Ssh0#ssh{opts = ?PUT_OPT({password,not_ok}, Opts)}} % FIXME:intermodule dependency end, {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; @@ -954,7 +950,7 @@ handle_event(cast, renegotiate, _, _) -> handle_event(cast, data_size, {connected,Role}, D) -> {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), Sent = Sent0 - D#data.last_size_rekey, - MaxSent = proplists:get_value(rekey_limit, D#data.opts, 1024000000), + MaxSent = ?GET_OPT(rekey_limit, D#data.opts), timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> @@ -1294,11 +1290,12 @@ handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> "Unexpected message '~p' received in state '~p'\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, - StateName, - Ssh#ssh.role, - Ssh#ssh.peer, - proplists:get_value(address, Ssh#ssh.opts)])), + "Local Address: ~p\n", + [UnexpectedMessage, + StateName, + Ssh#ssh.role, + Ssh#ssh.peer, + ?GET_INTERNAL_OPT(address, Ssh#ssh.opts)])), error_logger:info_report(Msg), keep_state_and_data; @@ -1312,11 +1309,12 @@ handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> "Message: ~p\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [Other, - UnexpectedMessage, - Ssh#ssh.role, - element(2,Ssh#ssh.peer), - proplists:get_value(address, Ssh#ssh.opts)] + "Local Address: ~p\n", + [Other, + UnexpectedMessage, + Ssh#ssh.role, + element(2,Ssh#ssh.peer), + ?GET_INTERNAL_OPT(address, Ssh#ssh.opts)] )), error_logger:error_report(Msg), keep_state_and_data @@ -1438,11 +1436,11 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %% Starting -start_the_connection_child(UserPid, Role, Socket, Options) -> - Sups = proplists:get_value(supervisors, Options), +start_the_connection_child(UserPid, Role, Socket, Options0) -> + Sups = ?GET_INTERNAL_OPT(supervisors, Options0), ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + Options = ?PUT_INTERNAL_OPT({user_pid,UserPid}, Options0), + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Options]), ok = socket_control(Socket, Pid, Options), Pid. @@ -1499,7 +1497,7 @@ supported_host_keys(server, KeyCb, Options) -> find_sup_hkeys(Options) -> case proplists:get_value(public_key, - proplists:get_value(preferred_algorithms,Options,[]) + ?GET_OPT(preferred_algorithms,Options) ) of undefined -> @@ -1512,9 +1510,10 @@ find_sup_hkeys(Options) -> %% Alg :: atom() -available_host_key(KeyCb, Alg, Opts) -> - element(1, catch KeyCb:host_key(Alg, Opts)) == ok. - +available_host_key({KeyCb,KeyCbOpts}, Alg, Opts) -> + UserOpts = ?GET_OPT(user_options, Opts), + element(1, + catch KeyCb:host_key(Alg, [{key_cb_private,KeyCbOpts}|UserOpts])) == ok. send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) -> {Bytes, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), @@ -1770,47 +1769,24 @@ get_repl(X, Acc) -> exit({get_repl,X,Acc}). %%%---------------------------------------------------------------- -disconnect_fun({disconnect,Msg}, D) -> - disconnect_fun(Msg, D); -disconnect_fun(Reason, #data{opts=Opts}) -> - case proplists:get_value(disconnectfun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(Reason) - end. - -unexpected_fun(UnexpectedMessage, #data{opts = Opts, - ssh_params = #ssh{peer = {_,Peer} } - } ) -> - case proplists:get_value(unexpectedfun, Opts) of - undefined -> - report; - Fun -> - catch Fun(UnexpectedMessage, Peer) - end. +-define(CALL_FUN(Key,D), catch (?GET_OPT(Key, D#data.opts)) ). +disconnect_fun({disconnect,Msg}, D) -> ?CALL_FUN(disconnectfun,D)(Msg); +disconnect_fun(Reason, D) -> ?CALL_FUN(disconnectfun,D)(Reason). + +unexpected_fun(UnexpectedMessage, #data{ssh_params = #ssh{peer = {_,Peer} }} = D) -> + ?CALL_FUN(unexpectedfun,D)(UnexpectedMessage, Peer). debug_fun(#ssh_msg_debug{always_display = Display, message = DbgMsg, language = Lang}, - #data{opts = Opts}) -> - case proplists:get_value(ssh_msg_debug_fun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(self(), Display, DbgMsg, Lang) - end. + D) -> + ?CALL_FUN(ssh_msg_debug_fun,D)(self(), Display, DbgMsg, Lang). -connected_fun(User, Method, #data{ssh_params = #ssh{peer = {_,Peer}}, - opts = Opts}) -> - case proplists:get_value(connectfun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(User, Peer, Method) - end. +connected_fun(User, Method, #data{ssh_params = #ssh{peer = {_,Peer}}} = D) -> + ?CALL_FUN(connectfun,D)(User, Peer, Method). + retry_fun(_, undefined, _) -> ok; @@ -1824,7 +1800,7 @@ retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, _ -> {infofun, Reason} end, - Fun = proplists:get_value(Tag, Opts, fun(_,_)-> ok end), + Fun = ?GET_OPT(Tag, Opts), try erlang:fun_info(Fun, arity) of {arity, 2} -> %% Backwards compatible @@ -1843,7 +1819,7 @@ retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, %%% channels open for a while. cache_init_idle_timer(D) -> - case proplists:get_value(idle_time, D#data.opts, infinity) of + case ?GET_OPT(idle_time, D#data.opts) of infinity -> D#data{idle_timer_value = infinity, idle_timer_ref = infinity % A flag used later... @@ -1906,9 +1882,8 @@ start_channel_request_timer(Channel, From, Time) -> %%% Connection start and initalization helpers socket_control(Socket, Pid, Options) -> - {_, TransportCallback, _} = % For example {_,gen_tcp,_} - proplists:get_value(transport, Options, ?DefaultTransport), - case TransportCallback:controlling_process(Socket, Pid) of + {_, Callback, _} = ?GET_OPT(transport, Options), + case Callback:controlling_process(Socket, Pid) of ok -> gen_statem:cast(Pid, socket_control); {error, Reason} -> diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 216f65f33a..898b4cc5c4 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -192,8 +192,8 @@ lookup_user_key(Key, User, Opts) -> ssh_dir({remoteuser, User}, Opts) -> case proplists:get_value(user_dir_fun, Opts) of undefined -> - case proplists:get_value(user_dir, Opts) of - undefined -> + case proplists:get_value(user_dir, Opts, false) of + false -> default_user_dir(); Dir -> Dir diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 1d8f370884..6828fd4760 100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl @@ -27,17 +27,17 @@ -export([yes_no/2, read_password/2, read_line/2, format/2]). -include("ssh.hrl"). -read_line(Prompt, Ssh) -> +read_line(Prompt, Opts) -> format("~s", [listify(Prompt)]), - proplists:get_value(user_pid, Ssh) ! {self(), question}, + ?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), question}, receive Answer when is_list(Answer) -> Answer end. -yes_no(Prompt, Ssh) -> +yes_no(Prompt, Opts) -> format("~s [y/n]?", [Prompt]), - proplists:get_value(user_pid, Ssh#ssh.opts) ! {self(), question}, + ?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), question}, receive %% I can't see that the atoms y and n are ever received, but it must %% be investigated before removing @@ -52,15 +52,13 @@ yes_no(Prompt, Ssh) -> "N" -> no; _ -> format("please answer y or n\n",[]), - yes_no(Prompt, Ssh) + yes_no(Prompt, Opts) end end. - -read_password(Prompt, #ssh{opts=Opts}) -> read_password(Prompt, Opts); -read_password(Prompt, Opts) when is_list(Opts) -> +read_password(Prompt, Opts) -> format("~s", [listify(Prompt)]), - proplists:get_value(user_pid, Opts) ! {self(), user_password}, + ?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), user_password}, receive Answer when is_list(Answer) -> case trim(Answer) of diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl new file mode 100644 index 0000000000..395be6b220 --- /dev/null +++ b/lib/ssh/src/ssh_options.erl @@ -0,0 +1,895 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-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_options). + +-include("ssh.hrl"). +-include_lib("kernel/include/file.hrl"). + +-export([default/1, + get_value/5, get_value/6, + put_value/5, + handle_options/2 + ]). + +-export_type([options/0 + ]). + +%%%================================================================ +%%% Types + +-type options() :: #{socket_options := socket_options(), + internal_options := internal_options(), + option_key() => any() + }. + +-type socket_options() :: proplists:proplist(). +-type internal_options() :: #{option_key() => any()}. + +-type option_key() :: atom(). + +-type option_in() :: proplists:property() | proplists:proplist() . + +-type option_class() :: internal_options | socket_options | user_options . + +-type option_declaration() :: #{class := user_options, + chk := fun((any) -> boolean() | {true,any()}), + default => any() + }. + +-type option_declarations() :: #{ {option_key(),def} := option_declaration() }. + +-type error() :: {error,{eoptions,any()}} . + +%%%================================================================ +%%% +%%% Get an option +%%% + +-spec get_value(option_class(), option_key(), options(), + atom(), non_neg_integer()) -> any() | no_return(). + +get_value(Class, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> + case Class of + internal_options -> maps:get(Key, maps:get(internal_options,Opts)); + socket_options -> proplists:get_value(Key, maps:get(socket_options,Opts)); + user_options -> maps:get(Key, Opts) + end; +get_value(Class, Key, Opts, _CallerMod, _CallerLine) -> + io:format("*** Bad Opts GET OPT ~p ~p:~p Key=~p,~n Opts=~p~n",[Class,_CallerMod,_CallerLine,Key,Opts]), + error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}). + + +-spec get_value(option_class(), option_key(), options(), any(), + atom(), non_neg_integer()) -> any() | no_return(). + +get_value(socket_options, Key, Opts, Def, _CallerMod, _CallerLine) when is_map(Opts) -> + proplists:get_value(Key, maps:get(socket_options,Opts), Def); +get_value(Class, Key, Opts, Def, CallerMod, CallerLine) when is_map(Opts) -> + try get_value(Class, Key, Opts, CallerMod, CallerLine) + catch + error:{badkey,Key} -> Def + end; +get_value(Class, Key, Opts, _Def, _CallerMod, _CallerLine) -> + io:format("*** Bad Opts GET OPT ~p ~p:~p Key=~p,~n Opts=~p~n",[Class,_CallerMod,_CallerLine,Key,Opts]), + error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}). + + +%%%================================================================ +%%% +%%% Put an option +%%% + +-spec put_value(option_class(), option_in(), options(), + atom(), non_neg_integer()) -> options(). + +put_value(user_options, KeyVal, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> + put_user_value(KeyVal, Opts); + +put_value(internal_options, KeyVal, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> + InternalOpts = maps:get(internal_options,Opts), + Opts#{internal_options := put_internal_value(KeyVal, InternalOpts)}; + +put_value(socket_options, KeyVal, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> + SocketOpts = maps:get(socket_options,Opts), + Opts#{socket_options := put_socket_value(KeyVal, SocketOpts)}. + + +%%%---------------- +put_user_value(L, Opts) when is_list(L) -> + lists:foldl(fun put_user_value/2, Opts, L); +put_user_value({Key,Value}, Opts) -> + Opts#{Key := Value}. + +%%%---------------- +put_internal_value(L, IntOpts) when is_list(L) -> + lists:foldl(fun put_internal_value/2, IntOpts, L); +put_internal_value({Key,Value}, IntOpts) -> + IntOpts#{Key => Value}. + +%%%---------------- +put_socket_value(L, SockOpts) when is_list(L) -> + L ++ SockOpts; +put_socket_value({Key,Value}, SockOpts) -> + [{Key,Value} | SockOpts]; +put_socket_value(A, SockOpts) when is_atom(A) -> + [A | SockOpts]. + +%%%================================================================ +%%% +%%% Initialize the options +%%% + +-spec handle_options(role(), proplists:proplist()) -> options() | error() . + +-spec handle_options(role(), proplists:proplist(), options()) -> options() | error() . + +handle_options(Role, PropList0) -> + handle_options(Role, PropList0, #{socket_options => [], + internal_options => #{}, + user_options => [] + }). + +handle_options(Role, PropList0, Opts0) when is_map(Opts0), + is_list(PropList0) -> + PropList1 = proplists:unfold(PropList0), + try + OptionDefinitions = default(Role), + InitialMap = + maps:fold( + fun({K,def}, #{default:=V}, M) -> M#{K=>V}; + (_,_,M) -> M + end, + Opts0#{user_options => + maps:get(user_options,Opts0) ++ PropList1 + }, + OptionDefinitions), + %% Enter the user's values into the map; unknown keys are + %% treated as socket options + lists:foldl(fun(KV, Vals) -> + save(KV, OptionDefinitions, Vals) + end, InitialMap, PropList1) + catch + error:{eoptions, KV, undefined} -> + {error, {eoptions,KV}}; + + error:{eoptions, KV, Txt} when is_list(Txt) -> + {error, {eoptions,{KV,lists:flatten(Txt)}}}; + + error:{eoptions, KV, Extra} -> + {error, {eoptions,{KV,Extra}}} + end. + + +check_fun(Key, Defs) -> + #{chk := Fun} = maps:get({Key,def}, Defs), + Fun. + +%%%================================================================ +%%% +%%% Check and save one option +%%% + + +%%% First some prohibited inet options: +save({K,V}, _, _) when K == reuseaddr ; + K == active + -> + forbidden_option(K, V); + +%%% then compatibility conversions: +save({allow_user_interaction,V}, Opts, Vals) -> + save({user_interaction,V}, Opts, Vals); + +save({public_key_alg,V}, Defs, Vals) -> % To remove in OTP-20 + New = case V of + 'ssh-rsa' -> ['ssh-rsa', 'ssh-dss']; + ssh_rsa -> ['ssh-rsa', 'ssh-dss']; + 'ssh-dss' -> ['ssh-dss', 'ssh-rsa']; + ssh_dsa -> ['ssh-dss', 'ssh-rsa']; + _ -> error({eoptions, {public_key_alg,V}, + "Unknown algorithm, try pref_public_key_algs instead"}) + end, + save({pref_public_key_algs,New}, Defs, Vals); + +%% Special case for socket options 'inet' and 'inet6' +save(Inet, Defs, OptMap) when Inet==inet ; Inet==inet6 -> + save({inet,Inet}, Defs, OptMap); + +%% Two clauses to prepare for a proplists:unfold +save({Inet,true}, Defs, OptMap) when Inet==inet ; Inet==inet6 -> save({inet,Inet}, Defs, OptMap); +save({Inet,false}, _Defs, OptMap) when Inet==inet ; Inet==inet6 -> OptMap; + +%% and finaly the 'real stuff': +save({Key,Value}, Defs, OptMap) when is_map(OptMap) -> + try (check_fun(Key,Defs))(Value) + of + true -> + OptMap#{Key := Value}; + {true, ModifiedValue} -> + OptMap#{Key := ModifiedValue}; + false -> + error({eoptions, {Key,Value}, "Bad value"}) + catch + %% An unknown Key (= not in the definition map) is + %% regarded as an inet option: + error:{badkey,{inet,def}} -> + %% atomic (= non-tuple) options 'inet' and 'inet6': + OptMap#{socket_options := [Value | maps:get(socket_options,OptMap)]}; + error:{badkey,{Key,def}} -> + OptMap#{socket_options := [{Key,Value} | maps:get(socket_options,OptMap)]}; + + %% But a Key that is known but the value does not validate + %% by the check fun will give an error exception: + error:{check,{BadValue,Extra}} -> + error({eoptions, {Key,BadValue}, Extra}) + end. + +%%%================================================================ +%%% +%%% Default options +%%% + +-spec default(role() | common) -> option_declarations() . + +default(server) -> + (default(common)) + #{ + {subsystems, def} => + #{default => [ssh_sftpd:subsystem_spec([])], + chk => fun(L) -> + is_list(L) andalso + lists:all(fun({Name,{CB,Args}}) -> + check_string(Name) andalso + is_atom(CB) andalso + is_list(Args); + (_) -> + false + end, L) + end, + class => user_options + }, + + {shell, def} => + #{default => {shell, start, []}, + chk => fun({M,F,A}) -> is_atom(M) andalso is_atom(F) andalso is_list(A); + (V) -> check_function1(V) orelse check_function2(V) + end, + class => user_options + }, + + {exec, def} => % FIXME: need some archeology.... + #{default => undefined, + chk => fun({M,F,_}) -> is_atom(M) andalso is_atom(F); + (V) -> is_function(V) + end, + class => user_options + }, + + {ssh_cli, def} => + #{default => undefined, + chk => fun({Cb, As}) -> is_atom(Cb) andalso is_list(As); + (V) -> V == no_cli + end, + class => user_options + }, + + {system_dir, def} => + #{default => "/etc/ssh", + chk => fun(V) -> check_string(V) andalso check_dir(V) end, + class => user_options + }, + + {auth_methods, def} => + #{default => ?SUPPORTED_AUTH_METHODS, + chk => fun check_string/1, + class => user_options + }, + + {auth_method_kb_interactive_data, def} => + #{default => undefined, % Default value can be constructed when User is known + chk => fun({S1,S2,S3,B}) -> + check_string(S1) andalso + check_string(S2) andalso + check_string(S3) andalso + is_boolean(B); + (F) -> + check_function3(F) + end, + class => user_options + }, + + {user_passwords, def} => + #{default => [], + chk => fun(V) -> + is_list(V) andalso + lists:all(fun({S1,S2}) -> + check_string(S1) andalso + check_string(S2) + end, V) + end, + class => user_options + }, + + {password, def} => + #{default => undefined, + chk => fun check_string/1, + class => user_options + }, + + {dh_gex_groups, def} => + #{default => undefined, + chk => fun check_dh_gex_groups/1, + class => user_options + }, + + {dh_gex_limits, def} => + #{default => {0, infinity}, + chk => fun({I1,I2}) -> + check_pos_integer(I1) andalso + check_pos_integer(I2) andalso + I1 < I2; + (_) -> + false + end, + class => user_options + }, + + {pwdfun, def} => + #{default => undefined, + chk => fun(V) -> check_function4(V) orelse check_function2(V) end, + class => user_options + }, + + {negotiation_timeout, def} => + #{default => 2*60*1000, + chk => fun check_timeout/1, + class => user_options + }, + + {max_sessions, def} => + #{default => infinity, + chk => fun check_pos_integer/1, + class => user_options + }, + + {max_channels, def} => + #{default => infinity, + chk => fun check_pos_integer/1, + class => user_options + }, + + {parallel_login, def} => + #{default => false, + chk => fun erlang:is_boolean/1, + class => user_options + }, + + {minimal_remote_max_packet_size, def} => + #{default => 0, + chk => fun check_pos_integer/1, + class => user_options + }, + + {failfun, def} => + #{default => fun(_,_,_) -> void end, + chk => fun(V) -> check_function3(V) orelse + check_function2(V) % Backwards compatibility + end, + class => user_options + }, + + {connectfun, def} => + #{default => fun(_,_,_) -> void end, + chk => fun check_function3/1, + class => user_options + }, + +%%%%% Undocumented + {infofun, def} => + #{default => fun(_,_,_) -> void end, + chk => fun(V) -> check_function3(V) orelse + check_function2(V) % Backwards compatibility + end, + class => user_options + } + }; + +default(client) -> + (default(common)) + #{ + {dsa_pass_phrase, def} => + #{default => undefined, + chk => fun check_string/1, + class => user_options + }, + + {rsa_pass_phrase, def} => + #{default => undefined, + chk => fun check_string/1, + class => user_options + }, + + {silently_accept_hosts, def} => + #{default => false, + chk => fun check_silently_accept_hosts/1, + class => user_options + }, + + {user_interaction, def} => + #{default => true, + chk => fun erlang:is_boolean/1, + class => user_options + }, + + {pref_public_key_algs, def} => + #{default => + %% Get dynamically supported keys in the order of the ?SUPPORTED_USER_KEYS + [A || A <- ?SUPPORTED_USER_KEYS, + lists:member(A, ssh_transport:supported_algorithms(public_key))], + chk => + fun check_pref_public_key_algs/1, + class => + ssh + }, + + {dh_gex_limits, def} => + #{default => {1024, 6144, 8192}, % FIXME: Is this true nowadays? + chk => fun({Min,I,Max}) -> + lists:all(fun check_pos_integer/1, + [Min,I,Max]); + (_) -> false + end, + class => user_options + }, + + {connect_timeout, def} => + #{default => infinity, + chk => fun check_timeout/1, + class => user_options + }, + + {user, def} => + #{default => + begin + Env = case os:type() of + {win32, _} -> "USERNAME"; + {unix, _} -> "LOGNAME" + end, + case os:getenv(Env) of + false -> + case os:getenv("USER") of + false -> undefined; + User -> User + end; + User -> + User + end + end, + chk => fun check_string/1, + class => user_options + }, + + {password, def} => + #{default => undefined, + chk => fun check_string/1, + class => user_options + }, + + {quiet_mode, def} => + #{default => false, + chk => fun erlang:is_boolean/1, + class => user_options + }, + + {idle_time, def} => + #{default => infinity, + chk => fun check_timeout/1, + class => user_options + }, + +%%%%% Undocumented + {keyboard_interact_fun, def} => + #{default => undefined, + chk => fun check_function3/1, + class => user_options + } + }; + +default(common) -> + #{ + {user_dir, def} => + #{default => false, % FIXME: TBD ~/.ssh at time of call when user is known + chk => fun(V) -> check_string(V) andalso check_dir(V) end, + class => user_options + }, + + {preferred_algorithms, def} => + #{default => ssh:default_algorithms(), + chk => fun check_preferred_algorithms/1, + class => user_options + }, + + {id_string, def} => + #{default => undefined, % FIXME: see ssh_transport:ssh_vsn/0 + chk => fun(random) -> + {true, {random,2,5}}; % 2 - 5 random characters + ({random,I1,I2}) -> + %% Undocumented + check_pos_integer(I1) andalso + check_pos_integer(I2) andalso + I1=<I2; + (V) -> + check_string(V) + end, + class => user_options + }, + + {key_cb, def} => + #{default => {ssh_file, []}, + chk => fun({Mod,Opts}) -> is_atom(Mod) andalso is_list(Opts); + (Mod) when is_atom(Mod) -> {true, {Mod,[]}}; + (_) -> false + end, + class => user_options + }, + + {profile, def} => + #{default => ?DEFAULT_PROFILE, + chk => fun erlang:is_atom/1, + class => user_options + }, + + %% This is a "SocketOption"... + %% {fd, def} => + %% #{default => undefined, + %% chk => fun erlang:is_integer/1, + %% class => user_options + %% }, + + {disconnectfun, def} => + #{default => fun(_) -> void end, + chk => fun check_function1/1, + class => user_options + }, + + {unexpectedfun, def} => + #{default => fun(_,_) -> report end, + chk => fun check_function2/1, + class => user_options + }, + + {ssh_msg_debug_fun, def} => + #{default => fun(_,_,_,_) -> void end, + chk => fun check_function4/1, + class => user_options + }, + + {rekey_limit, def} => % FIXME: Why not common? + #{default => 1024000000, + chk => fun check_non_neg_integer/1, + class => user_options + }, + +%%%%% Undocumented + {transport, def} => + #{default => ?DEFAULT_TRANSPORT, + chk => fun({A,B,C}) -> + is_atom(A) andalso is_atom(B) andalso is_atom(C) + end, + class => user_options + }, + + {vsn, def} => + #{default => {2,0}, + chk => fun({Maj,Min}) -> check_non_neg_integer(Maj) andalso check_non_neg_integer(Min); + (_) -> false + end, + class => user_options + }, + + {tstflg, def} => + #{default => [], + chk => fun erlang:is_list/1, + class => user_options + }, + + {user_dir_fun, def} => + #{default => undefined, + chk => fun check_function1/1, + class => user_options + }, + + {max_random_length_padding, def} => + #{default => ?MAX_RND_PADDING_LEN, + chk => fun check_non_neg_integer/1, + class => user_options + } + }. + + +%%%================================================================ +%%%================================================================ +%%%================================================================ + +%%% +%%% check_*/1 -> true | false | error({check,Spec}) +%%% See error_in_check/2,3 +%%% + +%%% error_in_check(BadValue) -> error_in_check(BadValue, undefined). + +error_in_check(BadValue, Extra) -> error({check,{BadValue,Extra}}). + + +%%%---------------------------------------------------------------- +check_timeout(infinity) -> true; +check_timeout(I) -> check_pos_integer(I). + +%%%---------------------------------------------------------------- +check_pos_integer(I) -> is_integer(I) andalso I>0. + +%%%---------------------------------------------------------------- +check_non_neg_integer(I) -> is_integer(I) andalso I>=0. + +%%%---------------------------------------------------------------- +check_function1(F) -> is_function(F,1). +check_function2(F) -> is_function(F,2). +check_function3(F) -> is_function(F,3). +check_function4(F) -> is_function(F,4). + +%%%---------------------------------------------------------------- +check_pref_public_key_algs(V) -> + %% Get the dynamically supported keys, that is, thoose + %% that are stored + PKs = ssh_transport:supported_algorithms(public_key), + CHK = fun(A, Ack) -> + case lists:member(A, PKs) of + true -> + [A|Ack]; + false -> + %% Check with the documented options, that is, + %% the one we can handle + case lists:member(A,?SUPPORTED_USER_KEYS) of + false -> + %% An algorithm ssh never can handle + error_in_check(A, "Not supported public key"); + true -> + %% An algorithm ssh can handle, but not in + %% this very call + Ack + end + end + end, + case lists:foldr( + fun(ssh_dsa, Ack) -> CHK('ssh-dss', Ack); % compatibility + (ssh_rsa, Ack) -> CHK('ssh-rsa', Ack); % compatibility + (X, Ack) -> CHK(X, Ack) + end, [], V) + of + V -> true; + [] -> false; + V1 -> {true,V1} + end. + + +%%%---------------------------------------------------------------- +%% Check that it is a directory and is readable +check_dir(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory, + access = Access}} -> + case Access of + read -> true; + read_write -> true; + _ -> error_in_check(Dir, eacces) + end; + + {ok, #file_info{}}-> + error_in_check(Dir, enotdir); + + {error, Error} -> + error_in_check(Dir, Error) + end. + +%%%---------------------------------------------------------------- +check_string(S) -> is_list(S). % FIXME: stub + +%%%---------------------------------------------------------------- +check_dh_gex_groups({file,File}) when is_list(File) -> + case file:consult(File) of + {ok, GroupDefs} -> + check_dh_gex_groups(GroupDefs); + {error, Error} -> + error_in_check({file,File},Error) + end; + +check_dh_gex_groups({ssh_moduli_file,File}) when is_list(File) -> + case file:open(File,[read]) of + {ok,D} -> + try + read_moduli_file(D, 1, []) + of + {ok,Moduli} -> + check_dh_gex_groups(Moduli); + {error,Error} -> + error_in_check({ssh_moduli_file,File}, Error) + catch + _:_ -> + error_in_check({ssh_moduli_file,File}, "Bad format in file "++File) + after + file:close(D) + end; + + {error, Error} -> + error_in_check({ssh_moduli_file,File}, Error) + end; + +check_dh_gex_groups(L0) when is_list(L0), is_tuple(hd(L0)) -> + {true, + collect_per_size( + lists:foldl( + fun({N,G,P}, Acc) when is_integer(N),N>0, + is_integer(G),G>0, + is_integer(P),P>0 -> + [{N,{G,P}} | Acc]; + ({N,{G,P}}, Acc) when is_integer(N),N>0, + is_integer(G),G>0, + is_integer(P),P>0 -> + [{N,{G,P}} | Acc]; + ({N,GPs}, Acc) when is_list(GPs) -> + lists:foldr(fun({Gi,Pi}, Acci) when is_integer(Gi),Gi>0, + is_integer(Pi),Pi>0 -> + [{N,{Gi,Pi}} | Acci] + end, Acc, GPs) + end, [], L0))}; + +check_dh_gex_groups(_) -> + false. + + + +collect_per_size(L) -> + lists:foldr( + fun({Sz,GP}, [{Sz,GPs}|Acc]) -> [{Sz,[GP|GPs]}|Acc]; + ({Sz,GP}, Acc) -> [{Sz,[GP]}|Acc] + end, [], lists:sort(L)). + +read_moduli_file(D, I, Acc) -> + case io:get_line(D,"") of + {error,Error} -> + {error,Error}; + eof -> + {ok, Acc}; + "#" ++ _ -> read_moduli_file(D, I+1, Acc); + <<"#",_/binary>> -> read_moduli_file(D, I+1, Acc); + Data -> + Line = if is_binary(Data) -> binary_to_list(Data); + is_list(Data) -> Data + end, + try + [_Time,_Class,_Tests,_Tries,Size,G,P] = string:tokens(Line," \r\n"), + M = {list_to_integer(Size), + {list_to_integer(G), list_to_integer(P,16)} + }, + read_moduli_file(D, I+1, [M|Acc]) + catch + _:_ -> + read_moduli_file(D, I+1, Acc) + end + end. + +%%%---------------------------------------------------------------- +-define(SHAs, [md5, sha, sha224, sha256, sha384, sha512]). + +check_silently_accept_hosts(B) when is_boolean(B) -> true; +check_silently_accept_hosts(F) when is_function(F,2) -> true; +check_silently_accept_hosts({S,F}) when is_atom(S), + is_function(F,2) -> + lists:member(S, ?SHAs) andalso + lists:member(S, proplists:get_value(hashs,crypto:supports())); +check_silently_accept_hosts({L,F}) when is_list(L), + is_function(F,2) -> + lists:all(fun(S) -> + lists:member(S, ?SHAs) andalso + lists:member(S, proplists:get_value(hashs,crypto:supports())) + end, L); +check_silently_accept_hosts(_) -> false. + +%%%---------------------------------------------------------------- +check_preferred_algorithms(Algs) -> + try alg_duplicates(Algs, [], []) + of + [] -> + {true, + [try ssh_transport:supported_algorithms(Key) + of + DefAlgs -> handle_pref_alg(Key,Vals,DefAlgs) + catch + _:_ -> error_in_check(Key,"Bad preferred_algorithms key") + end || {Key,Vals} <- Algs] + }; + + Dups -> + error_in_check(Dups, "Duplicates") + catch + _:_ -> + false + end. + +alg_duplicates([{K,V}|KVs], Ks, Dups0) -> + Dups = + case lists:member(K,Ks) of + true -> [K|Dups0]; + false -> Dups0 + end, + case V--lists:usort(V) of + [] -> alg_duplicates(KVs, [K|Ks], Dups); + Ds -> alg_duplicates(KVs, [K|Ks], Dups++Ds) + end; +alg_duplicates([], _Ks, Dups) -> + Dups. + +handle_pref_alg(Key, + Vs=[{client2server,C2Ss=[_|_]},{server2client,S2Cs=[_|_]}], + [{client2server,Sup_C2Ss},{server2client,Sup_S2Cs}] + ) -> + chk_alg_vs(Key, C2Ss, Sup_C2Ss), + chk_alg_vs(Key, S2Cs, Sup_S2Cs), + {Key, Vs}; + +handle_pref_alg(Key, + Vs=[{server2client,[_|_]},{client2server,[_|_]}], + Sup=[{client2server,_},{server2client,_}] + ) -> + handle_pref_alg(Key, lists:reverse(Vs), Sup); + +handle_pref_alg(Key, + Vs=[V|_], + Sup=[{client2server,_},{server2client,_}] + ) when is_atom(V) -> + handle_pref_alg(Key, [{client2server,Vs},{server2client,Vs}], Sup); + +handle_pref_alg(Key, + Vs=[V|_], + Sup=[S|_] + ) when is_atom(V), is_atom(S) -> + chk_alg_vs(Key, Vs, Sup), + {Key, Vs}; + +handle_pref_alg(Key, Vs, _) -> + error_in_check({Key,Vs}, "Badly formed list"). + +chk_alg_vs(OptKey, Values, SupportedValues) -> + case (Values -- SupportedValues) of + [] -> Values; + Bad -> error_in_check({OptKey,Bad}, "Unsupported value(s) found") + end. + +%%%---------------------------------------------------------------- +forbidden_option(K,V) -> + Txt = io_lib:format("The option '~s' is used internally. The " + "user is not allowed to specify this option.", + [K]), + error({eoptions, {K,V}, Txt}). + +%%%---------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 8d994cdb43..140856c8e3 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -100,18 +100,14 @@ start_channel(Socket) when is_port(Socket) -> start_channel(Host) when is_list(Host) -> start_channel(Host, []). -start_channel(Socket, Options) when is_port(Socket) -> - Timeout = - %% A mixture of ssh:connect and ssh_sftp:start_channel: - case proplists:get_value(connect_timeout, Options, undefined) of - undefined -> - proplists:get_value(timeout, Options, infinity); - TO -> - TO - end, - case ssh:connect(Socket, Options, Timeout) of +start_channel(Socket, UserOptions) when is_port(Socket) -> + {SshOpts, _ChanOpts, SftpOpts} = handle_options(UserOptions), + Timeout = % A mixture of ssh:connect and ssh_sftp:start_channel: + proplists:get_value(connect_timeout, SshOpts, + proplists:get_value(timeout, SftpOpts, infinity)), + case ssh:connect(Socket, SshOpts, Timeout) of {ok,Cm} -> - case start_channel(Cm, Options) of + case start_channel(Cm, UserOptions) of {ok, Pid} -> {ok, Pid, Cm}; Error -> @@ -120,9 +116,9 @@ start_channel(Socket, Options) when is_port(Socket) -> Error -> Error end; -start_channel(Cm, Opts) when is_pid(Cm) -> - Timeout = proplists:get_value(timeout, Opts, infinity), - {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), +start_channel(Cm, UserOptions) when is_pid(Cm) -> + Timeout = proplists:get_value(timeout, UserOptions, infinity), + {_SshOpts, ChanOpts, SftpOpts} = handle_options(UserOptions), case ssh_xfer:attach(Cm, [], ChanOpts) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, @@ -143,15 +139,17 @@ start_channel(Cm, Opts) when is_pid(Cm) -> Error end; -start_channel(Host, Opts) -> - start_channel(Host, 22, Opts). -start_channel(Host, Port, Opts) -> - {SshOpts, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), - Timeout = proplists:get_value(timeout, SftpOpts, infinity), +start_channel(Host, UserOptions) -> + start_channel(Host, 22, UserOptions). + +start_channel(Host, Port, UserOptions) -> + {SshOpts, ChanOpts, SftpOpts} = handle_options(UserOptions), + Timeout = % A mixture of ssh:connect and ssh_sftp:start_channel: + proplists:get_value(connect_timeout, SshOpts, + proplists:get_value(timeout, SftpOpts, infinity)), case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of {ok, ChannelId, Cm} -> - case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, - ChannelId, SftpOpts]) of + case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm,ChannelId,SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> @@ -865,6 +863,9 @@ terminate(_Reason, State) -> %%==================================================================== %% Internal functions %%==================================================================== +handle_options(UserOptions) -> + handle_options(UserOptions, [], [], []). + handle_options([], Sftp, Chan, Ssh) -> {Ssh, Chan, Sftp}; handle_options([{timeout, _} = Opt | Rest], Sftp, Chan, Ssh) -> diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl index 637f5f398f..cf82db458f 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_subsystem_sup.erl @@ -26,6 +26,8 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, connection_supervisor/1, channel_supervisor/1 @@ -37,8 +39,8 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Opts) -> - supervisor:start_link(?MODULE, [Opts]). +start_link(Options) -> + supervisor:start_link(?MODULE, [Options]). connection_supervisor(SupPid) -> Children = supervisor:which_children(SupPid), @@ -53,42 +55,42 @@ channel_supervisor(SupPid) -> %%%========================================================================= -spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . -init([Opts]) -> +init([Options]) -> RestartStrategy = one_for_all, MaxR = 0, MaxT = 3600, - Children = child_specs(Opts), + Children = child_specs(Options), {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -child_specs(Opts) -> - case proplists:get_value(role, Opts) of +child_specs(Options) -> + case ?GET_INTERNAL_OPT(role, Options) of client -> []; server -> - [ssh_channel_child_spec(Opts), ssh_connectinon_child_spec(Opts)] + [ssh_channel_child_spec(Options), ssh_connectinon_child_spec(Options)] end. -ssh_connectinon_child_spec(Opts) -> - Address = proplists:get_value(address, Opts), - Port = proplists:get_value(port, Opts), - Role = proplists:get_value(role, Opts), +ssh_connectinon_child_spec(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Role = ?GET_INTERNAL_OPT(role, Options), Name = id(Role, ssh_connection_sup, Address, Port), - StartFunc = {ssh_connection_sup, start_link, [Opts]}, + StartFunc = {ssh_connection_sup, start_link, [Options]}, Restart = temporary, Shutdown = 5000, Modules = [ssh_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -ssh_channel_child_spec(Opts) -> - Address = proplists:get_value(address, Opts), - Port = proplists:get_value(port, Opts), - Role = proplists:get_value(role, Opts), +ssh_channel_child_spec(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Role = ?GET_INTERNAL_OPT(role, Options), Name = id(Role, ssh_channel_sup, Address, Port), - StartFunc = {ssh_channel_sup, start_link, [Opts]}, + StartFunc = {ssh_channel_sup, start_link, [Options]}, Restart = temporary, Shutdown = infinity, Modules = [ssh_channel_sup], diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index e97ac7b01a..b0bbd3aae5 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -45,12 +45,12 @@ %%%========================================================================= %%% Internal API %%%========================================================================= -start_link(ServerOpts) -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), +start_link(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Profile = ?GET_OPT(profile, Options), Name = make_name(Address, Port, Profile), - supervisor:start_link({local, Name}, ?MODULE, [ServerOpts]). + supervisor:start_link({local, Name}, ?MODULE, [Options]). stop_listener(SysSup) -> stop_acceptor(SysSup). @@ -127,12 +127,12 @@ restart_acceptor(Address, Port, Profile) -> %%%========================================================================= -spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . -init([ServerOpts]) -> +init([Options]) -> RestartStrategy = one_for_one, MaxR = 0, MaxT = 3600, - Children = case proplists:get_value(asocket,ServerOpts) of - undefined -> child_specs(ServerOpts); + Children = case ?GET_INTERNAL_OPT(asocket,Options,undefined) of + undefined -> child_specs(Options); _ -> [] end, {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. @@ -140,24 +140,24 @@ init([ServerOpts]) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -child_specs(ServerOpts) -> - [ssh_acceptor_child_spec(ServerOpts)]. +child_specs(Options) -> + [ssh_acceptor_child_spec(Options)]. -ssh_acceptor_child_spec(ServerOpts) -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), +ssh_acceptor_child_spec(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Profile = ?GET_OPT(profile, Options), Name = id(ssh_acceptor_sup, Address, Port, Profile), - StartFunc = {ssh_acceptor_sup, start_link, [ServerOpts]}, + StartFunc = {ssh_acceptor_sup, start_link, [Options]}, Restart = transient, Shutdown = infinity, Modules = [ssh_acceptor_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -ssh_subsystem_child_spec(ServerOpts) -> +ssh_subsystem_child_spec(Options) -> Name = make_ref(), - StartFunc = {ssh_subsystem_sup, start_link, [ServerOpts]}, + StartFunc = {ssh_subsystem_sup, start_link, [Options]}, Restart = temporary, Shutdown = infinity, Modules = [ssh_subsystem_sup], diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index a17ad560d1..02c995399a 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -153,14 +153,14 @@ supported_algorithms(compression) -> %%%---------------------------------------------------------------------------- versions(client, Options)-> - Vsn = proplists:get_value(vsn, Options, ?DEFAULT_CLIENT_VERSION), + Vsn = ?GET_INTERNAL_OPT(vsn, Options, ?DEFAULT_CLIENT_VERSION), {Vsn, format_version(Vsn, software_version(Options))}; versions(server, Options) -> - Vsn = proplists:get_value(vsn, Options, ?DEFAULT_SERVER_VERSION), + Vsn = ?GET_INTERNAL_OPT(vsn, Options, ?DEFAULT_SERVER_VERSION), {Vsn, format_version(Vsn, software_version(Options))}. software_version(Options) -> - case proplists:get_value(id_string, Options) of + case ?GET_OPT(id_string, Options) of undefined -> "Erlang"++ssh_vsn(); {random,Nlo,Nup} -> @@ -171,7 +171,7 @@ software_version(Options) -> ssh_vsn() -> try {ok,L} = application:get_all_key(ssh), - proplists:get_value(vsn,L,"") + proplists:get_value(vsn, L, "") of "" -> ""; VSN when is_list(VSN) -> "/" ++ VSN; @@ -232,13 +232,7 @@ key_exchange_init_msg(Ssh0) -> kex_init(#ssh{role = Role, opts = Opts, available_host_keys = HostKeyAlgs}) -> Random = ssh_bits:random(16), - PrefAlgs = - case proplists:get_value(preferred_algorithms,Opts) of - undefined -> - default_algorithms(); - Algs0 -> - Algs0 - end, + PrefAlgs = ?GET_OPT(preferred_algorithms, Opts), kexinit_message(Role, Random, PrefAlgs, HostKeyAlgs). key_init(client, Ssh, Value) -> @@ -341,10 +335,7 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ; key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ; Kex == 'diffie-hellman-group-exchange-sha256' -> - {Min,NBits0,Max} = - proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN, - ?DEFAULT_DH_GROUP_NBITS, - ?DEFAULT_DH_GROUP_MAX}), + {Min,NBits0,Max} = ?GET_OPT(dh_gex_limits, Opts), DhBits = dh_bits(Ssh0#ssh.algorithms), NBits1 = %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management @@ -458,7 +449,7 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, %% server {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, - proplists:get_value(dh_gex_groups,Opts)) of + ?GET_OPT(dh_gex_groups,Opts)) of {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), @@ -492,7 +483,7 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, Max0 = 8192, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, - proplists:get_value(dh_gex_groups,Opts)) of + ?GET_OPT(dh_gex_groups,Opts)) of {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), @@ -517,22 +508,18 @@ handle_kex_dh_gex_request(_, _) -> adjust_gex_min_max(Min0, Max0, Opts) -> - case proplists:get_value(dh_gex_limits, Opts) of - undefined -> - {Min0, Max0}; - {Min1, Max1} -> - Min2 = max(Min0, Min1), - Max2 = min(Max0, Max1), - if - Min2 =< Max2 -> - {Min2, Max2}; - Max2 < Min2 -> - ssh_connection_handler:disconnect( - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group possible" - }) - end + {Min1, Max1} = ?GET_OPT(dh_gex_limits, Opts), + Min2 = max(Min0, Min1), + Max2 = min(Max0, Max1), + if + Min2 =< Max2 -> + {Min2, Max2}; + Max2 < Min2 -> + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group possible" + }) end. @@ -719,9 +706,9 @@ sid(#ssh{session_id = Id}, _) -> %% The host key should be read from storage %% get_host_key(SSH) -> - #ssh{key_cb = Mod, opts = Opts, algorithms = ALG} = SSH, - - case Mod:host_key(ALG#alg.hkey, Opts) of + #ssh{key_cb = {KeyCb,KeyCbOpts}, opts = Opts, algorithms = ALG} = SSH, + UserOpts = ?GET_OPT(user_options, Opts), + case KeyCb:host_key(ALG#alg.hkey, [{key_cb_private,KeyCbOpts}|UserOpts]) of {ok, #'RSAPrivateKey'{} = Key} -> Key; {ok, #'DSAPrivateKey'{} = Key} -> Key; {ok, #'ECPrivateKey'{} = Key} -> Key; @@ -767,7 +754,7 @@ public_algo({#'ECPoint'{},{namedCurve,OID}}) -> accepted_host(Ssh, PeerName, Public, Opts) -> - case proplists:get_value(silently_accept_hosts, Opts, false) of + case ?GET_OPT(silently_accept_hosts, Opts) of F when is_function(F,2) -> true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(Public))); {DigestAlg,F} when is_function(F,2) -> @@ -778,15 +765,16 @@ accepted_host(Ssh, PeerName, Public, Opts) -> yes == yes_no(Ssh, "New host " ++ PeerName ++ " accept") end. -known_host_key(#ssh{opts = Opts, key_cb = Mod, peer = {PeerName,_}} = Ssh, +known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_}} = Ssh, Public, Alg) -> - case Mod:is_host_key(Public, PeerName, Alg, Opts) of + UserOpts = ?GET_OPT(user_options, Opts), + case KeyCb:is_host_key(Public, PeerName, Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of true -> ok; false -> case accepted_host(Ssh, PeerName, Public, Opts) of true -> - Mod:add_host_key(PeerName, Public, Opts); + KeyCb:add_host_key(PeerName, Public, [{key_cb_private,KeyCbOpts}|UserOpts]); false -> {error, rejected} end @@ -1822,10 +1810,6 @@ len_supported(Name, Len) -> same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. - -%% default_algorithms(kex) -> % Example of how to disable an algorithm -%% supported_algorithms(kex, ['ecdh-sha2-nistp521']); - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Other utils diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index 04d2df30f7..14f1937abd 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -41,13 +41,13 @@ start_link(Servers) -> supervisor:start_link({local, ?MODULE}, ?MODULE, [Servers]). -start_child(ServerOpts) -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), +start_child(Options) -> + Address = ?GET_INTERNAL_OPT(address, Options), + Port = ?GET_INTERNAL_OPT(port, Options), + Profile = ?GET_OPT(profile, Options), case ssh_system_sup:system_supervisor(Address, Port, Profile) of undefined -> - Spec = child_spec(Address, Port, ServerOpts), + Spec = child_spec(Address, Port, Options), case supervisor:start_child(?MODULE, Spec) of {error, already_present} -> Name = id(Address, Port, Profile), @@ -58,7 +58,7 @@ start_child(ServerOpts) -> end; Pid -> AccPid = ssh_system_sup:acceptor_supervisor(Pid), - ssh_acceptor_sup:start_child(AccPid, ServerOpts) + ssh_acceptor_sup:start_child(AccPid, Options) end. stop_child(Name) -> @@ -82,8 +82,8 @@ init([Servers]) -> MaxR = 10, MaxT = 3600, Fun = fun(ServerOpts) -> - Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), + Address = ?GET_INTERNAL_OPT(address, ServerOpts), + Port = ?GET_INTERNAL_OPT(port, ServerOpts), child_spec(Address, Port, ServerOpts) end, Children = lists:map(Fun, Servers), @@ -92,10 +92,10 @@ init([Servers]) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -child_spec(Address, Port, ServerOpts) -> - Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), +child_spec(Address, Port, Options) -> + Profile = ?GET_OPT(profile, Options), Name = id(Address, Port,Profile), - StartFunc = {ssh_system_sup, start_link, [ServerOpts]}, + StartFunc = {ssh_system_sup, start_link, [Options]}, Restart = temporary, Shutdown = infinity, Modules = [ssh_system_sup], diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 313b7fc559..6f75d83c4a 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -200,6 +200,9 @@ try_exec_simple_group(Group, Config) -> %%-------------------------------------------------------------------- %% Testing all default groups +simple_exec_groups() -> + [{timetrap,{seconds,120}}]. + simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), lists:foreach( diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 85750f8fbd..fc90750455 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -139,7 +139,6 @@ openssh_client_shell(Config, Options) -> {ok, TracerPid} = erlang_trace(), {ServerPid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, ssh_dsa}, {failfun, fun ssh_test_lib:failfun/2} | Options]), ct:sleep(500), @@ -215,7 +214,6 @@ openssh_client_sftp(Config, Options) -> {ok, TracerPid} = erlang_trace(), {ServerPid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, ssh_dsa}, {subsystems,[ssh_sftpd:subsystem_spec([%{cwd, SftpSrcDir}, {root, SftpSrcDir}])]}, {failfun, fun ssh_test_lib:failfun/2} diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 6d18a980ee..b167f98ac8 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -158,8 +158,7 @@ init_per_testcase(TestCase, Config) -> [{user_dir, ClientUserDir}, {user, ?USER}, {password, ?PASSWD}, {user_interaction, false}, - {silently_accept_hosts, true}, - {pwdfun, fun(_,_) -> true end}]), + {silently_accept_hosts, true}]), {ok, Channel} = ssh_connection:session_channel(Cm, ?XFER_WINDOW_SIZE, ?XFER_PACKET_SIZE, ?TIMEOUT), diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index fd5157d603..b4d7eadfa4 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -189,7 +189,6 @@ quit(Config) when is_list(Config) -> timer:sleep(5000), {ok, NewSftp, _Conn} = ssh_sftp:start_channel(Host, Port, [{silently_accept_hosts, true}, - {pwdfun, fun(_,_) -> true end}, {user_dir, UserDir}, {user, ?USER}, {password, ?PASSWD}]), diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 4d5e5be2a1..687e6efaf3 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -381,7 +381,6 @@ erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -402,7 +401,6 @@ erlang_server_openssh_client_renegotiate(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -464,6 +462,7 @@ erlang_client_openssh_server_renegotiate(_Config) -> {silently_accept_hosts,true}], group_leader(IO, self()), {ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options), + ct:pal("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]), case ssh_connection:session_channel(ConnRef, infinity) of {ok,ChannelId} -> success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []), diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 0fa0f0c0e4..261239c152 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -85,18 +85,18 @@ exec(Op, S0=#s{}) -> throw:Term -> report_trace(throw, Term, S1), - throw(Term); + throw({Term,Op}); error:Error -> report_trace(error, Error, S1), - error(Error); + error({Error,Op}); exit:Exit -> report_trace(exit, Exit, S1), - exit(Exit); + exit({Exit,Op}); Cls:Err -> ct:pal("Class=~p, Error=~p", [Cls,Err]), - error("fooooooO") + error({"fooooooO",Op}) end; exec(Op, {ok,S=#s{}}) -> exec(Op, S); exec(_, Error) -> Error. @@ -114,20 +114,20 @@ op({accept,Opts}, S) when ?role(S) == server -> {ok,Socket} = gen_tcp:accept(S#s.listen_socket, S#s.timeout), {Host,_Port} = ok(inet:sockname(Socket)), S#s{socket = Socket, - ssh = init_ssh(server,Socket,[{host,host(Host)}|Opts]), + ssh = init_ssh(server, Socket, host(Host), Opts), return_value = ok}; %%%---- Client ops op({connect,Host,Port,Opts}, S) when ?role(S) == undefined -> Socket = ok(gen_tcp:connect(host(Host), Port, mangle_opts([]))), S#s{socket = Socket, - ssh = init_ssh(client, Socket, [{host,host(Host)}|Opts]), + ssh = init_ssh(client, Socket, host(Host), Opts), return_value = ok}; %%%---- ops for both client and server op(close_socket, S) -> - catch tcp_gen:close(S#s.socket), - catch tcp_gen:close(S#s.listen_socket), + catch gen_tcp:close(S#s.socket), + catch gen_tcp:close(S#s.listen_socket), S#s{socket = undefined, listen_socket = undefined, return_value = ok}; @@ -296,12 +296,14 @@ instantiate(X, _S) -> %%%================================================================ %%% -init_ssh(Role, Socket, Options0) -> - Options = [{user_interaction, false}, - {vsn, {2,0}}, - {id_string, "ErlangTestLib"} - | Options0], - ssh_connection_handler:init_ssh_record(Role, Socket, Options). +init_ssh(Role, Socket, Host, UserOptions0) -> + UserOptions = [{user_interaction, false}, + {vsn, {2,0}}, + {id_string, "ErlangTestLib"} + | UserOptions0], + Opts = ?PUT_INTERNAL_OPT({host,Host}, + ssh_options:handle_options(Role, UserOptions)), + ssh_connection_handler:init_ssh_record(Role, Socket, Opts). mangle_opts(Options) -> SysOpts = [{reuseaddr, true}, diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 070a90d481..f607c86ae3 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -39,7 +39,7 @@ -export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_event/3]). +-export([next_record/1, next_event/3, next_event/4]). %% Handshake handling -export([renegotiate/2, @@ -53,7 +53,7 @@ %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, - send/3]). + send/3, socket/5]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -77,20 +77,6 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} catch error:{badmatch, {error, _} = Error} -> Error - end; - -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, - Timeout) -> - try - {ok, Pid} = dtls_connection_sup:start_child_dist([Role, Host, Port, Socket, - Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), - ok = ssl_connection:handshake(SslSocket, Timeout), - {ok, SslSocket} - catch - error:{badmatch, {error, _} = Error} -> - Error end. send_handshake(Handshake, #state{connection_states = ConnectionStates} = States) -> @@ -201,6 +187,7 @@ reinit_handshake_data(#state{protocol_buffers = Buffers} = State) -> State#state{premaster_secret = undefined, public_key_info = undefined, tls_handshake_history = ssl_handshake:init_handshake_history(), + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, protocol_buffers = Buffers#protocol_buffers{ dtls_handshake_next_seq = 0, @@ -213,6 +200,9 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) -> select_sni_extension(_) -> undefined. +socket(Pid, Transport, Socket, Connection, _) -> + dtls_socket:socket(Pid, Transport, Socket, Connection). + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -243,7 +233,7 @@ callback_mode() -> state_functions. %%-------------------------------------------------------------------- -%% State functionsconnection/2 +%% State functions %%-------------------------------------------------------------------- init({call, From}, {start, Timeout}, @@ -262,17 +252,19 @@ init({call, From}, {start, Timeout}, Version = Hello#client_hello.client_version, HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), State1 = prepare_flight(State0#state{negotiated_version = Version}), - State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, start_or_recv_from = From, - timer = Timer}, + timer = Timer, + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} + }, {Record, State} = next_record(State3), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) -> ssl_connection:init(Type, Event, - State#state{flight_state = {waiting, undefined, ?INITIAL_RETRANSMIT_TIMEOUT}}, + State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}}, ?MODULE); init({call, _} = Type, Event, #state{role = server} = State) -> %% I.E. DTLS over sctp @@ -302,9 +294,9 @@ hello(internal, #client_hello{cookie = <<>>, Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello), VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version), State1 = prepare_flight(State0#state{negotiated_version = Version}), - State2 = send_handshake(VerifyRequest, State1), + {State2, Actions} = send_handshake(VerifyRequest, State1), {Record, State} = next_record(State2), - next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}); + next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions); hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, transport_cb = Transport, socket = Socket} = State0) -> @@ -333,13 +325,13 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, Cache, CacheCb, Renegotiation, OwnCert), Version = Hello#client_hello.client_version, HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), - State2 = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), + {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}), State3 = State2#state{negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}}, {Record, State} = next_record(State3), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, @@ -356,13 +348,13 @@ hello(internal, #server_hello{} = Hello, hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, State) -> %% Initial hello should not be in handshake history {next_state, hello, State, [{next_event, internal, Handshake}]}; - hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) -> %% hello_verify should not be in handshake history {next_state, hello, State, [{next_event, internal, Handshake}]}; - hello(info, Event, State) -> handle_info(Event, hello, State); +hello(state_timeout, Event, State) -> + handle_state_timeout(Event, hello, State); hello(Type, Event, State) -> ssl_connection:hello(Type, Event, State, ?MODULE). @@ -375,7 +367,11 @@ abbreviated(internal = Type, ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read), ssl_connection:abbreviated(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> - ssl_connection:cipher(Type, Event, prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); + ssl_connection:abbreviated(Type, Event, + prepare_flight(State#state{connection_states = ConnectionStates, + flight_state = connection}), ?MODULE); +abbreviated(state_timeout, Event, State) -> + handle_state_timeout(Event, abbreviated, State); abbreviated(Type, Event, State) -> ssl_connection:abbreviated(Type, Event, State, ?MODULE). @@ -383,6 +379,8 @@ certify(info, Event, State) -> handle_info(Event, certify, State); certify(internal = Type, #server_hello_done{} = Event, State) -> ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE); +certify(state_timeout, Event, State) -> + handle_state_timeout(Event, certify, State); certify(Type, Event, State) -> ssl_connection:certify(Type, Event, State, ?MODULE). @@ -395,7 +393,11 @@ cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event, ssl_connection:cipher(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE); cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) -> ssl_connection:cipher(Type, Event, - prepare_flight(State#state{connection_states = ConnectionStates}), ?MODULE); + prepare_flight(State#state{connection_states = ConnectionStates, + flight_state = connection}), + ?MODULE); +cipher(state_timeout, Event, State) -> + handle_state_timeout(Event, cipher, State); cipher(Type, Event, State) -> ssl_connection:cipher(Type, Event, State, ?MODULE). @@ -409,12 +411,12 @@ connection(internal, #hello_request{}, #state{host = Host, port = Port, renegotiation = {Renegotiation, _}} = State0) -> Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), - State1 = send_handshake(Hello, State0), + {State1, Actions} = send_handshake(Hello, State0), {Record, State} = next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html @@ -434,7 +436,6 @@ connection(Type, Event, State) -> downgrade(Type, Event, State) -> ssl_connection:downgrade(Type, Event, State, ?MODULE). - %%-------------------------------------------------------------------- %% Description: This function is called by a gen_fsm when it receives any %% other message than a synchronous or asynchronous event @@ -442,16 +443,6 @@ downgrade(Type, Event, State) -> %%-------------------------------------------------------------------- %% raw data from socket, unpack records -handle_info({_,flight_retransmission_timeout}, connection, _) -> - {next_state, keep_state_and_data}; -handle_info({Ref, flight_retransmission_timeout}, StateName, - #state{flight_state = {waiting, Ref, NextTimeout}} = State0) -> - State1 = send_handshake_flight(State0#state{flight_state = {retransmit_timer, NextTimeout}}, - retransmit_epoch(StateName, State0)), - {Record, State} = next_record(State1), - next_event(StateName, Record, State); -handle_info({_, flight_retransmission_timeout}, _, _) -> - {next_state, keep_state_and_data}; handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> case next_dtls_record(Data, State0) of @@ -489,7 +480,6 @@ handle_call(Event, From, StateName, State) -> handle_common_event(internal, #alert{} = Alert, StateName, #state{negotiated_version = Version} = State) -> ssl_connection:handle_own_alert(Alert, Version, StateName, State); - %%% DTLS record protocol level handshake messages handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, @@ -498,19 +488,14 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, negotiated_version = Version} = State0) -> try case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of - {more_data, Buffers} -> + {[], Buffers} -> {Record, State} = next_record(State0#state{protocol_buffers = Buffers}), next_event(StateName, Record, State); {Packets, Buffers} -> State = State0#state{protocol_buffers = Buffers}, Events = dtls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, - State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + {next_state, StateName, + State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} end catch throw:#alert{} = Alert -> ssl_connection:handle_own_alert(Alert, Version, StateName, State0) @@ -534,6 +519,13 @@ handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, Sta handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> {next_state, StateName, State}. +handle_state_timeout(flight_retransmission_timeout, StateName, + #state{flight_state = {retransmit, NextTimeout}} = State0) -> + {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}}, + retransmit_epoch(StateName, State0)), + {Record, State} = next_record(State1), + next_event(StateName, Record, State, Actions). + send(Transport, {_, {{_,_}, _} = Socket}, Data) -> send(Transport, Socket, Data); send(Transport, Socket, Data) -> @@ -645,7 +637,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, protocol_cb = ?MODULE, - flight_buffer = new_flight() + flight_buffer = new_flight(), + flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} }. next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ @@ -714,14 +707,14 @@ next_event(connection = StateName, no_record, #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> case next_record_if_active(State0) of {no_record, State} -> - ssl_connection:hibernate_after(StateName, State, Actions); + ssl_connection:hibernate_after(StateName, State, Actions); {#ssl_tls{epoch = CurrentEpoch} = Record, State} -> {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]}; {#ssl_tls{epoch = Epoch, type = ?HANDSHAKE, version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 -> - State = send_handshake_flight(State1, Epoch), - {next_state, StateName, State, Actions}; + {State, MoreActions} = send_handshake_flight(State1, Epoch), + {next_state, StateName, State, Actions ++ MoreActions}; {#ssl_tls{epoch = _Epoch, version = _Version}, State} -> %% TODO maybe buffer later epoch @@ -772,17 +765,20 @@ next_flight(Flight) -> Flight#{handshakes => [], change_cipher_spec => undefined, handshakes_after_change_cipher_spec => []}. - start_flight(#state{transport_cb = gen_udp, - flight_state = {retransmit_timer, Timeout}} = State) -> - Ref = erlang:make_ref(), - _ = erlang:send_after(Timeout, self(), {Ref, flight_retransmission_timeout}), - State#state{flight_state = {waiting, Ref, new_timeout(Timeout)}}; - + flight_state = {retransmit, Timeout}} = State) -> + start_retransmision_timer(Timeout, State); +start_flight(#state{transport_cb = gen_udp, + flight_state = connection} = State) -> + {State, []}; start_flight(State) -> %% No retransmision needed i.e DTLS over SCTP - State#state{flight_state = reliable}. + {State#state{flight_state = reliable}, []}. + +start_retransmision_timer(Timeout, State) -> + {State#state{flight_state = {retransmit, new_timeout(Timeout)}}, + [{state_timeout, Timeout, flight_retransmission_timeout}]}. new_timeout(N) when N =< 30 -> N * 2; @@ -806,13 +802,13 @@ renegotiate(#state{role = server, connection_states = CS0} = State0, Actions) -> HelloRequest = ssl_handshake:hello_request(), CS = CS0#{write_msg_seq => 0}, - State1 = send_handshake(HelloRequest, - State0#state{connection_states = - CS}), + {State1, MoreActions} = send_handshake(HelloRequest, + State0#state{connection_states = + CS}), Hs0 = ssl_handshake:init_handshake_history(), {Record, State} = next_record(State1#state{tls_handshake_history = Hs0, protocol_buffers = #protocol_buffers{}}), - next_event(hello, Record, State, Actions). + next_event(hello, Record, State, Actions ++ MoreActions). handle_alerts([], Result) -> Result; @@ -823,15 +819,11 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)). -retransmit_epoch(StateName, #state{connection_states = ConnectionStates}) -> +retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) -> #{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write), - case StateName of - connection -> - Epoch-1; - _ -> - Epoch - end. + Epoch. + update_handshake_history(#hello_verify_request{}, _, Hist) -> Hist; @@ -846,3 +838,4 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index af3708ddb7..fd1f9698fe 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -136,9 +136,11 @@ handshake_bin([Type, Length, Data], Seq) -> %%-------------------------------------------------------------------- -spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) -> - {[{dtls_handshake(), binary()}], #protocol_buffers{}} | {more_data, #protocol_buffers{}}. + {[dtls_handshake()], #protocol_buffers{}}. %% -%% Description: ... +%% Description: Given buffered and new data from dtls_record, collects +%% and returns it as a list of handshake messages, also returns +%% possible leftover data in the new "protocol_buffers". %%-------------------------------------------------------------------- get_dtls_handshake(Version, Fragment, ProtocolBuffers) -> handle_fragments(Version, Fragment, ProtocolBuffers, []). @@ -288,8 +290,6 @@ do_handle_fragments(_, [], Buffers, Acc) -> {lists:reverse(Acc), Buffers}; do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) -> case reassemble(Version, Fragment, Buffers0) of - {more_data, _} = More when Acc == []-> - More; {more_data, Buffers} when Fragments == [] -> {lists:reverse(Acc), Buffers}; {more_data, Buffers} -> diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index 570b3ae83a..ac1a7b37c6 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -71,11 +71,14 @@ connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo, close(gen_udp, {_Client, _Socket}) -> ok. +socket(Pid, gen_udp = Transport, {{_, _}, Socket}, ConnectionCb) -> + #sslsocket{pid = Pid, + %% "The name "fd" is keept for backwards compatibility + fd = {Transport, Socket, ConnectionCb}}; socket(Pid, Transport, Socket, ConnectionCb) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility - fd = {Transport, Socket, ConnectionCb}}. - + fd = {Transport, Socket, ConnectionCb}}. %% Vad göra med emulerade setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) -> {SockOpts, _} = tls_socket:split_options(Options), @@ -108,11 +111,15 @@ getstat(gen_udp, {_,Socket}, Options) -> inet:getstat(Socket, Options); getstat(Transport, Socket, Options) -> Transport:getstat(Socket, Options). +peername(udp, _) -> + {error, enotconn}; peername(gen_udp, {_, {Client, _Socket}}) -> {ok, Client}; peername(Transport, Socket) -> Transport:peername(Socket). -sockname(gen_udp, {_,Socket}) -> +sockname(gen_udp, {_, {_,Socket}}) -> + inet:sockname(Socket); +sockname(gen_udp, Socket) -> inet:sockname(Socket); sockname(Transport, Socket) -> Transport:sockname(Socket). diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl index b7f115582e..ab3d0783bd 100644 --- a/lib/ssl/src/dtls_udp_listener.erl +++ b/lib/ssl/src/dtls_udp_listener.erl @@ -24,7 +24,8 @@ -behaviour(gen_server). %% API --export([start_link/4, active_once/3, accept/2, sockname/1]). +-export([start_link/4, active_once/3, accept/2, sockname/1, close/1, + get_all_opts/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -39,7 +40,8 @@ clients = set_new(), dtls_processes = kv_new(), accepters = queue:new(), - first + first, + close }). %%%=================================================================== @@ -53,10 +55,14 @@ active_once(UDPConnection, Client, Pid) -> gen_server:cast(UDPConnection, {active_once, Client, Pid}). accept(UDPConnection, Accepter) -> - gen_server:call(UDPConnection, {accept, Accepter}, infinity). + call(UDPConnection, {accept, Accepter}). sockname(UDPConnection) -> - gen_server:call(UDPConnection, sockname, infinity). + call(UDPConnection, sockname). +close(UDPConnection) -> + call(UDPConnection, close). +get_all_opts(UDPConnection) -> + call(UDPConnection, get_all_opts). %%%=================================================================== %%% gen_server callbacks @@ -69,10 +75,13 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) -> first = true, dtls_options = DTLSOptions, emulated_options = EmOpts, - listner = Socket}} + listner = Socket, + close = false}} catch _:_ -> {error, closed} end. +handle_call({accept, _}, _, #state{close = true} = State) -> + {reply, {error, closed}, State}; handle_call({accept, Accepter}, From, #state{first = true, accepters = Accepters, @@ -87,7 +96,21 @@ handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) -> {noreply, State}; handle_call(sockname, _, #state{listner = Socket} = State) -> Reply = inet:sockname(Socket), - {reply, Reply, State}. + {reply, Reply, State}; +handle_call(close, _, #state{dtls_processes = Processes, + accepters = Accepters} = State) -> + case kv_empty(Processes) of + true -> + {stop, normal, ok, State#state{close=true}}; + false -> + lists:foreach(fun({_, From}) -> + gen_server:reply(From, {error, closed}) + end, queue:to_list(Accepters)), + {reply, ok, State#state{close = true, accepters = queue:new()}} + end; +handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions, + emulated_options = EmOpts} = State) -> + {reply, {ok, EmOpts, DTLSOptions}, State}. handle_cast({active_once, Client, Pid}, State0) -> State = handle_active_once(Client, Pid, State0), @@ -99,11 +122,17 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta {noreply, State}; handle_info({'DOWN', _, process, Pid, _}, #state{clients = Clients, - dtls_processes = Processes0} = State) -> + dtls_processes = Processes0, + close = ListenClosed} = State) -> Client = kv_get(Pid, Processes0), Processes = kv_delete(Pid, Processes0), - {noreply, State#state{clients = set_delete(Client, Clients), - dtls_processes = Processes}}. + case ListenClosed andalso kv_empty(Processes) of + true -> + {stop, normal, State}; + false -> + {noreply, State#state{clients = set_delete(Client, Clients), + dtls_processes = Processes}} + end. terminate(_Reason, _State) -> ok. @@ -182,6 +211,7 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes, gen_server:reply(From, {error, Reason}), State end. + kv_update(Key, Value, Store) -> gb_trees:update(Key, Value, Store). kv_lookup(Key, Store) -> @@ -194,6 +224,8 @@ kv_delete(Key, Store) -> gb_trees:delete(Key, Store). kv_new() -> gb_trees:empty(). +kv_empty(Store) -> + gb_trees:is_empty(Store). set_new() -> gb_sets:empty(). @@ -203,3 +235,15 @@ set_delete(Item, Set) -> gb_sets:delete(Item, Set). set_is_member(Item, Set) -> gb_sets:is_member(Item, Set). + +call(Server, Msg) -> + try + gen_server:call(Server, Msg, infinity) + catch + exit:{noproc, _} -> + {error, closed}; + exit:{normal, _} -> + {error, closed}; + exit:{{shutdown, _},_} -> + {error, closed} + end. diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index ffd3e4b833..dd0d35d404 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -21,12 +21,21 @@ -include("ssl_cipher.hrl"). --export([suites/1, mac_hash/7, ecc_curves/1, corresponding_tls_version/1, corresponding_dtls_version/1]). +-export([suites/1, all_suites/1, mac_hash/7, ecc_curves/1, + corresponding_tls_version/1, corresponding_dtls_version/1]). -spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. suites(Minor) -> - tls_v1:suites(corresponding_minor_tls_version(Minor)). + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + tls_v1:suites(corresponding_minor_tls_version(Minor))). +all_suites(Version) -> + lists:filter(fun(Cipher) -> + is_acceptable_cipher(ssl_cipher:suite_definition(Cipher)) + end, + ssl_cipher:all_suites(corresponding_tls_version(Version))). mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, @@ -50,3 +59,5 @@ corresponding_minor_dtls_version(2) -> 255; corresponding_minor_dtls_version(3) -> 253. +is_acceptable_cipher(Suite) -> + not ssl_cipher:is_stream_ciphersuite(Suite). diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 148989174d..064dcd6892 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -63,7 +63,7 @@ {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-3.1","public_key-1.2","kernel-3.0", + {runtime_dependencies, ["stdlib-3.2","public_key-1.2","kernel-3.0", "erts-7.0","crypto-3.3", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 32252386b4..bfdd0c205b 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,11 +1,19 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]}, - {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]} + {<<"8\\..*">>, [{restart_application, ssl}]}, + {<<"7\\..*">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]}, - {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]} - ] + {<<"8\\..*">>, [{restart_application, ssl}]}, + {<<"7\\..*">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, + {<<"4\\..*">>, [{restart_application, ssl}]}, + {<<"3\\..*">>, [{restart_application, ssl}]} + ] }. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 4a5a7e25ea..ed04c7e67b 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -187,16 +187,24 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_accept(Socket, Timeout); -ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try - {ok, EmOpts, InheritedSslOpts} = tls_socket:get_all_opts(Tracker), - SslOpts = handle_options(SslOpts0, InheritedSslOpts), + {ok, EmOpts, _} = tls_socket:get_all_opts(Tracker), ssl_connection:handshake(Socket, {SslOpts, tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; +ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> + try + {ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid), + ssl_connection:handshake(Socket, {SslOpts, + tls_socket:emulated_socket_options(EmOpts, #socket_options{})}, Timeout) + catch + Error = {error, _Reason} -> Error + end; ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = @@ -215,7 +223,6 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), catch Error = {error, _Reason} -> Error end. - %%-------------------------------------------------------------------- -spec close(#sslsocket{}) -> term(). %% @@ -223,6 +230,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), %%-------------------------------------------------------------------- close(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT}); +close(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) -> + dtls_udp_listener:close(Pid); close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) -> Transport:close(ListenSocket). @@ -251,6 +260,8 @@ send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); send(#sslsocket{pid = {_, #config{transport_info={gen_udp, _, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour +send(#sslsocket{pid = {udp,_}}, _) -> + {error,enotconn}; send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) -> Transport:send(ListenSocket, Data). %% {error,enotconn} @@ -265,6 +276,8 @@ recv(Socket, Length) -> recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); +recv(#sslsocket{pid = {udp,_}}, _, _) -> + {error,enotconn}; recv(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> Transport:recv(Listen, 0). %% {error,enotconn} @@ -277,10 +290,14 @@ recv(#sslsocket{pid = {Listen, %%-------------------------------------------------------------------- controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> ssl_connection:new_user(Pid, NewOwner); +controlling_process(#sslsocket{pid = {udp, _}}, + NewOwner) when is_pid(NewOwner) -> + ok; %% Meaningless but let it be allowed to conform with TLS controlling_process(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, NewOwner) when is_port(Listen), is_pid(NewOwner) -> + %% Meaningless but let it be allowed to conform with normal sockets Transport:controlling_process(Listen, NewOwner). @@ -297,7 +314,9 @@ connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) -> Error end; connection_information(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - {error, enotconn}. + {error, enotconn}; +connection_information(#sslsocket{pid = {udp,_}}) -> + {error,enotconn}. %%-------------------------------------------------------------------- -spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. @@ -333,10 +352,18 @@ connection_info(#sslsocket{} = SSLSocket) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)-> + dtls_socket:peername(Transport, Socket); peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> tls_socket:peername(Transport, Socket); +peername(#sslsocket{pid = {udp = Transport, #config{udp_handler = {_Pid, _}}}}) -> + dtls_socket:peername(Transport, undefined); +peername(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) -> + dtls_socket:peername(Transport, Socket); peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> - tls_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} + tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn} +peername(#sslsocket{pid = {udp,_}}) -> + {error,enotconn}. %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. @@ -350,6 +377,8 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> Result -> Result end; +peercert(#sslsocket{pid = {udp, _}}) -> + {error, enotconn}; peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. @@ -506,6 +535,8 @@ getstat(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}, Options) when is_ shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}, How) when is_port(Listen) -> Transport:shutdown(Listen, How); +shutdown(#sslsocket{pid = {udp,_}},_) -> + {error, enotconn}; shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). @@ -518,7 +549,7 @@ sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _ tls_socket:sockname(Transport, Listen); sockname(#sslsocket{pid = {udp, #config{udp_handler = {Pid, _}}}}) -> dtls_udp_listener:sockname(Pid); -sockname(#sslsocket{pid = Pid, fd = {gen_udp= Transport, Socket, _, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) -> dtls_socket:sockname(Transport, Socket); sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> tls_socket:sockname(Transport, Socket). @@ -531,6 +562,8 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) %%-------------------------------------------------------------------- session_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:session_info(Pid); +session_info(#sslsocket{pid = {udp,_}}) -> + {error, enotconn}; session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. @@ -555,6 +588,8 @@ versions() -> %%-------------------------------------------------------------------- renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:renegotiation(Pid); +renegotiate(#sslsocket{pid = {udp,_}}) -> + {error, enotconn}; renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. @@ -568,6 +603,8 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> prf(#sslsocket{pid = Pid}, Secret, Label, Seed, WantedLength) when is_pid(Pid) -> ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength); +prf(#sslsocket{pid = {udp,_}}, _,_,_,_) -> + {error, enotconn}; prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> {error, enotconn}. @@ -696,7 +733,7 @@ handle_options(Opts0, Role) -> [RecordCb:protocol_version(Vsn) || Vsn <- Vsns] end, - Protocol = proplists:get_value(protocol, Opts, tls), + Protocol = handle_option(protocol, Opts, tls), SSLOptions = #ssl_options{ versions = Versions, @@ -755,7 +792,7 @@ handle_options(Opts0, Role) -> honor_ecc_order = handle_option(honor_ecc_order, Opts, default_option_role(server, false, Role), server, Role), - protocol = Protocol, + protocol = Protocol, padding_check = proplists:get_value(padding_check, Opts, true), beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one), fallback = handle_option(fallback, Opts, @@ -1032,6 +1069,10 @@ validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> Value; validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 -> Value; +validate_option(protocol, Value = tls) -> + Value; +validate_option(protocol, Value = dtls) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). @@ -1069,17 +1110,37 @@ validate_binary_list(Opt, List) -> (Bin) -> throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) end, List). - validate_versions([], Versions) -> Versions; validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; Version == 'tlsv1.1'; Version == tlsv1; Version == sslv3 -> - validate_versions(Rest, Versions); + tls_validate_versions(Rest, Versions); +validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; + Version == 'dtlsv2'-> + dtls_validate_versions(Rest, Versions); validate_versions([Ver| _], Versions) -> throw({error, {options, {Ver, {versions, Versions}}}}). +tls_validate_versions([], Versions) -> + Versions; +tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + tls_validate_versions(Rest, Versions); +tls_validate_versions([Ver| _], Versions) -> + throw({error, {options, {Ver, {versions, Versions}}}}). + +dtls_validate_versions([], Versions) -> + Versions; +dtls_validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; + Version == 'dtlsv2'-> + dtls_validate_versions(Rest, Versions); +dtls_validate_versions([Ver| _], Versions) -> + throw({error, {options, {Ver, {versions, Versions}}}}). + validate_inet_option(mode, Value) when Value =/= list, Value =/= binary -> throw({error, {options, {mode,Value}}}); @@ -1151,18 +1212,18 @@ handle_cipher_option(Value, Version) when is_list(Value) -> binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(Version)); + ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - All = ssl_cipher:all_suites(Version), + All = ssl_cipher:all_suites(tls_version(Version)), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> %% Defaults to all supported suites that does %% not require explicit configuration - ssl_cipher:filter_suites(ssl_cipher:suites(Version)); + ssl_cipher:filter_suites(ssl_cipher:suites(tls_version(Version))); Ciphers -> Ciphers end; @@ -1175,7 +1236,8 @@ binary_cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). -handle_eccs_option(Value, {_Major, Minor}) when is_list(Value) -> +handle_eccs_option(Value, Version) when is_list(Value) -> + {_Major, Minor} = tls_version(Version), try tls_v1:ecc_curves(Minor, Value) of Curves -> #elliptic_curves{elliptic_curve_list = Curves} catch @@ -1348,7 +1410,10 @@ new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordC handle_hashsigns_option(Value, tls_version(RecordCB:highest_protocol_version()))}, RecordCB); - +new_ssl_options([{protocol, dtls = Value} | Rest], #ssl_options{} = Opts, dtls_record = RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB); +new_ssl_options([{protocol, tls = Value} | Rest], #ssl_options{} = Opts, tls_record = RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{protocol = Value}, RecordCB); new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> throw({error, {options, {Key, Value}}}). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 32fec03b8e..8e6860e9dc 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -40,7 +40,8 @@ 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, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, - random_bytes/1, calc_aad/3, calc_mac_hash/4]). + random_bytes/1, calc_aad/3, calc_mac_hash/4, + is_stream_ciphersuite/1]). -export_type([cipher_suite/0, erl_cipher_suite/0, openssl_cipher_suite/0, @@ -310,18 +311,21 @@ aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, %%-------------------------------------------------------------------- suites({3, 0}) -> ssl_v3:suites(); -suites({3, N}) -> - tls_v1:suites(N); -suites(Version) -> - suites(dtls_v1:corresponding_tls_version(Version)). +suites({3, Minor}) -> + tls_v1:suites(Minor); +suites({_, Minor}) -> + dtls_v1:suites(Minor). -all_suites(Version) -> +all_suites({3, _} = Version) -> suites(Version) ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) - ++ des_suites(Version). + ++ des_suites(Version); +all_suites(Version) -> + dtls_v1:all_suites(Version). + %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -1541,6 +1545,10 @@ calc_mac_hash(Type, Version, MacSecret, SeqNo, Type, Length, PlainFragment). +is_stream_ciphersuite({_, rc4_128, _, _}) -> + true; +is_stream_ciphersuite(_) -> + false. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 0c17891fbc..ea139ac4b1 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -148,19 +148,19 @@ socket_control(Connection, Socket, Pid, Transport) -> %%-------------------------------------------------------------------- socket_control(Connection, Socket, Pid, Transport, udp_listner) -> %% dtls listner process must have the socket control - {ok, dtls_socket:socket(Pid, Transport, Socket, Connection)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)}; socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end; socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, tls_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; + {ok, Connection:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -363,11 +363,13 @@ init({call, From}, {start, Timeout}, State0, Connection) -> timer = Timer}), Connection:next_event(hello, Record, State); init({call, From}, {start, {Opts, EmOpts}, Timeout}, - #state{role = Role} = State0, Connection) -> + #state{role = Role, ssl_options = OrigSSLOptions, + socket_options = SockOpts} = State0, Connection) -> try - State = ssl_config(Opts, Role, State0), + SslOpts = ssl:handle_options(Opts, OrigSSLOptions), + State = ssl_config(SslOpts, Role, State0), init({call, From}, {start, Timeout}, - State#state{ssl_options = Opts, socket_options = EmOpts}, Connection) + State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection) catch throw:Error -> {stop_and_reply, normal, {reply, From, {error, Error}}} end; @@ -432,11 +434,11 @@ abbreviated(internal, #finished{verify_data = Data} = Finished, verified -> ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), - State1 = + {State1, Actions} = finalize_handshake(State0#state{connection_states = ConnectionStates1}, abbreviated, Connection), {Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection), - Connection:next_event(connection, Record, State); + Connection:next_event(connection, Record, State, Actions); #alert{} = Alert -> handle_own_alert(Alert, Version, abbreviated, State0) end; @@ -856,6 +858,7 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, StateName, State); handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, _) -> + ct:pal("Unexpected msg ~p", [Msg]), Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), handle_own_alert(Alert, Version, {StateName, Msg}, State). @@ -1236,13 +1239,13 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite, negotiated_version = Version} = State0, Connection) -> try server_certify_and_key_exchange(State0, Connection) of #state{} = State1 -> - State2 = server_hello_done(State1, Connection), + {State2, Actions} = server_hello_done(State1, Connection), Session = Session0#session{session_id = SessionId, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State2#state{session = Session}), - Connection:next_event(certify, Record, State) + Connection:next_event(certify, Record, State, Actions) catch #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0) @@ -1257,10 +1260,10 @@ resumed_server_hello(#state{session = Session, {_, ConnectionStates1} -> State1 = State0#state{connection_states = ConnectionStates1, session = Session}, - State2 = + {State2, Actions} = finalize_handshake(State1, abbreviated, Connection), {Record, State} = Connection:next_record(State2), - Connection:next_event(abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State, Actions); #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0) end. @@ -1343,12 +1346,12 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = State0, Connection) -> try do_client_certify_and_key_exchange(State0, Connection) of State1 = #state{} -> - State2 = finalize_handshake(State1, certify, Connection), + {State2, Actions} = finalize_handshake(State1, certify, Connection), State3 = State2#state{ %% Reinitialize client_certificate_requested = false}, {Record, State} = Connection:next_record(State3), - Connection:next_event(cipher, Record, State) + Connection:next_event(cipher, Record, State, Actions) catch throw:#alert{} = Alert -> handle_own_alert(Alert, Version, certify, State0) @@ -1870,11 +1873,11 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0 Connection) -> ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), - State1 = + {State1, Actions} = finalize_handshake(State0#state{connection_states = ConnectionStates1, session = Session}, cipher, Connection), {Record, State} = prepare_connection(State1, Connection), - Connection:next_event(connection, Record, State). + Connection:next_event(connection, Record, State, Actions). is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; @@ -2305,7 +2308,7 @@ format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data, Tracker, Connection) -> - {ssl, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl, Connection:socket(self(), Transport, Socket, Connection, Tracker), do_format_reply(Mode, Packet, Header, Data)}. deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker, Connection) -> @@ -2314,7 +2317,7 @@ deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Da format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _, _) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker, Connection) -> - {ssl_error, tls_socket:socket(self(), Transport, Socket, Connection, Tracker), + {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -2369,11 +2372,11 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, tls_socket:socket(self(), + {ssl_closed, Connection:socket(self(), Transport, Socket, Connection, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, tls_socket:socket(self(), + {ssl_error, Connection:socket(self(), Transport, Socket, Connection, Tracker), ReasonCode}) end. @@ -2472,3 +2475,8 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> _ -> ssl:handle_options(SSLOption, OrigSSLOptions) end. + +new_emulated([], EmOpts) -> + EmOpts; +new_emulated(NewEmOpts, _) -> + NewEmOpts. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index c34af9f82c..c10ec3a2d6 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -76,7 +76,7 @@ -define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]). -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). --define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). +-define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]). -define('24H_in_msec', 86400000). -define('24H_in_sec', 86400). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 77606911be..c6e530e164 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -48,7 +48,7 @@ -export([encode_data/3, encode_alert/3]). %% State transition handling --export([next_record/1, next_event/3]). +-export([next_record/1, next_event/3, next_event/4]). %% Handshake handling -export([renegotiate/2, send_handshake/2, @@ -59,7 +59,8 @@ -export([send_alert/2, close/5]). %% Data handling --export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3]). +-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3, + socket/5]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -117,7 +118,7 @@ send_handshake_flight(#state{socket = Socket, transport_cb = Transport, flight_buffer = Flight} = State0) -> send(Transport, Socket, Flight), - State0#state{flight_buffer = []}. + {State0#state{flight_buffer = []}, []}. queue_change_cipher(Msg, #state{negotiated_version = Version, flight_buffer = Flight0, @@ -191,6 +192,10 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) -> callback_mode() -> state_functions. +socket(Pid, Transport, Socket, Connection, Tracker) -> + tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). + + %%-------------------------------------------------------------------- %% State functions %%-------------------------------------------------------------------- @@ -340,12 +345,12 @@ connection(internal, #hello_request{}, renegotiation = {Renegotiation, _}} = State0) -> Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), - State1 = send_handshake(Hello, State0), + {State1, Actions} = send_handshake(Hello, State0), {Record, State} = next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_event(hello, Record, State); + next_event(hello, Record, State, Actions); connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State0) -> %% Mitigate Computational DoS attack diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index f0a3c42e8d..bff6d254f1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -53,7 +53,8 @@ all() -> {group, options_tls}, {group, session}, {group, 'dtlsv1.2'}, - %%{group, 'dtlsv1'}, + %% {group, 'dtlsv1'}, Breaks dtls in cert_verify_SUITE enable later when + %% problem is identified and fixed {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, @@ -65,15 +66,15 @@ groups() -> {basic_tls, [], basic_tests_tls()}, {options, [], options_tests()}, {options_tls, [], options_tests_tls()}, - %%{'dtlsv1.2', [], all_versions_groups()}, - {'dtlsv1.2', [], [connection_information]}, - %%{'dtlsv1', [], all_versions_groups()}, + {'dtlsv1.2', [], all_versions_groups()}, + {'dtlsv1', [], all_versions_groups()}, {'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()}, {'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]}, {api,[], api_tests()}, {api_tls,[], api_tests_tls()}, + {tls_ciphers,[], tls_cipher_tests()}, {session, [], session_tests()}, {renegotiate, [], renegotiate_tests()}, {ciphers, [], cipher_tests()}, @@ -83,12 +84,13 @@ groups() -> ]. tls_versions_groups ()-> - [{group, api_tls}, + [{group, renegotiate}, %% Should be in all_versions_groups not fixed for DTLS yet + {group, api_tls}, + {group, tls_ciphers}, {group, error_handling_tests_tls}]. all_versions_groups ()-> [{group, api}, - {group, renegotiate}, {group, ciphers}, {group, ciphers_ec}, {group, error_handling_tests}]. @@ -147,10 +149,8 @@ options_tests_tls() -> api_tests() -> [connection_info, connection_information, - peername, peercert, peercert_with_client_cert, - sockname, versions, eccs, controlling_process, @@ -162,7 +162,6 @@ api_tests() -> ssl_recv_timeout, server_name_indication_option, accept_pool, - new_options_in_accept, prf ]. @@ -175,7 +174,10 @@ api_tests_tls() -> tls_shutdown, tls_shutdown_write, tls_shutdown_both, - tls_shutdown_error + tls_shutdown_error, + peername, + sockname, + new_options_in_accept ]. session_tests() -> @@ -197,6 +199,11 @@ renegotiate_tests() -> renegotiate_dos_mitigate_passive, renegotiate_dos_mitigate_absolute]. +tls_cipher_tests() -> + [rc4_rsa_cipher_suites, + rc4_ecdh_rsa_cipher_suites, + rc4_ecdsa_cipher_suites]. + cipher_tests() -> [cipher_suites, cipher_suites_mix, @@ -212,9 +219,6 @@ cipher_tests() -> srp_cipher_suites, srp_anon_cipher_suites, srp_dsa_cipher_suites, - rc4_rsa_cipher_suites, - rc4_ecdh_rsa_cipher_suites, - rc4_ecdsa_cipher_suites, des_rsa_cipher_suites, des_ecdh_rsa_cipher_suites, default_reject_anonymous]. @@ -226,15 +230,15 @@ cipher_tests_ec() -> ciphers_ecdh_rsa_signed_certs_openssl_names]. error_handling_tests()-> - [controller_dies, - close_transport_accept, + [close_transport_accept, recv_active, recv_active_once, recv_error_handling ]. error_handling_tests_tls()-> - [tls_client_closes_socket, + [controller_dies, + tls_client_closes_socket, tls_tcp_error_propagation_in_active_mode, tls_tcp_connect, tls_tcp_connect_big, @@ -843,8 +847,7 @@ controller_dies(Config) when is_list(Config) -> Server ! listen, Tester = self(), Connect = fun(Pid) -> - {ok, Socket} = ssl:connect(Hostname, Port, - [{reuseaddr,true},{ssl_imp,new}]), + {ok, Socket} = ssl:connect(Hostname, Port, ClientOpts), %% Make sure server finishes and verification %% and is in coonection state before %% killing client @@ -2194,8 +2197,9 @@ ciphers_dsa_signed_certs() -> [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:dsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- @@ -2218,29 +2222,33 @@ anonymous_cipher_suites(Config) when is_list(Config) -> psk_cipher_suites() -> [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_suites(), + Ciphers = ssl_test_lib:psk_suites(NVersion), run_suites(Ciphers, Version, Config, psk). %%------------------------------------------------------------------- psk_with_hint_cipher_suites()-> [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}]. psk_with_hint_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_suites(), + Ciphers = ssl_test_lib:psk_suites(NVersion), run_suites(Ciphers, Version, Config, psk_with_hint). %%------------------------------------------------------------------- psk_anon_cipher_suites() -> [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_anon_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_anon_suites(), + Ciphers = ssl_test_lib:psk_anon_suites(NVersion), run_suites(Ciphers, Version, Config, psk_anon). %%------------------------------------------------------------------- psk_anon_with_hint_cipher_suites()-> [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}]. psk_anon_with_hint_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:psk_anon_suites(), + Ciphers = ssl_test_lib:psk_anon_suites(NVersion), run_suites(Ciphers, Version, Config, psk_anon_with_hint). %%------------------------------------------------------------------- srp_cipher_suites()-> @@ -2291,18 +2299,17 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> %%------------------------------------------------------------------- des_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. + [{doc, "Test the des_rsa ciphersuites"}]. des_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), - Ciphers = ssl_test_lib:des_suites(NVersion), + Version = ssl_test_lib:protocol_version(Config), + Ciphers = ssl_test_lib:des_suites(Config), run_suites(Ciphers, Version, Config, des_rsa). %------------------------------------------------------------------- des_ecdh_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. + [{doc, "Test ECDH rsa signed ciphersuites"}]. des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Version = tls_record:protocol_version(NVersion), + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_test_lib:des_suites(NVersion), run_suites(Ciphers, Version, Config, des_dhe_rsa). @@ -2313,9 +2320,11 @@ default_reject_anonymous(Config) when is_list(Config) -> {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()), - [CipherSuite | _] = ssl_test_lib:anonymous_suites(Version), - + Version = ssl_test_lib:protocol_version(Config), + TLSVersion = ssl_test_lib:tls_version(Version), + + [CipherSuite | _] = ssl_test_lib:anonymous_suites(TLSVersion), + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {options, ServerOpts}]), @@ -2335,8 +2344,9 @@ ciphers_ecdsa_signed_certs() -> [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:ecdsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdsa). %%-------------------------------------------------------------------- @@ -2353,8 +2363,9 @@ ciphers_ecdh_rsa_signed_certs() -> [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)), + Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdh_rsa). %%-------------------------------------------------------------------- @@ -3326,11 +3337,11 @@ hibernate(Config) -> process_info(Pid, current_function), ssl_test_lib:check_result(Server, ok, Client, ok), - timer:sleep(1100), - + + timer:sleep(1500), {current_function, {erlang, hibernate, 3}} = process_info(Pid, current_function), - + ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -3363,13 +3374,12 @@ hibernate_right_away(Config) -> [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), ssl_test_lib:check_result(Server1, ok, Client1, ok), - - {current_function, {erlang, hibernate, 3}} = + + {current_function, {erlang, hibernate, 3}} = process_info(Pid1, current_function), - ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), - + Server2 = ssl_test_lib:start_server(StartServerOpts), Port2 = ssl_test_lib:inet_port(Server2), {Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++ @@ -3377,8 +3387,8 @@ hibernate_right_away(Config) -> ssl_test_lib:check_result(Server2, ok, Client2, ok), - ct:sleep(100), %% Schedule out - + ct:sleep(1000), %% Schedule out + {current_function, {erlang, hibernate, 3}} = process_info(Pid2, current_function), @@ -4507,16 +4517,21 @@ run_suites(Ciphers, Version, Config, Type) -> [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk, Config)}; + [{ciphers, ssl_test_lib:psk_suites(Version)} | + ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_hint, Config)}; + [{ciphers, ssl_test_lib:psk_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_hint, Config) + ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_anon, Config)}; + [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - ssl_test_lib:ssl_options(server_psk_anon_hint, Config)}; + [{ciphers, ssl_test_lib:psk_anon_suites(Version)} | + ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), ssl_test_lib:ssl_options(server_srp, Config)}; @@ -4556,7 +4571,7 @@ run_suites(Ciphers, Version, Config, Type) -> Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - ssl_test_lib:filter_suites(Ciphers)), + ssl_test_lib:filter_suites(Ciphers, Version)), case lists:flatten(Result) of [] -> ok; diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5265c87e29..4552a4f57d 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -39,17 +39,26 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- all() -> - [{group, active}, - {group, passive}, - {group, active_once}, - {group, error_handling}]. - + [ + {group, tls}, + {group, dtls} + ]. groups() -> - [{active, [], tests()}, + [ + {tls, [], all_protocol_groups()}, + {dtls, [], all_protocol_groups()}, + {active, [], tests()}, {active_once, [], tests()}, {passive, [], tests()}, - {error_handling, [],error_handling_tests()}]. + {error_handling, [],error_handling_tests()} + ]. + +all_protocol_groups() -> + [{group, active}, + {group, passive}, + {group, active_once}, + {group, error_handling}]. tests() -> [verify_peer, @@ -85,7 +94,7 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - ssl_test_lib:clean_start(), + ssl_test_lib:clean_start(), %% make rsa certs using oppenssl {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), proplists:get_value(priv_dir, Config0)), @@ -99,6 +108,26 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). +init_per_group(tls, Config) -> + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, Version), + application:set_env(ssl, bypass_pem_cache, Version), + ssl:start(), + NewConfig = proplists:delete(protocol, Config), + [{protocol, tls}, {version, tls_record:protocol_version(Version)} | NewConfig]; + +init_per_group(dtls, Config) -> + Version = dtls_record:protocol_version(dtls_record:highest_protocol_version([])), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, Version), + application:set_env(ssl, bypass_pem_cache, Version), + ssl:start(), + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}, {version, dtls_record:protocol_version(Version)} | NewConfig]; + init_per_group(active, Config) -> [{active, true}, {receive_function, send_recv_result_active} | Config]; init_per_group(active_once, Config) -> @@ -262,7 +291,7 @@ server_require_peer_cert_fail() -> server_require_peer_cert_fail(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ssl_test_lib:ssl_options(server_verification_opts, Config)], - BadClientOpts = ssl_test_lib:ssl_options(client_opts, []), + BadClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, @@ -411,7 +440,7 @@ server_require_peer_cert_partial_chain_fun_fail() -> server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ssl_test_lib:ssl_options(server_verification_opts, Config)], - ClientOpts = proplists:get_value(client_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), @@ -1091,6 +1120,7 @@ client_with_cert_cipher_suites_handshake() -> client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> ClientOpts = ssl_test_lib:ssl_options(client_verification_opts_digital_signature_only, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -1098,7 +1128,7 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> send_recv_result_active, []}}, {options, [{active, true}, {ciphers, - ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))} + ssl_test_lib:rsa_non_signed_suites(proplists:get_value(version, Config))} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -1132,7 +1162,7 @@ server_verify_no_cacerts(Config) when is_list(Config) -> unknown_server_ca_fail() -> [{doc,"Test that the client fails if the ca is unknown in verify_peer mode"}]. unknown_server_ca_fail(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, @@ -1176,7 +1206,7 @@ unknown_server_ca_fail(Config) when is_list(Config) -> unknown_server_ca_accept_verify_none() -> [{doc,"Test that the client succeds if the ca is unknown in verify_none mode"}]. unknown_server_ca_accept_verify_none(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -1201,8 +1231,8 @@ unknown_server_ca_accept_verify_peer() -> [{doc, "Test that the client succeds if the ca is unknown in verify_peer mode" " with a verify_fun that accepts the unknown ca error"}]. unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> - ClientOpts =ssl_test_lib:ssl_options(client_opts, []), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -1240,7 +1270,7 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> unknown_server_ca_accept_backwardscompatibility() -> [{doc,"Test that old style verify_funs will work"}]. unknown_server_ca_accept_backwardscompatibility(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, []), + ClientOpts = ssl_test_lib:ssl_options(empty_client_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index 69aeea10c5..0b1de1dc1c 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -50,6 +50,10 @@ init_per_suite(Config) -> {skip, "Crypto did not start"} end. +end_per_suite(_Config) -> + %% This function is required since init_per_suite/1 exists. + ok. + init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 5}), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 49d2b5c1b8..7a644968f2 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -401,27 +401,22 @@ cert_options(Config) -> {ssl_imp, new}]}, {server_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, - %%{server_anon, [{ssl_imp, new},{reuseaddr, true}, {ciphers, anonymous_suites()}]}, - {client_psk, [{ssl_imp, new},{reuseaddr, true}, + {client_psk, [{ssl_imp, new}, {psk_identity, "Test-User"}, {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_hint, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {psk_identity, "HINT"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_anon, [{ssl_imp, new},{reuseaddr, true}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_anon_suites()}]}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, {server_psk_anon_hint, [{ssl_imp, new},{reuseaddr, true}, {psk_identity, "HINT"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}, - {ciphers, psk_anon_suites()}]}, - {client_srp, [{ssl_imp, new},{reuseaddr, true}, + {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}, + {client_srp, [{ssl_imp, new}, {srp_identity, {"Test-User", "secret"}}]}, {server_srp, [{ssl_imp, new},{reuseaddr, true}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, @@ -476,7 +471,7 @@ make_dsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_dsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}, {server_srp_dsa, [{ssl_imp, new},{reuseaddr, true}, @@ -484,7 +479,7 @@ make_dsa_cert(Config) -> {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {user_lookup_fun, {fun user_lookup/3, undefined}}, {ciphers, srp_dss_suites()}]}, - {client_srp_dsa, [{ssl_imp, new},{reuseaddr, true}, + {client_srp_dsa, [{ssl_imp, new}, {srp_identity, {"Test-User", "secret"}}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} @@ -505,7 +500,7 @@ make_ecdsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_ecdsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]; @@ -540,7 +535,7 @@ make_ecdh_rsa_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_ecdh_rsa_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]; @@ -560,7 +555,7 @@ make_mix_cert(Config) -> {cacertfile, ClientCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, - {client_mix_opts, [{ssl_imp, new},{reuseaddr, true}, + {client_mix_opts, [{ssl_imp, new}, {cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]. @@ -830,17 +825,17 @@ rsa_suites(CounterPart) -> ({dhe_rsa, des_cbc, sha}) when FIPS == true -> false; ({rsa, Cipher, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({dhe_rsa, Cipher, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({ecdhe_rsa, Cipher, _}) when ECC == true -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({rsa, Cipher, _, _}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({dhe_rsa, Cipher, _,_}) -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); ({ecdhe_rsa, Cipher, _,_}) when ECC == true -> - lists:member(Cipher, Ciphers); + lists:member(cipher_atom(Cipher), Ciphers); (_) -> false end, @@ -933,44 +928,12 @@ anonymous_suites(Version) -> Suites = ssl_cipher:anonymous_suites(Version), ssl_cipher:filter_suites(Suites). -psk_suites() -> - Suites = - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {psk, aes_128_cbc, sha256}, - {psk, aes_256_cbc, sha384}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}, - {dhe_psk, aes_128_cbc, sha256}, - {dhe_psk, aes_256_cbc, sha384}, - {rsa_psk, rc4_128, sha}, - {rsa_psk, '3des_ede_cbc', sha}, - {rsa_psk, aes_128_cbc, sha}, - {rsa_psk, aes_256_cbc, sha}, - {rsa_psk, aes_128_cbc, sha256}, - {rsa_psk, aes_256_cbc, sha384}, - {psk, aes_128_gcm, null, sha256}, - {psk, aes_256_gcm, null, sha384}, - {dhe_psk, aes_128_gcm, null, sha256}, - {dhe_psk, aes_256_gcm, null, sha384}, - {rsa_psk, aes_128_gcm, null, sha256}, - {rsa_psk, aes_256_gcm, null, sha384}], +psk_suites(Version) -> + Suites = ssl_cipher:psk_suites(Version), ssl_cipher:filter_suites(Suites). -psk_anon_suites() -> - Suites = - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}], +psk_anon_suites(Version) -> + Suites = [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)], ssl_cipher:filter_suites(Suites). srp_suites() -> @@ -1092,14 +1055,16 @@ init_tls_version(Version, Config) application:load(ssl), application:set_env(ssl, dtls_protocol_version, Version), ssl:start(), - [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]}|Config]; + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, dtls}, {protocol_opts, [{protocol, dtls}]} | NewConfig]; init_tls_version(Version, Config) -> ssl:stop(), application:load(ssl), application:set_env(ssl, protocol_version, Version), ssl:start(), - [{protocol, tls}|Config]. + NewConfig = proplists:delete(protocol_opts, proplists:delete(protocol, Config)), + [{protocol, tls} | NewConfig]. sufficient_crypto_support(Version) when Version == 'tlsv1.2'; Version == 'dtlsv1.2' -> @@ -1234,19 +1199,37 @@ check_sane_openssl_version(Version) -> enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; enough_openssl_crl_support(_) -> true. -wait_for_openssl_server(Port) -> - wait_for_openssl_server(Port, 10). -wait_for_openssl_server(_, 0) -> +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). + +do_wait_for_openssl_tls_server(_, 0) -> exit(failed_to_connect_to_openssl); -wait_for_openssl_server(Port, N) -> +do_wait_for_openssl_tls_server(Port, N) -> case gen_tcp:connect("localhost", Port, []) of {ok, S} -> gen_tcp:close(S); _ -> ct:sleep(?SLEEP), - wait_for_openssl_server(Port, N-1) + 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') -> @@ -1256,10 +1239,14 @@ version_flag('tlsv1.2') -> version_flag(sslv3) -> "-ssl3"; version_flag(sslv2) -> - "-ssl2". - -filter_suites(Ciphers0) -> - Version = tls_record:highest_protocol_version([]), + "-ssl2"; +version_flag('dtlsv1.2') -> + "-dtls1_2"; +version_flag('dtlsv1') -> + "-dtls1". + +filter_suites(Ciphers0, AtomVersion) -> + Version = tls_version(AtomVersion), Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) @@ -1341,7 +1328,7 @@ protocol_version(Config) -> protocol_version(Config, tuple) -> case proplists:get_value(protocol, Config) of dtls -> - dtls_record:protocol_version(dtls_record:highest_protocol_version([])); + dtls_record:highest_protocol_version(dtls_record:supported_protocol_versions()); _ -> tls_record:highest_protocol_version(tls_record:supported_protocol_versions()) end; @@ -1375,6 +1362,7 @@ clean_env() -> application:unset_env(ssl, session_cache_client_max), application:unset_env(ssl, session_cache_server_max), application:unset_env(ssl, ssl_pem_cache_clean), + application:unset_env(ssl, bypass_pem_cache), application:unset_env(ssl, alert_timeout). clean_start() -> @@ -1382,3 +1370,105 @@ clean_start() -> application:load(ssl), clean_env(), ssl:start(). + +is_psk_anon_suite({psk, _,_}) -> + true; +is_psk_anon_suite({dhe_psk,_,_}) -> + true; +is_psk_anon_suite({psk, _,_,_}) -> + true; +is_psk_anon_suite({dhe_psk, _,_,_}) -> + true; +is_psk_anon_suite(_) -> + false. + +cipher_atom(aes_256_cbc) -> + aes_cbc256; +cipher_atom(aes_128_cbc) -> + aes_cbc128; +cipher_atom('3des_ede_cbc') -> + des_ede3; +cipher_atom(Atom) -> + Atom. +tls_version('dtlsv1' = Atom) -> + dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom)); +tls_version('dtlsv1.2' = Atom) -> + dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Atom)); +tls_version(Atom) -> + tls_record:protocol_version(Atom). + +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 e99340822d..7a1dce70c2 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -42,7 +42,9 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'} + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} ]. groups() -> @@ -50,7 +52,10 @@ groups() -> {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, - {'sslv3', [], all_versions_tests()}]. + {'sslv3', [], all_versions_tests()}, + {'dtlsv1.2', [], dtls_all_versions_tests()}, + {'dtlsv1', [], dtls_all_versions_tests()} + ]. basic_tests() -> [basic_erlang_client_openssl_server, @@ -78,6 +83,25 @@ all_versions_tests() -> expired_session, ssl2_erlang_server_openssl_client ]. +dtls_all_versions_tests() -> + [ + %%erlang_client_openssl_server, + erlang_server_openssl_client, + %%erlang_client_openssl_server_dsa_cert, + erlang_server_openssl_client_dsa_cert + %% This one works but gets port EXIT first some times + %%erlang_server_openssl_client_reuse_session + %%erlang_client_openssl_server_renegotiate, + %%erlang_client_openssl_server_nowrap_seqnum, + %%erlang_server_openssl_client_nowrap_seqnum, + %%erlang_client_openssl_server_no_server_ca_cert, + %%erlang_client_openssl_server_client_cert, + %%erlang_server_openssl_client_client_cert + %%ciphers_rsa_signed_certs, + %%ciphers_dsa_signed_certs, + %%erlang_client_bad_openssl_server, + %%expired_session + ]. alpn_tests() -> [erlang_client_alpn_openssl_server_alpn, @@ -284,7 +308,8 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + + ssl_test_lib:wait_for_openssl_server(Port, tls), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -357,7 +382,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -431,7 +456,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -551,7 +576,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -600,7 +625,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -681,7 +706,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -724,7 +749,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -856,7 +881,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -911,7 +936,7 @@ expired_session(Config) when is_list(Config) -> OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, tls), Client0 = ssl_test_lib:start_client([{node, ClientNode}, @@ -1399,7 +1424,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), ConnectionInfo = {ok, {Version, CipherSuite}}, @@ -1469,7 +1494,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1505,7 +1530,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1574,7 +1599,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -1639,7 +1664,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - ssl_test_lib:wait_for_openssl_server(Port), + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 2cdb825d75..415a47949d 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.1 +SSL_VSN = 8.1.1 diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index fd498ee82e..5eb13db1aa 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2016</year> + <year>2016-2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -587,8 +587,8 @@ handle_event(_, _, State, Data) -> <name name="state_enter"/> <desc> <p> - If the state machine should use <em>state enter calls</em> - is selected when starting the <c>gen_statem</c> + Whether the state machine should use <em>state enter calls</em> + or not is selected when starting the <c>gen_statem</c> and after code change using the return value from <seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>. </p> @@ -606,7 +606,16 @@ handle_event(_, _, State, Data) -> See <seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso> and - <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>. + <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>. + Such a call can be repeated by returning a + <seealso marker="#type-state_callback_result"> + <c>repeat_state</c> + </seealso> + or + <seealso marker="#type-state_callback_result"> + <c>repeat_state_and_data</c> + </seealso> + tuple from the state callback. </p> <p> If @@ -625,7 +634,8 @@ handle_event(_, _, State, Data) -> right before entering the initial state even though this formally is not a state change. In this case <c>OldState</c> will be the same as <c>State</c>, - which can not happen for a subsequent state change. + which can not happen for a subsequent state change, + but will happen when repeating the state enter call. </p> </desc> </datatype> @@ -640,7 +650,15 @@ handle_event(_, _, State, Data) -> <list type="ordered"> <item> <p> - If the state changes or is the initial state, and + If the state changes, is the initial state, + <seealso marker="#type-state_callback_result"> + <c>repeat_state</c> + </seealso> + or + <seealso marker="#type-state_callback_result"> + <c>repeat_state_and_data</c> + </seealso> + is used, and also <seealso marker="#type-state_enter"><em>state enter calls</em></seealso> are used, the <c>gen_statem</c> calls the new state callback with arguments @@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) -> </desc> </datatype> <datatype> + <name name="init_result"/> + <desc> + <p> + For a succesful initialization, + <c><anno>State</anno></c> is the initial + <seealso marker="#type-state"><c>state()</c></seealso> + and <c><anno>Data</anno></c> the initial server + <seealso marker="#type-data"><c>data()</c></seealso> + of the <c>gen_statem</c>. + </p> + <p> + The <seealso marker="#type-action"><c>Actions</c></seealso> + are executed when entering the first + <seealso marker="#type-state">state</seealso> just as for a + <seealso marker="#state callback">state callback</seealso>, + except that the action <c>postpone</c> is forced to + <c>false</c> since there is no event to postpone. + </p> + <p> + For an unsuccesful initialization, + <c>{stop,<anno>Reason</anno>}</c> + or <c>ignore</c> should be used; see + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. + </p> + </desc> + </datatype> + <datatype> <name name="state_enter_result"/> <desc> <p> @@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) -> <c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>. </p> </item> + <tag><c>repeat_state</c></tag> + <item> + <p> + The <c>gen_statem</c> keeps the current state, or + does a state transition to the current state if you like, + sets <c><anno>NewData</anno></c>, + and executes all <c><anno>Actions</anno></c>. + If the <c>gen_statem</c> runs with + <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>, + the state enter call is repeated, see type + <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>, + otherwise <c>repeat_state</c> is the same as + <c>keep_state</c>. + </p> + </item> + <tag><c>repeat_state_and_data</c></tag> + <item> + <p> + The <c>gen_statem</c> keeps the current state and data, or + does a state transition to the current state if you like, + and executes all <c><anno>Actions</anno></c>. + This is the same as + <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>. + If the <c>gen_statem</c> runs with + <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>, + the state enter call is repeated, see type + <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>, + otherwise <c>repeat_state_and_data</c> is the same as + <c>keep_state_and_data</c>. + </p> + </item> <tag><c>stop</c></tag> <item> <p> @@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) -> It is recommended to use an atom as <c>Reason</c> since it will be wrapped in an <c>{error,Reason}</c> tuple. </p> + <p> + Also note when upgrading a <c>gen_statem</c>, + this function and hence + the <c>Change={advanced,Extra}</c> parameter in the + <seealso marker="sasl:appup"><c>appup</c></seealso> file + is not only needed to update the internal state + or to act on the <c>Extra</c> argument. + It is also needed if an upgrade or downgrade should change + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>, + or else the callback mode after the code change + will not be honoured, + most probably causing a server crash. + </p> </desc> </func> <func> - <name>Module:init(Args) -> Result</name> + <name>Module:init(Args) -> Result(StateType)</name> <fsummary> Optional function for initializing process and internal state. </fsummary> <type> <v>Args = term()</v> - <v>Result = {ok,State,Data}</v> - <v> | {ok,State,Data,Actions}</v> - <v> | {stop,Reason} | ignore</v> - <v>State = <seealso marker="#type-state">state()</seealso></v> - <v> - Data = <seealso marker="#type-data">data()</seealso> - </v> <v> - Actions = - [<seealso marker="#type-action">action()</seealso>] | - <seealso marker="#type-action">action()</seealso> + Result(StateType) = + <seealso marker="#type-init_result">init_result(StateType)</seealso> </v> - <v>Reason = term()</v> </type> <desc> <marker id="Module:init-1"/> @@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) -> the implementation state and server data. </p> <p> - <c>Args</c> is the <c>Args</c> argument provided to the start + <c>Args</c> is the <c>Args</c> argument provided to that start function. </p> - <p> - If the initialization is successful, the function is to - return <c>{ok,State,Data}</c> or - <c>{ok,State,Data,Actions}</c>. - <c>State</c> is the initial - <seealso marker="#type-state"><c>state()</c></seealso> - and <c>Data</c> the initial server - <seealso marker="#type-data"><c>data()</c></seealso>. - </p> - <p> - The <seealso marker="#type-action"><c>Actions</c></seealso> - are executed when entering the first - <seealso marker="#type-state">state</seealso> just as for a - <seealso marker="#state callback">state callback</seealso>. - </p> - <p> - If the initialization fails, - the function is to return <c>{stop,Reason}</c> - or <c>ignore</c>; see - <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. - </p> <note> <p> This callback is optional, so a callback module does not need @@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) -> <seealso marker="#type-enter_action">actions</seealso> that may be returned: <seealso marker="#type-postpone"><c>postpone()</c></seealso> - and + is not allowed since a <em>state enter call</em> is not + an event so there is no event to postpone, and <seealso marker="#type-action"><c>{next_event,_,_}</c></seealso> - are not allowed. + is not allowed since using <em>state enter calls</em> + should not affect how events are consumed and produced. You may also not change states from this call. Should you return <c>{next_state,NextState, ...}</c> with <c>NextState =/= State</c> the <c>gen_statem</c> crashes. - You are advised to use <c>{keep_state,...}</c> or - <c>keep_state_and_data</c>. + It is possible to use <c>{repeat_state, ...}</c>, + <c>{repeat_state_and_data,_}</c> or + <c>repeat_state_and_data</c> but all of them makes little + sense since you immediately will be called again with a new + <em>state enter call</em> making this just a weird way + of looping, and there are better ways to loop in Erlang. + You are advised to use <c>{keep_state,...}</c>, + <c>{keep_state_and_data,_}</c> or + <c>keep_state_and_data</c> since you can not change states + from a <em>state enter call</em> anyway. </p> <p> Note the fact that you can use <seealso marker="erts:erlang#throw/1"><c>throw</c></seealso> to return the result, which can be useful. For example to bail out with <c>throw(keep_state_and_data)</c> - from deep within complex code that is in no position to - return <c>{next_state,State,Data}</c>. + from deep within complex code that can not + return <c>{next_state,State,Data}</c> because + <c>State</c> or <c>Data</c> is no longer in scope. </p> </desc> </func> @@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) -> <v>Ignored = term()</v> </type> <desc> + <note> + <p>This callback is optional, so callback modules need not + export it. The <c>gen_statem</c> module provides a default + implementation without cleanup.</p> + </note> <p> This function is called by a <c>gen_statem</c> when it is about to terminate. It is to be the opposite of diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 0143686bb2..0e8bf3d27c 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -3163,7 +3163,7 @@ <p> Two bugs in io:format for ~F.~Ps has been corrected. When length(S) >= abs(F) > P, the precision P was incorrectly - ignored. When F == P > lenght(S) the result was + ignored. When F == P > length(S) the result was incorrectly left adjusted. Bug found by Ali Yakout who also provided a fix.</p> <p> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 9091a46df9..45171f814d 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -83,8 +83,8 @@ <p>If the modules used to implement the process change dynamically during runtime, the process must understand one more message. An example is the <seealso marker="gen_event"><c>gen_event</c></seealso> - processes. The message is <c>{get_modules, From}</c>. - The reply to this message is <c>From ! {modules, Modules}</c>, where + processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>. + The reply to this message is <c>From ! {Ref, Modules}</c>, where <c>Modules</c> is a list of the currently active modules in the process.</p> <p>This message is used by the release handler to find which diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl index bf259e6691..0c8d817910 100644 --- a/lib/stdlib/src/base64.erl +++ b/lib/stdlib/src/base64.erl @@ -219,38 +219,49 @@ mime_decode_binary(Result, <<0:8,T/bits>>) -> mime_decode_binary(Result, T); mime_decode_binary(Result0, <<C:8,T/bits>>) -> case element(C, ?DECODE_MAP) of - Bits when is_integer(Bits) -> - mime_decode_binary(<<Result0/bits,Bits:6>>, T); - eq -> - case tail_contains_more(T, false) of - {<<>>, Eq} -> - %% No more valid data. - case bit_size(Result0) rem 8 of - 0 -> - %% '====' is not uncommon. - Result0; - 4 when Eq -> - %% enforce at least one more '=' only ignoring illegals and spacing - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:4>> = Result0, - Result; - 2 -> - %% remove 2 bits - Split = byte_size(Result0) - 1, - <<Result:Split/bytes,_:2>> = Result0, - Result - end; - {More, _} -> - %% More valid data, skip the eq as invalid - mime_decode_binary(Result0, More) - end; - _ -> - mime_decode_binary(Result0, T) + Bits when is_integer(Bits) -> + mime_decode_binary(<<Result0/bits,Bits:6>>, T); + eq -> + mime_decode_binary_after_eq(Result0, T, false); + _ -> + mime_decode_binary(Result0, T) end; -mime_decode_binary(Result, <<>>) -> +mime_decode_binary(Result, _) -> true = is_binary(Result), Result. +mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) -> + mime_decode_binary_after_eq(Result, T, Eq); +mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) -> + case element(C, ?DECODE_MAP) of + bad -> + mime_decode_binary_after_eq(Result0, T, Eq); + ws -> + mime_decode_binary_after_eq(Result0, T, Eq); + eq -> + mime_decode_binary_after_eq(Result0, T, true); + Bits when is_integer(Bits) -> + %% More valid data, skip the eq as invalid + mime_decode_binary(<<Result0/bits,Bits:6>>, T) + end; +mime_decode_binary_after_eq(Result0, <<>>, Eq) -> + %% No more valid data. + case bit_size(Result0) rem 8 of + 0 -> + %% '====' is not uncommon. + Result0; + 4 when Eq -> + %% enforce at least one more '=' only ignoring illegals and spacing + Split = byte_size(Result0) - 1, + <<Result:Split/bytes,_:4>> = Result0, + Result; + 2 -> + %% remove 2 bits + Split = byte_size(Result0) - 1, + <<Result:Split/bytes,_:2>> = Result0, + Result + end. + decode([], A) -> A; decode([$=,$=,C2,C1|Cs], A) -> Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12), diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 4839fe4f2c..0aebf1bdc5 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -778,7 +778,7 @@ stop_handlers([], _) -> []. %% Message from the release_handler. -%% The list of modules got to be a set ! +%% The list of modules got to be a set, i.e. no duplicate elements! get_modules(MSL) -> Mods = [Handler#handler.module || Handler <- MSL], ordsets:to_list(ordsets:from_list(Mods)). diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 018aca90e6..cacc932ec4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016. All Rights Reserved. +%% Copyright Ericsson AB 2016-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. @@ -47,15 +47,17 @@ %% Type exports for templates and callback modules -export_type( [event_type/0, - init_result/0, callback_mode_result/0, - state_function_result/0, - handle_event_result/0, + init_result/1, state_enter_result/1, event_handler_result/1, reply_action/0, enter_action/0, action/0]). +%% Old types, not advertised +-export_type( + [state_function_result/0, + handle_event_result/0]). %% Type that is exported just to be documented -export_type([transition_option/0]). @@ -143,9 +145,10 @@ {'reply', % Reply to a caller From :: from(), Reply :: term()}. --type init_result() :: - {ok, state(), data()} | - {ok, state(), data(), [action()] | action()} | +-type init_result(StateType) :: + {ok, State :: StateType, Data :: data()} | + {ok, State :: StateType, Data :: data(), + Actions :: [action()] | action()} | 'ignore' | {'stop', Reason :: term()}. @@ -182,12 +185,23 @@ 'keep_state_and_data' | % {keep_state_and_data,[]} {'keep_state_and_data', % Keep state and data -> only actions Actions :: [ActionType] | ActionType} | + %% + {'repeat_state', % {repeat_state,NewData,[]} + NewData :: data()} | + {'repeat_state', % Repeat state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'repeat_state_and_data' | % {repeat_state_and_data,[]} + {'repeat_state_and_data', % Repeat state and data -> only actions + Actions :: [ActionType] | ActionType} | + %% 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | {'stop', % Stop the server Reason :: term(), NewData :: data()} | + %% {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action()} | @@ -201,7 +215,7 @@ %% the server is not running until this function has returned %% an {ok, ...} tuple. Thereafter the state callbacks are called %% for all events to this server. --callback init(Args :: term()) -> init_result(). +-callback init(Args :: term()) -> init_result(state()). %% This callback shall return the callback mode of the callback module. %% @@ -275,6 +289,8 @@ -optional_callbacks( [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation + terminate/3, % Has got a default implementation + code_change/4, % Only needed by advanced soft upgrade %% state_name/3, % Example for callback_mode() =:= state_functions: %% there has to be a StateName/3 callback function @@ -304,12 +320,16 @@ event_type({call,From}) -> from(From); event_type(Type) -> case Type of + {call,From} -> + from(From); cast -> true; info -> true; timeout -> true; + state_timeout -> + true; internal -> true; _ -> @@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> true -> [Actions,{postpone,false}] end, + TimerRefs = #{}, + %% Key: timer ref + %% Value: the timer type i.e the timer's event type + %% + TimerTypes = #{}, + %% Key: timer type i.e the timer's event type + %% Value: timer ref + %% + %% We add a timer to both timer_refs and timer_types + %% when we start it. When we request an asynchronous + %% timer cancel we remove it from timer_types. When + %% the timer cancel message arrives we remove it from + %% timer_refs. + %% + Hibernate = false, + CancelTimers = 0, S = #{ callback_mode => undefined, state_enter => false, @@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> state => State, data => Data, postponed => P, - %% The rest of the fields are set from to the arguments to - %% loop_event_actions/10 when it finally loops back to loop/3 - %% in loop_events/10 %% - %% Marker for initial state, cleared immediately when used - init_state => true + %% The following fields are finally set from to the arguments to + %% loop_event_actions/9 when it finally loops back to loop/3 + %% in loop_event_result/11 + timer_refs => TimerRefs, + timer_types => TimerTypes, + hibernate => Hibernate, + cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> - TimerRefs = #{}, - TimerTypes = #{}, loop_event_actions( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, State, Data, NewActions); + Parent, NewDebug, NewS, + Events, Event, State, Data, NewActions, true); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - NewDebug, S, [Event|Events]) + Class, Reason, Stacktrace, NewDebug, + S, [Event|Events]) end. %%%========================================================================== @@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). system_terminate(Reason, _Parent, Debug, S) -> - terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, []). + terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( #{module := Module, @@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) -> %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 -loop(Parent, Debug, #{hibernate := Hibernate} = S) -> - case Hibernate of - true -> - %% Does not return but restarts process at - %% wakeup_from_hibernate/3 that jumps to loop_receive/3 - proc_lib:hibernate( - ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), - error( - {should_not_have_arrived_here_but_instead_in, - {wakeup_from_hibernate,3}}); - false -> - loop_receive(Parent, Debug, S) - end. +loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) -> + loop_hibernate(Parent, Debug, S); +loop(Parent, Debug, S) -> + loop_receive(Parent, Debug, S). + +loop_hibernate(Parent, Debug, S) -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive( - Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> +loop_receive(Parent, Debug, S) -> receive Msg -> case Msg of @@ -821,30 +854,87 @@ loop_receive( %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( - Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + Req, Pid, Parent, ?MODULE, Debug, S, + Hibernate); {'EXIT',Parent,Reason} = EXIT -> - %% EXIT is not a 2-tuple and therefore - %% not an event and has no event_type(), - %% but this will stand out in the crash report... - terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + %% EXIT is not a 2-tuple therefore + %% not an event but this will stand out + %% in the crash report... + Q = [EXIT], + terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> + #{timer_refs := TimerRefs, + timer_types := TimerTypes, + hibernate := Hibernate} = S, case TimerRefs of #{TimerRef := TimerType} -> - Event = {TimerType,TimerMsg}, - %% Unregister the triggered timeout + %% We know of this timer; is it a running + %% timer or a timer being cancelled that + %% managed to send a late timeout message? + case TimerTypes of + #{TimerType := TimerRef} -> + %% The timer type maps back to this + %% timer ref, so it was a running timer + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewTimerTypes = + maps:remove(TimerType, TimerTypes), + loop_receive_result( + Parent, Debug, + S#{ + timer_refs := NewTimerRefs, + timer_types := NewTimerTypes}, + Hibernate, + Event); + _ -> + %% This was a late timeout message + %% from timer being cancelled, so + %% ignore it and expect a cancel_timer + %% msg shortly + loop_receive(Parent, Debug, S) + end; + _ -> + %% Not our timer; present it as an event + Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes), - Event); + Parent, Debug, S, Hibernate, Event) + end; + {cancel_timer,TimerRef,_} -> + #{timer_refs := TimerRefs, + cancel_timers := CancelTimers, + hibernate := Hibernate} = S, + case TimerRefs of + #{TimerRef := _} -> + %% We must have requested a cancel + %% of this timer so it is already + %% removed from TimerTypes + NewTimerRefs = + maps:remove(TimerRef, TimerRefs), + NewCancelTimers = CancelTimers - 1, + NewS = + S#{ + timer_refs := NewTimerRefs, + cancel_timers := NewCancelTimers}, + if + Hibernate =:= true, NewCancelTimers =:= 0 -> + %% No more cancel_timer msgs to expect; + %% we can hibernate + loop_hibernate(Parent, Debug, NewS); + NewCancelTimers >= 0 -> % Assert + loop_receive(Parent, Debug, NewS) + end; _ -> + %% Not our cancel_timer msg; + %% present it as an event Event = {info,Msg}, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, Event) + Parent, Debug, S, Hibernate, Event) end; _ -> + %% External msg + #{hibernate := Hibernate} = S, Event = case Msg of {'$gen_call',From,Request} -> @@ -855,208 +945,212 @@ loop_receive( {info,Msg} end, loop_receive_result( - Parent, Debug, S, - TimerRefs, TimerTypes, Event) + Parent, Debug, S, Hibernate, Event) end end. loop_receive_result( - Parent, Debug, #{state := State} = S, - TimerRefs, TimerTypes, Event) -> - %% The fields 'timer_refs', 'timer_types' and 'hibernate' - %% are now invalid in state map S - they will be recalculated - %% and restored when we return to loop/3 - %% + Parent, Debug, + #{state := State, + timer_types := TimerTypes, cancel_timers := CancelTimers} = S, + Hibernate, Event) -> + %% From now the 'hibernate' field in S is invalid + %% and will be restored when looping back + %% in loop_event_result/11 NewDebug = sys_debug(Debug, S, State, {in,Event}), - %% Here the queue of not yet handled events is created + %% Here is the queue of not yet handled events created Events = [], - Hibernate = false, - loop_event( - Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). + %% Cancel any running event timer + case + cancel_timer_by_type(timeout, TimerTypes, CancelTimers) + of + {_,CancelTimers} -> + %% No timer cancelled + loop_event(Parent, NewDebug, S, Events, Event, Hibernate); + {NewTimerTypes,NewCancelTimers} -> + %% The timer is removed from NewTimerTypes but + %% remains in TimerRefs until we get + %% the cancel_timer msg + NewS = + S#{ + timer_types := NewTimerTypes, + cancel_timers := NewCancelTimers}, + loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate) + end. %% Entry point for handling an event, received or enqueued loop_event( - Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Parent, Debug, + #{state := State, data := Data} = S, Events, {Type,Content} = Event, Hibernate) -> %% - %% If Hibernate is true here it can only be + %% If (this old) Hibernate is true here it can only be %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user %% might rely on i.e collect garbage which %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), case call_state_function(S, Type, Content, State, Data) of {ok,Result,NewS} -> - %% Cancel event timeout - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type( - timeout, TimerRefs, TimerTypes), - {NewData,NextState,Actions} = + {NextState,NewData,Actions,EnterCall} = parse_event_result( - true, Debug, NewS, Result, - Events, Event, State, Data), + true, Debug, NewS, + Events, Event, State, Data, Result), loop_event_actions( - Parent, Debug, S, NewTimerRefs, NewTimerTypes, - Events, Event, NextState, NewData, Actions); + Parent, Debug, NewS, + Events, Event, NextState, NewData, Actions, EnterCall); {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) + Class, Reason, Stacktrace, Debug, S, + [Event|Events]) end. loop_event_actions( Parent, Debug, - #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, Actions) -> + #{state := State, state_enter := StateEnter} = S, + Events, Event, NextState, NewData, + Actions, EnterCall) -> + %% Hibernate is reborn here as false being + %% the default value from parse_actions/4 case parse_actions(Debug, S, State, Actions) of {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> if - StateEnter, NextState =/= State -> + StateEnter, EnterCall -> loop_event_enter( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR); - StateEnter -> - case maps:is_key(init_state, S) of - true -> - %% Avoid infinite loop in initial state - %% with state entry events - NewS = maps:remove(init_state, S), - loop_event_enter( - Parent, NewDebug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; true -> loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, + Parent, NewDebug, S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{data := NewData}, [Event|Events]) + Class, Reason, Stacktrace, Debug, S, + [Event|Events]) end. loop_event_enter( - Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Parent, Debug, #{state := State} = S, Events, Event, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> case call_state_function(S, enter, State, NextState, NewData) of {ok,Result,NewS} -> - {NewerData,_,Actions} = - parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData), - loop_event_enter_actions( - Parent, Debug, NewS, TimerRefs, TimerTypes, - Events, Event, NextState, NewerData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + case parse_event_result( + false, Debug, NewS, + Events, Event, NextState, NewData, Result) of + {_,NewerData,Actions,EnterCall} -> + loop_event_enter_actions( + Parent, Debug, NewS, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) + end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + hibernate := Hibernate}, [Event|Events]) end. loop_event_enter_actions( - Parent, Debug, S, TimerRefs, TimerTypes, + Parent, Debug, #{state_enter := StateEnter} = S, Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + Hibernate, TimeoutsR, Postpone, NextEventsR, + Actions, EnterCall) -> case parse_enter_actions( - Debug, S, NextState, Actions, - Hibernate, TimeoutsR) + Debug, S, NextState, Actions, Hibernate, TimeoutsR) of {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - loop_event_result( - Parent, NewDebug, S, TimerRefs, TimerTypes, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + if + StateEnter, EnterCall -> + loop_event_enter( + Parent, NewDebug, S, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + true -> + loop_event_result( + Parent, NewDebug, S, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR) + end; {Class,Reason,Stacktrace} -> terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, + Class, Reason, Stacktrace, Debug, + S#{ + state := NextState, + data := NewData, + hibernate := Hibernate}, [Event|Events]) end. loop_event_result( - Parent, Debug, - #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, - Events, Event, NextState, NewData, + Parent, Debug_0, + #{state := State, postponed := P_0, + timer_refs := TimerRefs_0, timer_types := TimerTypes_0, + cancel_timers := CancelTimers_0} = S_0, + Events_0, Event_0, NextState, NewData, Hibernate, TimeoutsR, Postpone, NextEventsR) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {NewDebug,P_1} = % Move current event to postponed if Postpone + {Debug_1,P_1} = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug, S, State, {postpone,Event,State}), - [Event|P_0]}; + {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), + [Event_0|P_0]}; false -> - {sys_debug(Debug, S, State, {consume,Event,State}), + {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), P_0} end, - {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = %% Move all postponed events to queue and cancel the %% state timeout if the state changes if NextState =:= State -> - {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; true -> - {lists:reverse(P_1, Events),[], + {lists:reverse(P_1, Events_0), + [], cancel_timer_by_type( - state_timeout, TimerRefs_0, TimerTypes_0)} + state_timeout, TimerTypes_0, CancelTimers_0)} + %% The state timer is removed from TimerTypes_1 + %% but remains in TimerRefs_0 until we get + %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,TimeoutEvents} = - %% Stop and start timers non-event timers - parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = + %% Stop and start non-event timers + parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), %% Place next events last in reversed queue Events_2R = lists:reverse(Events_1, NextEventsR), %% Enqueue immediate timeout events and start event timer - {NewTimerRefs,NewTimerTypes,Events_3R} = - process_timeout_events( - TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), - NewEvents = lists:reverse(Events_3R), - loop_events( - Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, - NewEvents, Hibernate, NextState, NewData, NewP). - -%% Loop until out of enqueued events -%% -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, - [] = _Events, Hibernate, State, Data, P) -> - %% Update S and loop back to loop/3 to receive a new event - NewS = - S#{ - state := State, - data := Data, - postponed := P, - hibernate => Hibernate, - timer_refs => TimerRefs, - timer_types => TimerTypes}, - loop(Parent, Debug, NewS); -loop_events( - Parent, Debug, S, TimerRefs, TimerTypes, - [Event|Events], Hibernate, State, Data, P) -> - %% Update S and continue with enqueued events - NewS = - S#{ - state := State, - data := Data, - postponed := P}, - loop_event( - Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). - + Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R), + S_1 = + S_0#{ + state := NextState, + data := NewData, + postponed := P_2, + timer_refs := TimerRefs_2, + timer_types := TimerTypes_2, + cancel_timers := CancelTimers_2, + hibernate := Hibernate}, + case lists:reverse(Events_3R) of + [] -> + %% Get a new event + loop(Parent, Debug_1, S_1); + [Event|Events] -> + %% Loop until out of enqueued events + loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + end. %%--------------------------------------------------------------------------- @@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) -> catch CallbackMode -> callback_mode_result(S, CallbackMode); - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,callback_mode,[]=Args,_} - |Stacktrace] -> - {error, - {undef_callback,{Module,callback_mode,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. @@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) -> call_state_function( - #{callback_mode := undefined} = S, - Type, Content, State, Data) -> + #{callback_mode := undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of {ok,NewS} -> call_state_function(NewS, Type, Content, State, Data); @@ -1135,13 +1215,12 @@ call_state_function( Error end; call_state_function( - #{callback_mode := CallbackMode, - module := Module} = S, + #{callback_mode := CallbackMode, module := Module} = S, Type, Content, State, Data) -> try case CallbackMode of state_functions -> - erlang:apply(Module, State, [Type,Content,Data]); + Module:State(Type, Content, Data); handle_event_function -> Module:handle_event(Type, Content, State, Data) end @@ -1151,41 +1230,6 @@ call_state_function( catch Result -> {ok,Result,S}; - error:badarg -> - case erlang:get_stacktrace() of - [{erlang,apply, - [Module,State,[Type,Content,Data]=Args], - _} - |Stacktrace] - when CallbackMode =:= state_functions -> - %% We get here e.g if apply fails - %% due to State not being an atom - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - Stacktrace -> - {error,badarg,Stacktrace} - end; - error:undef -> - %% Process undef to check for the simple mistake - %% of calling a nonexistent state function - %% to make the undef more precise - case erlang:get_stacktrace() of - [{Module,State,[Type,Content,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= state_functions -> - {error, - {undef_state_function,{Module,State,Args}}, - Stacktrace}; - [{Module,handle_event,[Type,Content,State,Data]=Args,_} - |Stacktrace] - when CallbackMode =:= handle_event_function -> - {error, - {undef_state_function,{Module,handle_event,Args}}, - Stacktrace}; - Stacktrace -> - {error,undef,Stacktrace} - end; Class:Reason -> {Class,Reason,erlang:get_stacktrace()} end. @@ -1193,65 +1237,83 @@ call_state_function( %% Interpret all callback return variants parse_event_result( - AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> + AllowStateChange, Debug, S, + Events, Event, State, Data, Result) -> case Result of stop -> terminate( - exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, normal, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]); {stop,Reason,NewData} -> terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, [Event|Events]); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := NewData}, + [Event|Events]); + %% {stop_and_reply,Reason,Replies} -> - Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events], Replies); {stop_and_reply,Reason,Replies,NewData} -> - Q = [Event|Events], reply_then_terminate( - exit, Reason, ?STACKTRACE(), - Debug, S#{data := NewData}, Q, Replies); + exit, Reason, ?STACKTRACE(), Debug, + S#{state := State, data := NewData}, + [Event|Events], Replies); + %% {next_state,State,NewData} -> - {NewData,State,[]}; + {State,NewData,[],false}; {next_state,NextState,NewData} when AllowStateChange -> - {NewData,NextState,[]}; + {NextState,NewData,[],true}; {next_state,State,NewData,Actions} -> - {NewData,State,Actions}; + {State,NewData,Actions,false}; {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NewData,NextState,Actions}; + {NextState,NewData,Actions,true}; + %% {keep_state,NewData} -> - {NewData,State,[]}; + {State,NewData,[],false}; {keep_state,NewData,Actions} -> - {NewData,State,Actions}; + {State,NewData,Actions,false}; keep_state_and_data -> - {Data,State,[]}; + {State,Data,[],false}; {keep_state_and_data,Actions} -> - {Data,State,Actions}; + {State,Data,Actions,false}; + %% + {repeat_state,NewData} -> + {State,NewData,[],true}; + {repeat_state,NewData,Actions} -> + {State,NewData,Actions,true}; + repeat_state_and_data -> + {State,Data,[],true}; + {repeat_state_and_data,Actions} -> + {State,Data,Actions,true}; + %% _ -> terminate( error, {bad_return_from_state_function,Result}, - ?STACKTRACE(), - Debug, S, [Event|Events]) + ?STACKTRACE(), Debug, + S#{state := State, data := Data}, + [Event|Events]) end. -parse_enter_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR) -> +parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> Postpone = forbidden, NextEventsR = forbidden, parse_actions( Debug, S, State, listify(Actions), Hibernate, TimeoutsR, Postpone, NextEventsR). - + parse_actions(Debug, S, State, Actions) -> Hibernate = false, - TimeoutsR = [], + TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer Postpone = false, NextEventsR = [], parse_actions( @@ -1279,64 +1341,29 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; + %% %% Actions that set options {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, NewHibernate, TimeoutsR, Postpone, NextEventsR); - {hibernate,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; hibernate -> + NewHibernate = true, parse_actions( Debug, S, State, Actions, - true, TimeoutsR, Postpone, NextEventsR); - {state_timeout,Time,_} = StateTimeout - when is_integer(Time), Time >= 0; - Time =:= infinity -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); - {state_timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - {timeout,infinity,_} -> - %% Ignore - timeout will never happen and already cancelled - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); - {timeout,_,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; - infinity -> % Ignore - timeout will never happen - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - Time when is_integer(Time), Time >= 0 -> - Timeout = {timeout,Time,Time}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); + NewHibernate, TimeoutsR, Postpone, NextEventsR); + %% {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, Hibernate, TimeoutsR, NewPostpone, NextEventsR); - {postpone,_} -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()}; postpone when Postpone =/= forbidden -> + NewPostpone = true, parse_actions( Debug, S, State, Actions, - Hibernate, TimeoutsR, true, NextEventsR); + Hibernate, TimeoutsR, NewPostpone, NextEventsR); + %% {next_event,Type,Content} -> case event_type(Type) of true when NextEventsR =/= forbidden -> @@ -1351,96 +1378,150 @@ parse_actions( {bad_action_from_state_function,Action}, ?STACKTRACE()} end; - _ -> + %% + {state_timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + {timeout,_,_} = Timeout -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); + Time -> + parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Time) + end. + +parse_actions_timeout( + Debug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> + Time = + case Timeout of + {_,T,_} -> T; + T -> T + end, + case validate_time(Time) of + true -> + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|TimeoutsR], + Postpone, NextEventsR); + false -> {error, - {bad_action_from_state_function,Action}, + {bad_action_from_state_function,Timeout}, ?STACKTRACE()} end. +validate_time(Time) when is_integer(Time), Time >= 0 -> true; +validate_time(infinity) -> true; +validate_time(_) -> false. %% Stop and start timers as well as create timeout zero events %% and pending event timer %% %% Stop and start timers non-event timers -parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). %% -parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> - {TimerType,Time,TimerMsg} = Timeout, + TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], + Seen, TimeoutEvents) -> + case Timeout of + {TimerType,Time,TimerMsg} -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg); + Time -> + parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + timeout, Time, Time) + end. + +parse_timers( + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents, + TimerType, Time, TimerMsg) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + TimerRefs, TimerTypes, CancelTimers, TimeoutsR, + Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, - %% Cancel any running timer - {NewTimerRefs,NewTimerTypes} = - cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), - if - Time =:= infinity -> - %% Ignore - timer will never fire + case Time of + infinity -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, TimeoutEvents); - TimerType =:= timeout -> - %% Handle event timer later - parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, - NewSeen, [Timeout|TimeoutEvents]); - Time =:= 0 -> + 0 -> + %% Cancel any running timer + {NewTimerTypes,NewCancelTimers} = + cancel_timer_by_type( + TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - NewTimerRefs, NewTimerTypes, TimeoutsR, + TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, NewSeen, [TimeoutEvent|TimeoutEvents]); - true -> - %% Start a new timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - parse_timers( - NewTimerRefs#{TimerRef => TimerType}, - NewTimerTypes#{TimerType => TimerRef}, - TimeoutsR, NewSeen, TimeoutEvents) + _ -> + %% (Re)start the timer + TimerRef = + erlang:start_timer(Time, self(), TimerMsg), + case TimerTypes of + #{TimerType := OldTimerRef} -> + %% Cancel the running timer + cancel_timer(OldTimerRef), + NewCancelTimers = CancelTimers + 1, + %% Insert the new timer into + %% both TimerRefs and TimerTypes + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + NewCancelTimers, TimeoutsR, + NewSeen, TimeoutEvents); + #{} -> + parse_timers( + TimerRefs#{TimerRef => TimerType}, + TimerTypes#{TimerType => TimerRef}, + CancelTimers, TimeoutsR, + NewSeen, TimeoutEvents) + end end end. -%% Enqueue immediate timeout events and start event timer -process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> - {TimerRefs, TimerTypes, EventsR}; -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,0,TimerMsg}|TimeoutEvents], []) -> - %% No enqueued events - insert a timeout zero event - TimeoutEvent = {timeout,TimerMsg}, - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent]); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,Time,TimerMsg}], []) -> - %% No enqueued events - start event timer - TimerRef = erlang:start_timer(Time, self(), TimerMsg), - process_timeout_events( - TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, - [], []); -process_timeout_events( - TimerRefs, TimerTypes, - [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> - %% There will be some other event so optimize by not starting - %% an event timer to just have to cancel it again - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, EventsR); -process_timeout_events( - TimerRefs, TimerTypes, - [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> - process_timeout_events( - TimerRefs, TimerTypes, - TimeoutEvents, [TimeoutEvent|EventsR]). +%% Enqueue immediate timeout events (timeout 0 events) +%% +%% Event timer timeout 0 events gets special treatment since +%% an event timer is cancelled by any received event, +%% so if there are enqueued events before the event timer +%% timeout 0 event - the event timer is cancelled hence no event. +%% +%% Other (state_timeout) timeout 0 events that are after +%% the event timer timeout 0 events are considered to +%% belong to timers that were started after the event timer +%% timeout 0 event fired, so they do not cancel the event timer. +%% +prepend_timeout_events([], EventsR) -> + EventsR; +prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> + prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); +prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + prepend_timeout_events(TimeoutEvents, EventsR); +prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> + %% Just prepend all others + prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]). @@ -1448,18 +1529,11 @@ process_timeout_events( %% Server helpers reply_then_terminate( - Class, Reason, Stacktrace, - Debug, #{state := State} = S, Q, Replies) -> - if - is_list(Replies) -> - do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, Replies, State); - true -> - do_reply_then_terminate( - Class, Reason, Stacktrace, - Debug, S, Q, [Replies], State) - end. + Class, Reason, Stacktrace, Debug, + #{state := State} = S, Q, Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, + S, Q, listify(Replies), State). %% do_reply_then_terminate( Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> @@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) -> terminate( - Class, Reason, Stacktrace, - Debug, + Class, Reason, Stacktrace, Debug, #{module := Module, state := State, data := Data, postponed := P} = S, Q) -> - try Module:terminate(Reason, State, Data) of - _ -> ok - catch - _ -> ok; - C:R -> - ST = erlang:get_stacktrace(), - error_info( - C, R, ST, S, Q, P, - format_status(terminate, get(), S)), - sys:print_log(Debug), - erlang:raise(C, R, ST) + case erlang:function_exported(Module, terminate, 3) of + true -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), + erlang:raise(C, R, ST) + end; + false -> + ok end, _ = case Reason of @@ -1637,28 +1715,21 @@ listify(Item) -> [Item]. %% Cancel timer if running, otherwise no op -cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> +%% +%% This is an asynchronous cancel so the timer is not really cancelled +%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}. +%% In the mean time we might get a timeout message. +%% +%% Remove the timer from TimerTypes. +%% When we get the cancel_timer msg we remove it from TimerRefs. +cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> case TimerTypes of #{TimerType := TimerRef} -> cancel_timer(TimerRef), - {maps:remove(TimerRef, TimerRefs), - maps:remove(TimerType, TimerTypes)}; + {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerRefs,TimerTypes} + {TimerTypes,CancelTimers} end. -%%cancel_timer(undefined) -> -%% ok; -cancel_timer(TRef) -> - case erlang:cancel_timer(TRef) of - false -> - %% We have to assume that TRef is the ref of a running timer - %% and if so the timer has expired - %% hence we must wait for the timeout message - receive - {timeout,TRef,_} -> - ok - end; - _TimeLeft -> - ok - end. +cancel_timer(TimerRef) -> + ok = erlang:cancel_timer(TimerRef, [{async,true}]). diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f3665824f2..8c4d835432 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> end; abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) -> {special, Line, lists:flatten(io_lib:write(PPR))}; +abstr_term(Map, Line) when is_map(Map) -> + {map,Line, + [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} || + {K,V} <- maps:to_list(Map)]}; abstr_term(Simple, Line) -> erl_parse:abstract(Simple, erl_anno:line(Line)). diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index 340cc21390..fadf96146e 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -179,19 +179,6 @@ external_attr, local_header_offset}). -%% Unix extra fields (not yet supported) --define(UNIX_EXTRA_FIELD_TAG, 16#000d). --record(unix_extra_field, {atime, - mtime, - uid, - gid}). - -%% extended timestamps (not yet supported) --define(EXTENDED_TIMESTAMP_TAG, 16#5455). -%% -record(extended_timestamp, {mtime, -%% atime, -%% ctime}). - -define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50). -define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)). @@ -381,9 +368,12 @@ do_unzip(F, Options) -> {Info, In1} = get_central_dir(In0, RawIterator, Input), %% get rid of zip-comment Z = zlib:open(), - Files = get_z_files(Info, Z, In1, Opts, []), - zlib:close(Z), - Input(close, In1), + Files = try + get_z_files(Info, Z, In1, Opts, []) + after + zlib:close(Z), + Input(close, In1) + end, {ok, Files}. %% Iterate over all files in a zip archive @@ -460,11 +450,20 @@ do_zip(F, Files, Options) -> #zip_opts{output = Output, open_opts = OpO} = Opts, Out0 = Output({open, F, OpO}, []), Z = zlib:open(), - {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []), - zlib:close(Z), - Out2 = put_central_dir(LHS, Pos, Out1, Opts), - Out3 = Output({close, F}, Out2), - {ok, Out3}. + try + {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []), + zlib:close(Z), + Out2 = put_central_dir(LHS, Pos, Out1, Opts), + Out3 = Output({close, F}, Out2), + {ok, Out3} + catch + C:R -> + Stk = erlang:get_stacktrace(), + zlib:close(Z), + Output({close, F}, Out0), + erlang:raise(C, R, Stk) + end. + %% List zip directory contents %% @@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName, gid = 0}, add_extra_info(FI, ExtraField). -%% add extra info to file (some day when we implement it) -add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) -> - FI; % not yet supported, some other day... -add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) -> - _UnixExtra = unix_extra_field_and_var_from_bin(Rest), - FI; % not yet supported, and not widely used +%% Currently, we ignore all the extra fields. add_extra_info(FI, _) -> FI. @@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) -> <<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>, {DosDate, DosTime}. -unix_extra_field_and_var_from_bin(<<TSize:16/little, - ATime:32/little, - MTime:32/little, - UID:16/little, - GID:16/little, - Var:TSize/binary>>) -> - {#unix_extra_field{atime = ATime, - mtime = MTime, - uid = UID, - gid = GID}, - Var}; -unix_extra_field_and_var_from_bin(_) -> - throw(bad_unix_extra_field). - %% A pwrite-like function for iolists (used by memory-option) pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 8f2ba0cab2..ac27c9fc79 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -38,7 +38,7 @@ all() -> {group, abnormal}, {group, abnormal_handle_event}, shutdown, stop_and_reply, state_enter, event_order, - state_timeout, code_change, + state_timeout, event_types, code_change, {group, sys}, hibernate, enter_loop]. @@ -600,15 +600,26 @@ state_enter(_Config) -> (internal, Prev, N) -> Self ! {internal,start,Prev,N}, {keep_state,N + 1}; + ({call,From}, repeat, N) -> + {repeat_state,N + 1, + [{reply,From,{repeat,start,N}}]}; ({call,From}, echo, N) -> - {next_state,wait,N + 1,{reply,From,{echo,start,N}}}; + {next_state,wait,N + 1, + {reply,From,{echo,start,N}}}; ({call,From}, {stop,Reason}, N) -> - {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1} + {stop_and_reply,Reason, + [{reply,From,{stop,N}}],N + 1} end, wait => - fun (enter, Prev, N) -> + fun (enter, Prev, N) when N < 5 -> + {repeat_state,N + 1, + {reply,{Self,N},{enter,Prev}}}; + (enter, Prev, N) -> Self ! {enter,wait,Prev,N}, {keep_state,N + 1}; + ({call,From}, repeat, N) -> + {repeat_state_and_data, + [{reply,From,{repeat,wait,N}}]}; ({call,From}, echo, N) -> {next_state,start,N + 1, [{next_event,internal,wait}, @@ -620,11 +631,15 @@ state_enter(_Config) -> [{enter,start,start,1}] = flush(), {echo,start,2} = gen_statem:call(STM, echo), - [{enter,wait,start,3}] = flush(), - {wait,[4|_]} = sys:get_state(STM), - {echo,wait,4} = gen_statem:call(STM, echo), - [{enter,start,wait,5},{internal,start,wait,6}] = flush(), - {stop,7} = gen_statem:call(STM, {stop,bye}), + [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(), + {wait,[6|_]} = sys:get_state(STM), + {repeat,wait,6} = gen_statem:call(STM, repeat), + [{enter,wait,wait,6}] = flush(), + {echo,wait,7} = gen_statem:call(STM, echo), + [{enter,start,wait,8},{internal,start,wait,9}] = flush(), + {repeat,start,10} = gen_statem:call(STM, repeat), + [{enter,start,start,11}] = flush(), + {stop,12} = gen_statem:call(STM, {stop,bye}), [{'EXIT',STM,bye}] = flush(), {noproc,_} = @@ -801,6 +816,74 @@ state_timeout(_Config) -> +%% Test that all event types can be sent with {next_event,EventType,_} +event_types(_Config) -> + process_flag(trap_exit, true), + + Machine = + %% Abusing the internal format of From... + #{init => + fun () -> + {ok, start, undefined} + end, + start => + fun ({call,_} = Call, Req, undefined) -> + {next_state, state1, undefined, + [{next_event,internal,1}, + {next_event,state_timeout,2}, + {next_event,timeout,3}, + {next_event,info,4}, + {next_event,cast,5}, + {next_event,Call,Req}]} + end, + state1 => + fun (internal, 1, undefined) -> + {next_state, state2, undefined} + end, + state2 => + fun (state_timeout, 2, undefined) -> + {next_state, state3, undefined} + end, + state3 => + fun (timeout, 3, undefined) -> + {next_state, state4, undefined} + end, + state4 => + fun (info, 4, undefined) -> + {next_state, state5, undefined} + end, + state5 => + fun (cast, 5, undefined) -> + {next_state, state6, undefined} + end, + state6 => + fun ({call,From}, stop, undefined) -> + {stop_and_reply, shutdown, + [{reply,From,stopped}]} + end}, + {ok,STM} = + gen_statem:start_link( + ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]), + + stopped = gen_statem:call(STM, stop), + receive + {'EXIT',STM,shutdown} -> + ok + after 500 -> + ct:fail(did_not_stop) + end, + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason), + case flush() of + [] -> + ok; + Other2 -> + ct:fail({unexpected,Other2}) + end. + + + sys1(Config) -> {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), {status, Pid, {module,gen_statem}, _} = sys:get_status(Pid), @@ -1722,6 +1805,10 @@ handle_event( {keep_state,[NewData|Machine]}; {keep_state,NewData,Ops} -> {keep_state,[NewData|Machine],Ops}; + {repeat_state,NewData} -> + {repeat_state,[NewData|Machine]}; + {repeat_state,NewData,Ops} -> + {repeat_state,[NewData|Machine],Ops}; Other -> Other end; diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index c08e138ad3..2b5d52287e 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% Copyright Ericsson AB 2004-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. @@ -886,11 +886,12 @@ eval_unique(Config) when is_list(Config) -> [a] = qlc:e(Q2, {unique_all, true}) ">>, - <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)], + <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]], + unique)], unique), {call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} = qlc:info(Q, [{format,abstract_code},unique_all]), - [1,2] = qlc:e(Q)">>, + [1,2,#{a := 1}] = qlc:e(Q)">>, <<"Q = qlc:q([X || X <- [1,2,1]]), {call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} = @@ -2637,7 +2638,16 @@ info(Config) when is_list(Config) -> {cons, _, _, _}]}, {nil,_}}]}]} = i(QH, {format, abstract_code}), [{5},{6}] = qlc:e(QH), - [{4},{5},{6}] = qlc:e(F(3))">> + [{4},{5},{6}] = qlc:e(F(3))">>, + + <<"Fun = fun ?MODULE:i/2, + L = [{#{k => #{v => Fun}}, Fun}], + H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]), + L = qlc:e(H), + {call,_,_,[{lc,_,{var,_,'Q'}, + [{generate,_,_,_}, + {op,_,_,_,_}]}]} = + qlc:info(H, [{format,abstract_code}])">> ], run(Config, Ts), diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 7d90795c9e..f0feda217a 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -27,7 +27,7 @@ openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1, unzip_traversal_exploit/1, compress_control/1, - foldl/1]). + foldl/1,fd_leak/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -40,7 +40,7 @@ all() -> unzip_to_binary, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, zip_api, open_leak, unzip_jar, compress_control, foldl, - unzip_traversal_exploit]. + unzip_traversal_exploit,fd_leak]. groups() -> []. @@ -882,3 +882,35 @@ foldl(Config) -> {error, enoent} = zip:foldl(ZipFun, [], File), ok. + +fd_leak(Config) -> + ok = file:set_cwd(proplists:get_value(priv_dir, Config)), + DataDir = proplists:get_value(data_dir, Config), + Name = filename:join(DataDir, "bad_file_header.zip"), + BadExtract = fun() -> + {error,bad_file_header} = zip:extract(Name), + ok + end, + do_fd_leak(BadExtract, 1), + + BadCreate = fun() -> + {error,enoent} = zip:zip("failed.zip", + ["none"]), + ok + end, + do_fd_leak(BadCreate, 1), + + ok. + +do_fd_leak(_Bad, 10000) -> + ok; +do_fd_leak(Bad, N) -> + try Bad() of + ok -> + do_fd_leak(Bad, N + 1) + catch + C:R -> + Stk = erlang:get_stacktrace(), + io:format("Bad error after ~p attempts\n", [N]), + erlang:raise(C, R, Stk) + end. diff --git a/lib/tools/doc/src/make.xml b/lib/tools/doc/src/make.xml index fddf5ebd7b..6b878f72fb 100644 --- a/lib/tools/doc/src/make.xml +++ b/lib/tools/doc/src/make.xml @@ -43,15 +43,15 @@ <fsummary>Compile a set of modules.</fsummary> <type> <v>Options = [Option]</v> - <v> Option = noexec | load | netload | <compiler option></v> + <v> Option = noexec | load | netload | {emake, Emake} | <compiler option></v> </type> <desc> - <p>This function first looks in the current working directory - for a file named <c>Emakefile</c> (see below) specifying the - set of modules to compile and the compile options to use. If - no such file is found, the set of modules to compile - defaults to all modules in the current working - directory.</p> + <p>This function determines the set of modules to compile and the + compile options to use, by first looking for the <c>emake</c> make + option, if not present reads the configuration from a file named + <c>Emakefile</c> (see below). If no such file is found, the + set of modules to compile defaults to all modules in the + current working directory.</p> <p>Traversing the set of modules, it then recompiles every module for which at least one of the following conditions apply:</p> <list type="bulleted"> @@ -77,6 +77,9 @@ <item><c>netload</c> <br></br> Net load mode. Loads all recompiled modules on all known nodes.</item> + <item><c>{emake, Emake}</c> <br></br> + + Rather than reading the <c>Emakefile</c> specify configuration explicitly.</item> </list> <p>All items in <c>Options</c> that are not make options are assumed to be compiler options and are passed as-is to @@ -108,9 +111,10 @@ <section> <title>Emakefile</title> - <p><c>make:all/0,1</c> and <c>make:files/1,2</c> looks in the - current working directory for a file named <c>Emakefile</c>. If - it exists, <c>Emakefile</c> should contain elements like this:</p> + <p><c>make:all/0,1</c> and <c>make:files/1,2</c> first looks for + <c>{emake, Emake}</c> in options, then in the current working directory + for a file named <c>Emakefile</c>. If present <c>Emake</c> should + contain elements like this:</p> <code type="none"> Modules. {Modules,Options}. </code> diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index eeba7f34e9..bdb3d9ad4a 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010-2016. All Rights Reserved. +;; Copyright Ericsson AB 2010-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. @@ -915,11 +915,7 @@ Please see the function `tempo-define-template'.") "%% process to initialize." n (erlang-skel-separator-end 2) "-spec init(Args :: term()) ->" n> - "{ok, State :: term(), Data :: term()} |" n> - "{ok, State :: term(), Data :: term()," n> - "[gen_statem:action()] | gen_statem:action()} |" n> - "ignore |" n> - "{stop, Reason :: term()}." n + "gen_statem:init_result(atom())." n "init([]) ->" n> "process_flag(trap_exit, true)," n> "{ok, state_name, #data{}}." n @@ -1028,11 +1024,7 @@ Please see the function `tempo-define-template'.") "%% process to initialize." n (erlang-skel-separator-end 2) "-spec init(Args :: term()) ->" n> - "{ok, State :: term(), Data :: term()} |" n> - "{ok, State :: term(), Data :: term()," n> - "[gen_statem:action()] | gen_statem:action()} |" n> - "ignore |" n> - "{stop, Reason :: term()}." n + "gen_statem:init_result(term())." n "init([]) ->" n> "process_flag(trap_exit, true)," n> "{ok, state_name, #data{}}." n diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index e1fd661348..348800f880 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -407,7 +407,7 @@ up the indexing." (defvar erldoc-user-guides nil) (defvar erldoc-missing-user-guides - '("compiler" "hipe" "kernel" "os_mon" "parsetools" "typer") + '("compiler" "hipe" "kernel" "os_mon" "parsetools") "List of standard Erlang applications with no user guides.") ;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name @@ -417,7 +417,7 @@ up the indexing." "runtime_tools" "sasl" "snmp" "ssl" "test_server" ("ssh" . "SSH") ("stdlib" . "STDLIB") - ("hipe" . "HiPE") ("typer" . "TypEr")) + ("hipe" . "HiPE")) "List of applications that come with a manual.") (defun erldoc-user-guide-chapters (user-guide) diff --git a/lib/tools/examples/xref_examples.erl b/lib/tools/examples/xref_examples.erl index 4c082195a2..f7e71c9708 100644 --- a/lib/tools/examples/xref_examples.erl +++ b/lib/tools/examples/xref_examples.erl @@ -7,7 +7,7 @@ %% ${HOME}/unused_locals.txt. script() -> Root = code:root_dir(), - Dir = os:getenv("HOME"), + {ok,[[Dir]]} = init:get_argument(home), Server = s, xref:start(Server), {ok, _Relname} = xref:add_release(Server, code:lib_dir(), {name,otp}), diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl index 37e67cbe34..60695febb4 100644 --- a/lib/tools/src/make.erl +++ b/lib/tools/src/make.erl @@ -29,7 +29,7 @@ -include_lib("kernel/include/file.hrl"). --define(MakeOpts,[noexec,load,netload,noload]). +-define(MakeOpts,[noexec,load,netload,noload,emake]). all_or_nothing() -> case all() of @@ -43,29 +43,30 @@ all() -> all([]). all(Options) -> - {MakeOpts,CompileOpts} = sort_options(Options,[],[]), - case read_emakefile('Emakefile',CompileOpts) of - Files when is_list(Files) -> - do_make_files(Files,MakeOpts); - error -> - error - end. + run_emake(undefined, Options). files(Fs) -> files(Fs, []). files(Fs0, Options) -> Fs = [filename:rootname(F,".erl") || F <- Fs0], + run_emake(Fs, Options). + +run_emake(Mods, Options) -> {MakeOpts,CompileOpts} = sort_options(Options,[],[]), - case get_opts_from_emakefile(Fs,'Emakefile',CompileOpts) of + Emake = get_emake(Options), + case normalize_emake(Emake, Mods, CompileOpts) of Files when is_list(Files) -> - do_make_files(Files,MakeOpts); - error -> error + do_make_files(Files,MakeOpts); + error -> + error end. do_make_files(Fs, Opts) -> process(Fs, lists:member(noexec, Opts), load_opt(Opts)). +sort_options([{emake, _}=H|T],Make,Comp) -> + sort_options(T,[H|Make],Comp); sort_options([H|T],Make,Comp) -> case lists:member(H,?MakeOpts) of @@ -89,20 +90,35 @@ sort_options([],Make,Comp) -> %%% %%% These elements are converted to [{ModList,OptList},...] %%% ModList is a list of modulenames (strings) -read_emakefile(Emakefile,Opts) -> - case file:consult(Emakefile) of - {ok,Emake} -> + +normalize_emake(EmakeRaw, Mods, Opts) -> + case EmakeRaw of + {ok, Emake} when Mods =:= undefined -> transform(Emake,Opts,[],[]); - {error,enoent} -> + {ok, Emake} when is_list(Mods) -> + ModsOpts = transform(Emake,Opts,[],[]), + ModStrings = [coerce_2_list(M) || M <- Mods], + get_opts_from_emakefile(ModsOpts,ModStrings,Opts,[]); + {error,enoent} when Mods =:= undefined -> %% No Emakefile found - return all modules in current %% directory and the options given at command line - Mods = [filename:rootname(F) || F <- filelib:wildcard("*.erl")], + CwdMods = [filename:rootname(F) || F <- filelib:wildcard("*.erl")], + [{CwdMods, Opts}]; + {error,enoent} when is_list(Mods) -> [{Mods, Opts}]; - {error,Other} -> - io:format("make: Trouble reading 'Emakefile':~n~tp~n",[Other]), + {error, Error} -> + io:format("make: Trouble reading 'Emakefile':~n~tp~n",[Error]), error end. +get_emake(Opts) -> + case proplists:get_value(emake, Opts, false) of + false -> + file:consult('Emakefile'); + OptsEmake -> + {ok, OptsEmake} + end. + transform([{Mod,ModOpts}|Emake],Opts,Files,Already) -> case expand(Mod,Already) of [] -> @@ -143,31 +159,19 @@ expand(Mod,Already) -> end end. -%%% Reads the given Emakefile to see if there are any specific compile +%%% Reads the given Emake to see if there are any specific compile %%% options given for the modules. -get_opts_from_emakefile(Mods,Emakefile,Opts) -> - case file:consult(Emakefile) of - {ok,Emake} -> - Modsandopts = transform(Emake,Opts,[],[]), - ModStrings = [coerce_2_list(M) || M <- Mods], - get_opts_from_emakefile2(Modsandopts,ModStrings,Opts,[]); - {error,enoent} -> - [{Mods, Opts}]; - {error,Other} -> - io:format("make: Trouble reading 'Emakefile':~n~tp~n",[Other]), - error - end. -get_opts_from_emakefile2([{MakefileMods,O}|Rest],Mods,Opts,Result) -> +get_opts_from_emakefile([{MakefileMods,O}|Rest],Mods,Opts,Result) -> case members(Mods,MakefileMods,[],Mods) of {[],_} -> - get_opts_from_emakefile2(Rest,Mods,Opts,Result); + get_opts_from_emakefile(Rest,Mods,Opts,Result); {I,RestOfMods} -> - get_opts_from_emakefile2(Rest,RestOfMods,Opts,[{I,O}|Result]) + get_opts_from_emakefile(Rest,RestOfMods,Opts,[{I,O}|Result]) end; -get_opts_from_emakefile2([],[],_Opts,Result) -> +get_opts_from_emakefile([],[],_Opts,Result) -> Result; -get_opts_from_emakefile2([],RestOfMods,Opts,Result) -> +get_opts_from_emakefile([],RestOfMods,Opts,Result) -> [{RestOfMods,Opts}|Result]. members([H|T],MakefileMods,I,Rest) -> diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl index e6284db8b8..2a94ead329 100644 --- a/lib/tools/test/make_SUITE.erl +++ b/lib/tools/test/make_SUITE.erl @@ -20,7 +20,7 @@ -module(make_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, make_all/1, make_files/1]). + init_per_group/2,end_per_group/2, make_all/1, make_files/1, emake_opts/1]). -export([otp_6057_init/1, otp_6057_a/1, otp_6057_b/1, otp_6057_c/1, otp_6057_end/1]). @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [make_all, make_files, {group, otp_6057}]. + [make_all, make_files, emake_opts, {group, otp_6057}]. groups() -> [{otp_6057,[],[otp_6057_a, otp_6057_b, @@ -86,6 +86,20 @@ make_files(Config) when is_list(Config) -> ensure_no_messages(), ok. +emake_opts(Config) when is_list(Config) -> + Current = prepare_data_dir(Config), + + %% prove that emake is used in opts instead of local Emakefile + Opts = [{emake, [test8, test9]}], + error = make:all(Opts), + error = make:files([test9], Opts), + "test8.beam" = ensure_exists([test8]), + "test9.beam" = ensure_exists([test9]), + "test5.S" = ensure_exists(["test5"],".S"), + + file:set_cwd(Current), + ensure_no_messages(), + ok. %% Moves to the data directory of this suite, clean it from any object %% files (*.jam for a JAM emulator). Returns the previous directory. diff --git a/lib/typer/Makefile b/lib/typer/Makefile deleted file mode 100644 index bd1b6458a8..0000000000 --- a/lib/typer/Makefile +++ /dev/null @@ -1,44 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2006-2016. 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% -# -#============================================================================= -# -# File: lib/typer/Makefile -# Authors: Bingwen He, Tobias Lindahl, and Kostis Sagonas -# -#============================================================================= -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# -# Macros -# - -SUB_DIRECTORIES = src doc/src - -include vsn.mk -VSN = $(TYPER_VSN) - -SPECIAL_TARGETS = - -# -# Default Subdir Targets -# -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/typer/RELEASE_NOTES b/lib/typer/RELEASE_NOTES deleted file mode 100644 index d91a815ee9..0000000000 --- a/lib/typer/RELEASE_NOTES +++ /dev/null @@ -1,22 +0,0 @@ -============================================================================== - Major features, additions and changes between Typer versions - (in reversed chronological order) -============================================================================== - -Version 0.9 (in Erlang/OTP R14B02) ----------------------------------- - - Major rewrite; all code has been cleaned up and placed in one file. - The only reason why this is not version 1.0 yet is that there is no proper - documentation for typer which can be displayed in the www.erlang.org site. - - Added ability to receive the set of exported types and report unknown ones. - - Better handling of overloaded contracts; especially erroneous ones on which - typer does not crash anymore. - - Fixed problem that caused typer to hang when given a file whose module name - did not correspond to the file name. - - Added two undocumented options that may come very handy when trying to - understand why typer reports some particular set of types for the functions - in a module. These options are mainly for typer developers at this point, - but may become documented in some future version. - -Older versions --------------- diff --git a/lib/typer/doc/Makefile b/lib/typer/doc/Makefile deleted file mode 100644 index 1015ca78eb..0000000000 --- a/lib/typer/doc/Makefile +++ /dev/null @@ -1,40 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2006-2016. 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% -# -SHELL=/bin/sh - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -clean: - -rm -f *.html edoc-info stylesheet.css erlang.png - -distclean: clean -realclean: clean - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk diff --git a/lib/typer/doc/html/.gitignore b/lib/typer/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/typer/doc/html/.gitignore +++ /dev/null diff --git a/lib/typer/doc/pdf/.gitignore b/lib/typer/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/typer/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/typer/doc/src/Makefile b/lib/typer/doc/src/Makefile deleted file mode 100644 index 3724a2e4d1..0000000000 --- a/lib/typer/doc/src/Makefile +++ /dev/null @@ -1,118 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2006-2016. 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% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(TYPER_VSN) -APPLICATION=typer - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = - -XML_PART_FILES = part_notes.xml -XML_CHAPTER_FILES = notes.xml - -BOOK_FILES = book.xml - -XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) - -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -distclean: clean -realclean: clean - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - - -release_spec: diff --git a/lib/typer/doc/src/book.xml b/lib/typer/doc/src/book.xml deleted file mode 100644 index 20da44ae04..0000000000 --- a/lib/typer/doc/src/book.xml +++ /dev/null @@ -1,42 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>TypEr</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <pagetext></pagetext> - <preamble> - </preamble> - <pagetext>TypEr</pagetext> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> -</book> - diff --git a/lib/typer/doc/src/fascicules.xml b/lib/typer/doc/src/fascicules.xml deleted file mode 100644 index b15610fa8b..0000000000 --- a/lib/typer/doc/src/fascicules.xml +++ /dev/null @@ -1,12 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> - -<fascicules> - <fascicule file="part_notes" href="part_notes_frame.html" entry="yes"> - Release Notes - </fascicule> - <fascicule file="" href="../../../../doc/print.html" entry="no"> - Off-Print - </fascicule> -</fascicules> - diff --git a/lib/typer/doc/src/notes.xml b/lib/typer/doc/src/notes.xml deleted file mode 100644 index 9ef5ca1c70..0000000000 --- a/lib/typer/doc/src/notes.xml +++ /dev/null @@ -1,111 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>TypEr Release Notes</title> - <prepared>otp_appnotes</prepared> - <docno>nil</docno> - <date>nil</date> - <rev>nil</rev> - <file>notes.xml</file> - </header> - <p>This document describes the changes made to TypEr.</p> - -<section><title>TypEr 0.9.11</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Internal changes</p> - <p> - Own Id: OTP-13551</p> - </item> - </list> - </section> - -</section> - -<section><title>TypEr 0.9.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>Fix a bug that could result in a crash when printing - warnings onto standard error. </p> - <p> - Own Id: OTP-13010</p> - </item> - </list> - </section> - -</section> - -<section><title>TypEr 0.9.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Properly extract annotations from core code. </p> - <p> - Own Id: OTP-12727</p> - </item> - </list> - </section> - -</section> - -<section><title>TypEr 0.9.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> The name of a compiler option has been fixed in the - Makefile. </p> - <p> - Own Id: OTP-11996</p> - </item> - </list> - </section> - -</section> - -<section><title>TypEr 0.9.7</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Added initial documentation framework for TypEr.</p> - <p> - Own Id: OTP-11860</p> - </item> - </list> - </section> - -</section> - - - -</chapter> - diff --git a/lib/typer/doc/src/part_notes.xml b/lib/typer/doc/src/part_notes.xml deleted file mode 100644 index 3234f0903e..0000000000 --- a/lib/typer/doc/src/part_notes.xml +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2006</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>TypEr Release Notes</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <description> - <p><em>TypEr</em></p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/typer/doc/src/ref_man.xml b/lib/typer/doc/src/ref_man.xml deleted file mode 100644 index c793207443..0000000000 --- a/lib/typer/doc/src/ref_man.xml +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2014</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>TypEr</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>ref_man.xml</file> - </header> - <description> - </description> - <xi:include href="typer_app.xml"/> -</application> - diff --git a/lib/typer/doc/src/typer_app.xml b/lib/typer/doc/src/typer_app.xml deleted file mode 100644 index d52df5d0da..0000000000 --- a/lib/typer/doc/src/typer_app.xml +++ /dev/null @@ -1,44 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE appref SYSTEM "appref.dtd"> - -<appref> - <header> - <copyright> - <year>2014</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>TypEr</title> - <prepared></prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> - <file>typer.xml</file> - </header> - <app>TypEr</app> - <appsummary>The TypEr Application</appsummary> - <description> - <p>An Erlang/OTP application that shows type information - for Erlang modules to the user. Additionally, it can - annotate the code of files with such type information.</p> - </description> - -</appref> - diff --git a/lib/typer/ebin/.gitignore b/lib/typer/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/typer/ebin/.gitignore +++ /dev/null diff --git a/lib/typer/info b/lib/typer/info deleted file mode 100644 index 5145fbcfff..0000000000 --- a/lib/typer/info +++ /dev/null @@ -1,2 +0,0 @@ -group: tools -short: TypEr diff --git a/lib/typer/src/Makefile b/lib/typer/src/Makefile deleted file mode 100644 index 6c5d8b0726..0000000000 --- a/lib/typer/src/Makefile +++ /dev/null @@ -1,111 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2006-2016. 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% -# -#============================================================================= -# -# File: lib/typer/src/Makefile -# Authors: Kostis Sagonas -# -#============================================================================= - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(TYPER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/typer-$(VSN) - -# ---------------------------------------------------- -# Orientation information -- find dialyzer's dir -# ---------------------------------------------------- -DIALYZER_DIR = $(ERL_TOP)/lib/dialyzer - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -MODULES = typer - -HRL_FILES= -ERL_FILES= $(MODULES:%=%.erl) -INSTALL_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) -TARGET_FILES= $(INSTALL_FILES) - -APP_FILE= typer.app -APP_SRC= $(APP_FILE).src -APP_TARGET= $(EBIN)/$(APP_FILE) - -APPUP_FILE= typer.appup -APPUP_SRC= $(APPUP_FILE).src -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_export_vars +warn_untyped_record +warn_missing_spec - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -docs: - -clean: - rm -f $(TARGET_FILES) - rm -f core - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/typer.$(EMULATOR): typer.erl ../vsn.mk Makefile - $(erlc_verbose)erlc -W $(ERL_COMPILE_FLAGS) -DVSN="\"v$(VSN)\"" -o$(EBIN) typer.erl - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -# --------------------------------------------------------------------- -# dependencies -# --------------------------------------------------------------------- - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(YRL_FILES) \ - "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(INSTALL_FILES) "$(RELSYSDIR)/ebin" - -release_docs_spec: diff --git a/lib/typer/src/typer.app.src b/lib/typer/src/typer.app.src deleted file mode 100644 index 974091b44c..0000000000 --- a/lib/typer/src/typer.app.src +++ /dev/null @@ -1,11 +0,0 @@ -% This is an -*- erlang -*- file. - -{application, typer, - [{description, "TYPe annotator for ERlang programs, version %VSN%"}, - {vsn, "%VSN%"}, - {modules, [typer]}, - {registered, []}, - {applications, [compiler, dialyzer, hipe, kernel, stdlib]}, - {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", - "dialyzer-2.7","compiler-5.0"]}]}. diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl deleted file mode 100644 index 18c4fe902d..0000000000 --- a/lib/typer/src/typer.erl +++ /dev/null @@ -1,1110 +0,0 @@ -%% -*- erlang-indent-level: 2 -*- -%% -%% 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. - -%%----------------------------------------------------------------------- -%% File : typer.erl -%% Author(s) : The first version of typer was written by Bingwen He -%% with guidance from Kostis Sagonas and Tobias Lindahl. -%% Since June 2008 typer is maintained by Kostis Sagonas. -%% Description : An Erlang/OTP application that shows type information -%% for Erlang modules to the user. Additionally, it can -%% annotate the code of files with such type information. -%%----------------------------------------------------------------------- - --module(typer). - --export([start/0]). - -%%----------------------------------------------------------------------- - --define(SHOW, show). --define(SHOW_EXPORTED, show_exported). --define(ANNOTATE, annotate). --define(ANNOTATE_INC_FILES, annotate_inc_files). - --type mode() :: ?SHOW | ?SHOW_EXPORTED | ?ANNOTATE | ?ANNOTATE_INC_FILES. - -%%----------------------------------------------------------------------- - --type files() :: [file:filename()]. --type callgraph() :: dialyzer_callgraph:callgraph(). --type codeserver() :: dialyzer_codeserver:codeserver(). --type plt() :: dialyzer_plt:plt(). - --record(analysis, - {mode :: mode() | 'undefined', - macros = [] :: [{atom(), term()}], - includes = [] :: files(), - codeserver = dialyzer_codeserver:new():: codeserver(), - callgraph = dialyzer_callgraph:new() :: callgraph(), - files = [] :: files(), % absolute names - plt = none :: 'none' | file:filename(), - no_spec = false :: boolean(), - show_succ = false :: boolean(), - %% For choosing between specs or edoc @spec comments - edoc = false :: boolean(), - %% Files in 'fms' are compilable with option 'to_pp'; we keep them - %% as {FileName, ModuleName} in case the ModuleName is different - fms = [] :: [{file:filename(), module()}], - ex_func = map__new() :: map_dict(), - record = map__new() :: map_dict(), - func = map__new() :: map_dict(), - inc_func = map__new() :: map_dict(), - trust_plt = dialyzer_plt:new() :: plt()}). --type analysis() :: #analysis{}. - --record(args, {files = [] :: files(), - files_r = [] :: files(), - trusted = [] :: files()}). --type args() :: #args{}. - -%%-------------------------------------------------------------------- - --spec start() -> no_return(). - -start() -> - {Args, Analysis} = process_cl_args(), - %% io:format("Args: ~p\n", [Args]), - %% io:format("Analysis: ~p\n", [Analysis]), - Timer = dialyzer_timing:init(false), - TrustedFiles = filter_fd(Args#args.trusted, [], fun is_erl_file/1), - Analysis2 = extract(Analysis, TrustedFiles), - All_Files = get_all_files(Args), - %% io:format("All_Files: ~p\n", [All_Files]), - Analysis3 = Analysis2#analysis{files = All_Files}, - Analysis4 = collect_info(Analysis3), - %% io:format("Final: ~p\n", [Analysis4#analysis.fms]), - TypeInfo = get_type_info(Analysis4), - dialyzer_timing:stop(Timer), - show_or_annotate(TypeInfo), - %% io:format("\nTyper analysis finished\n"), - erlang:halt(0). - -%%-------------------------------------------------------------------- - --spec extract(analysis(), files()) -> analysis(). - -extract(#analysis{macros = Macros, - includes = Includes, - trust_plt = TrustPLT} = Analysis, TrustedFiles) -> - %% io:format("--- Extracting trusted typer_info... "), - Ds = [{d, Name, Value} || {Name, Value} <- Macros], - CodeServer = dialyzer_codeserver:new(), - Fun = - fun(File, CS) -> - %% We include one more dir; the one above the one we are trusting - %% E.g, for /home/tests/typer_ann/test.ann.erl, we should include - %% /home/tests/ rather than /home/tests/typer_ann/ - AllIncludes = [filename:dirname(filename:dirname(File)) | Includes], - Is = [{i, Dir} || Dir <- AllIncludes], - CompOpts = dialyzer_utils:src_compiler_opts() ++ Is ++ Ds, - case dialyzer_utils:get_abstract_code_from_src(File, CompOpts) of - {ok, AbstractCode} -> - case dialyzer_utils:get_record_and_type_info(AbstractCode) of - {ok, RecDict} -> - Mod = list_to_atom(filename:basename(File, ".erl")), - case dialyzer_utils:get_spec_info(Mod, AbstractCode, RecDict) of - {ok, SpecDict, CbDict} -> - CS1 = dialyzer_codeserver:store_temp_records(Mod, RecDict, CS), - dialyzer_codeserver:store_temp_contracts(Mod, SpecDict, CbDict, CS1); - {error, Reason} -> compile_error([Reason]) - end; - {error, Reason} -> compile_error([Reason]) - end; - {error, Reason} -> compile_error(Reason) - end - end, - CodeServer1 = lists:foldl(Fun, CodeServer, TrustedFiles), - %% Process remote types - NewCodeServer = - try - CodeServer2 = - dialyzer_utils:merge_types(CodeServer1, - TrustPLT), % XXX change to the PLT? - NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1), - case sets:size(NewExpTypes) of 0 -> ok end, - CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), - CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), - dialyzer_contracts:process_contract_remote_types(CodeServer4) - catch - throw:{error, ErrorMsg} -> - compile_error(ErrorMsg) - end, - %% Create TrustPLT - ContractsDict = dialyzer_codeserver:get_contracts(NewCodeServer), - Contracts = orddict:from_list(dict:to_list(ContractsDict)), - NewTrustPLT = dialyzer_plt:insert_contract_list(TrustPLT, Contracts), - Analysis#analysis{trust_plt = NewTrustPLT}. - -%%-------------------------------------------------------------------- - --spec get_type_info(analysis()) -> analysis(). - -get_type_info(#analysis{callgraph = CallGraph, - trust_plt = TrustPLT, - codeserver = CodeServer} = Analysis) -> - StrippedCallGraph = remove_external(CallGraph, TrustPLT), - %% io:format("--- Analyzing callgraph... "), - try - NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph, - TrustPLT, - CodeServer), - NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt), - Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt} - catch - error:What -> - fatal_error(io_lib:format("Analysis failed with message: ~p", - [{What, erlang:get_stacktrace()}])); - throw:{dialyzer_succ_typing_error, Msg} -> - fatal_error(io_lib:format("Analysis failed with message: ~s", [Msg])) - end. - --spec remove_external(callgraph(), plt()) -> callgraph(). - -remove_external(CallGraph, PLT) -> - {StrippedCG0, Ext} = dialyzer_callgraph:remove_external(CallGraph), - case get_external(Ext, PLT) of - [] -> ok; - Externals -> - msg(io_lib:format(" Unknown functions: ~p\n", [lists:usort(Externals)])), - ExtTypes = rcv_ext_types(), - case ExtTypes of - [] -> ok; - _ -> msg(io_lib:format(" Unknown types: ~p\n", [ExtTypes])) - end - end, - StrippedCG0. - --spec get_external([{mfa(), mfa()}], plt()) -> [mfa()]. - -get_external(Exts, Plt) -> - Fun = fun ({_From, To = {M, F, A}}, Acc) -> - case dialyzer_plt:contains_mfa(Plt, To) of - false -> - case erl_bif_types:is_known(M, F, A) of - true -> Acc; - false -> [To|Acc] - end; - true -> Acc - end - end, - lists:foldl(Fun, [], Exts). - -%%-------------------------------------------------------------------- -%% Showing type information or annotating files with such information. -%%-------------------------------------------------------------------- - --define(TYPER_ANN_DIR, "typer_ann"). - --type line() :: non_neg_integer(). --type fa() :: {atom(), arity()}. --type func_info() :: {line(), atom(), arity()}. - --record(info, {records = maps:new() :: erl_types:type_table(), - functions = [] :: [func_info()], - types = map__new() :: map_dict(), - edoc = false :: boolean()}). --record(inc, {map = map__new() :: map_dict(), filter = [] :: files()}). --type inc() :: #inc{}. - --spec show_or_annotate(analysis()) -> 'ok'. - -show_or_annotate(#analysis{mode = Mode, fms = Files} = Analysis) -> - case Mode of - ?SHOW -> show(Analysis); - ?SHOW_EXPORTED -> show(Analysis); - ?ANNOTATE -> - Fun = fun ({File, Module}) -> - Info = get_final_info(File, Module, Analysis), - write_typed_file(File, Info) - end, - lists:foreach(Fun, Files); - ?ANNOTATE_INC_FILES -> - IncInfo = write_and_collect_inc_info(Analysis), - write_inc_files(IncInfo) - end. - -write_and_collect_inc_info(Analysis) -> - Fun = fun ({File, Module}, Inc) -> - Info = get_final_info(File, Module, Analysis), - write_typed_file(File, Info), - IncFuns = get_functions(File, Analysis), - collect_imported_functions(IncFuns, Info#info.types, Inc) - end, - NewInc = lists:foldl(Fun, #inc{}, Analysis#analysis.fms), - clean_inc(NewInc). - -write_inc_files(Inc) -> - Fun = - fun (File) -> - Val = map__lookup(File, Inc#inc.map), - %% Val is function with its type info - %% in form [{{Line,F,A},Type}] - Functions = [Key || {Key, _} <- Val], - Val1 = [{{F,A},Type} || {{_Line,F,A},Type} <- Val], - Info = #info{types = map__from_list(Val1), - records = maps:new(), - %% Note we need to sort functions here! - functions = lists:keysort(1, Functions)}, - %% io:format("Types ~p\n", [Info#info.types]), - %% io:format("Functions ~p\n", [Info#info.functions]), - %% io:format("Records ~p\n", [Info#info.records]), - write_typed_file(File, Info) - end, - lists:foreach(Fun, dict:fetch_keys(Inc#inc.map)). - -show(Analysis) -> - Fun = fun ({File, Module}) -> - Info = get_final_info(File, Module, Analysis), - show_type_info(File, Info) - end, - lists:foreach(Fun, Analysis#analysis.fms). - -get_final_info(File, Module, Analysis) -> - Records = get_records(File, Analysis), - Types = get_types(Module, Analysis, Records), - Functions = get_functions(File, Analysis), - Edoc = Analysis#analysis.edoc, - #info{records = Records, functions = Functions, types = Types, edoc = Edoc}. - -collect_imported_functions(Functions, Types, Inc) -> - %% Coming from other sourses, including: - %% FIXME: How to deal with yecc-generated file???? - %% --.yrl (yecc-generated file)??? - %% -- yeccpre.hrl (yecc-generated file)??? - %% -- other cases - Fun = fun ({File, _} = Obj, I) -> - case is_yecc_gen(File, I) of - {true, NewI} -> NewI; - {false, NewI} -> - check_imported_functions(Obj, NewI, Types) - end - end, - lists:foldl(Fun, Inc, Functions). - --spec is_yecc_gen(file:filename(), inc()) -> {boolean(), inc()}. - -is_yecc_gen(File, #inc{filter = Fs} = Inc) -> - case lists:member(File, Fs) of - true -> {true, Inc}; - false -> - case filename:extension(File) of - ".yrl" -> - Rootname = filename:rootname(File, ".yrl"), - Obj = Rootname ++ ".erl", - case lists:member(Obj, Fs) of - true -> {true, Inc}; - false -> - NewInc = Inc#inc{filter = [Obj|Fs]}, - {true, NewInc} - end; - _ -> - case filename:basename(File) of - "yeccpre.hrl" -> {true, Inc}; - _ -> {false, Inc} - end - end - end. - -check_imported_functions({File, {Line, F, A}}, Inc, Types) -> - IncMap = Inc#inc.map, - FA = {F, A}, - Type = get_type_info(FA, Types), - case map__lookup(File, IncMap) of - none -> %% File is not added. Add it - Obj = {File,[{FA, {Line, Type}}]}, - NewMap = map__insert(Obj, IncMap), - Inc#inc{map = NewMap}; - Val -> %% File is already in. Check. - case lists:keyfind(FA, 1, Val) of - false -> - %% Function is not in; add it - Obj = {File, Val ++ [{FA, {Line, Type}}]}, - NewMap = map__insert(Obj, IncMap), - Inc#inc{map = NewMap}; - Type -> - %% Function is in and with same type - Inc; - _ -> - %% Function is in but with diff type - inc_warning(FA, File), - Elem = lists:keydelete(FA, 1, Val), - NewMap = case Elem of - [] -> map__remove(File, IncMap); - _ -> map__insert({File, Elem}, IncMap) - end, - Inc#inc{map = NewMap} - end - end. - -inc_warning({F, A}, File) -> - io:format(" ***Warning: Skip function ~p/~p ", [F, A]), - io:format("in file ~p because of inconsistent type\n", [File]). - -clean_inc(Inc) -> - Inc1 = remove_yecc_generated_file(Inc), - normalize_obj(Inc1). - -remove_yecc_generated_file(#inc{filter = Filter} = Inc) -> - Fun = fun (Key, #inc{map = Map} = I) -> - I#inc{map = map__remove(Key, Map)} - end, - lists:foldl(Fun, Inc, Filter). - -normalize_obj(TmpInc) -> - Fun = fun (Key, Val, Inc) -> - NewVal = [{{Line,F,A},Type} || {{F,A},{Line,Type}} <- Val], - map__insert({Key, NewVal}, Inc) - end, - TmpInc#inc{map = map__fold(Fun, map__new(), TmpInc#inc.map)}. - -get_records(File, Analysis) -> - map__lookup(File, Analysis#analysis.record). - -get_types(Module, Analysis, Records) -> - TypeInfoPlt = Analysis#analysis.trust_plt, - TypeInfo = - case dialyzer_plt:lookup_module(TypeInfoPlt, Module) of - none -> []; - {value, List} -> List - end, - CodeServer = Analysis#analysis.codeserver, - TypeInfoList = - case Analysis#analysis.show_succ of - true -> - [convert_type_info(I) || I <- TypeInfo]; - false -> - [get_type(I, CodeServer, Records) || I <- TypeInfo] - end, - map__from_list(TypeInfoList). - -convert_type_info({{_M, F, A}, Range, Arg}) -> - {{F, A}, {Range, Arg}}. - -get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) -> - case dialyzer_codeserver:lookup_mfa_contract(MFA, CodeServer) of - error -> - {{F, A}, {Range, Arg}}; - {ok, {_FileLine, Contract, _Xtra}} -> - Sig = erl_types:t_fun(Arg, Range), - case dialyzer_contracts:check_contract(Contract, Sig) of - ok -> {{F, A}, {contract, Contract}}; - {error, {extra_range, _, _}} -> - {{F, A}, {contract, Contract}}; - {error, {overlapping_contract, []}} -> - {{F, A}, {contract, Contract}}; - {error, invalid_contract} -> - CString = dialyzer_contracts:contract_to_string(Contract), - SigString = dialyzer_utils:format_sig(Sig, Records), - Msg = io_lib:format("Error in contract of function ~w:~w/~w\n" - "\t The contract is: " ++ CString ++ "\n" ++ - "\t but the inferred signature is: ~s", - [M, F, A, SigString]), - fatal_error(Msg); - {error, ErrorStr} when is_list(ErrorStr) -> % ErrorStr is a string() - Msg = io_lib:format("Error in contract of function ~w:~w/~w: ~s", - [M, F, A, ErrorStr]), - fatal_error(Msg) - end - end. - -get_functions(File, Analysis) -> - case Analysis#analysis.mode of - ?SHOW -> - Funcs = map__lookup(File, Analysis#analysis.func), - Inc_Funcs = map__lookup(File, Analysis#analysis.inc_func), - remove_module_info(Funcs) ++ normalize_incFuncs(Inc_Funcs); - ?SHOW_EXPORTED -> - Ex_Funcs = map__lookup(File, Analysis#analysis.ex_func), - remove_module_info(Ex_Funcs); - ?ANNOTATE -> - Funcs = map__lookup(File, Analysis#analysis.func), - remove_module_info(Funcs); - ?ANNOTATE_INC_FILES -> - map__lookup(File, Analysis#analysis.inc_func) - end. - -normalize_incFuncs(Functions) -> - [FunInfo || {_FileName, FunInfo} <- Functions]. - --spec remove_module_info([func_info()]) -> [func_info()]. - -remove_module_info(FunInfoList) -> - F = fun ({_,module_info,0}) -> false; - ({_,module_info,1}) -> false; - ({Line,F,A}) when is_integer(Line), is_atom(F), is_integer(A) -> true - end, - lists:filter(F, FunInfoList). - -write_typed_file(File, Info) -> - io:format(" Processing file: ~p\n", [File]), - Dir = filename:dirname(File), - RootName = filename:basename(filename:rootname(File)), - Ext = filename:extension(File), - TyperAnnDir = filename:join(Dir, ?TYPER_ANN_DIR), - TmpNewFilename = lists:concat([RootName, ".ann", Ext]), - NewFileName = filename:join(TyperAnnDir, TmpNewFilename), - case file:make_dir(TyperAnnDir) of - {error, Reason} -> - case Reason of - eexist -> %% TypEr dir exists; remove old typer files if they exist - case file:delete(NewFileName) of - ok -> ok; - {error, enoent} -> ok; - {error, _} -> - Msg = io_lib:format("Error in deleting file ~s\n", [NewFileName]), - fatal_error(Msg) - end, - write_typed_file(File, Info, NewFileName); - enospc -> - Msg = io_lib:format("Not enough space in ~p\n", [Dir]), - fatal_error(Msg); - eacces -> - Msg = io_lib:format("No write permission in ~p\n", [Dir]), - fatal_error(Msg); - _ -> - Msg = io_lib:format("Unhandled error ~s when writing ~p\n", - [Reason, Dir]), - fatal_error(Msg) - end; - ok -> %% Typer dir does NOT exist - write_typed_file(File, Info, NewFileName) - end. - -write_typed_file(File, Info, NewFileName) -> - {ok, Binary} = file:read_file(File), - Chars = binary_to_list(Binary), - write_typed_file(Chars, NewFileName, Info, 1, []), - io:format(" Saved as: ~p\n", [NewFileName]). - -write_typed_file(Chars, File, #info{functions = []}, _LNo, _Acc) -> - ok = file:write_file(File, list_to_binary(Chars), [append]); -write_typed_file([Ch|Chs] = Chars, File, Info, LineNo, Acc) -> - [{Line,F,A}|RestFuncs] = Info#info.functions, - case Line of - 1 -> %% This will happen only for inc files - ok = raw_write(F, A, Info, File, []), - NewInfo = Info#info{functions = RestFuncs}, - NewAcc = [], - write_typed_file(Chars, File, NewInfo, Line, NewAcc); - _ -> - case Ch of - 10 -> - NewLineNo = LineNo + 1, - {NewInfo, NewAcc} = - case NewLineNo of - Line -> - ok = raw_write(F, A, Info, File, [Ch|Acc]), - {Info#info{functions = RestFuncs}, []}; - _ -> - {Info, [Ch|Acc]} - end, - write_typed_file(Chs, File, NewInfo, NewLineNo, NewAcc); - _ -> - write_typed_file(Chs, File, Info, LineNo, [Ch|Acc]) - end - end. - -raw_write(F, A, Info, File, Content) -> - TypeInfo = get_type_string(F, A, Info, file), - ContentList = lists:reverse(Content) ++ TypeInfo ++ "\n", - ContentBin = list_to_binary(ContentList), - file:write_file(File, ContentBin, [append]). - -get_type_string(F, A, Info, Mode) -> - Type = get_type_info({F,A}, Info#info.types), - TypeStr = - case Type of - {contract, C} -> - dialyzer_contracts:contract_to_string(C); - {RetType, ArgType} -> - Sig = erl_types:t_fun(ArgType, RetType), - dialyzer_utils:format_sig(Sig, Info#info.records) - end, - case Info#info.edoc of - false -> - case {Mode, Type} of - {file, {contract, _}} -> ""; - _ -> - Prefix = lists:concat(["-spec ", erl_types:atom_to_string(F)]), - lists:concat([Prefix, TypeStr, "."]) - end; - true -> - Prefix = lists:concat(["%% @spec ", F]), - lists:concat([Prefix, TypeStr, "."]) - end. - -show_type_info(File, Info) -> - io:format("\n%% File: ~p\n%% ", [File]), - OutputString = lists:concat(["~.", length(File)+8, "c~n"]), - io:fwrite(OutputString, [$-]), - Fun = fun ({_LineNo, F, A}) -> - TypeInfo = get_type_string(F, A, Info, show), - io:format("~s\n", [TypeInfo]) - end, - lists:foreach(Fun, Info#info.functions). - -get_type_info(Func, Types) -> - case map__lookup(Func, Types) of - none -> - %% Note: Typeinfo of any function should exist in - %% the result offered by dialyzer, otherwise there - %% *must* be something wrong with the analysis - Msg = io_lib:format("No type info for function: ~p\n", [Func]), - fatal_error(Msg); - {contract, _Fun} = C -> C; - {_RetType, _ArgType} = RA -> RA - end. - -%%-------------------------------------------------------------------- -%% Processing of command-line options and arguments. -%%-------------------------------------------------------------------- - --spec process_cl_args() -> {args(), analysis()}. - -process_cl_args() -> - ArgList = init:get_plain_arguments(), - %% io:format("Args is ~p\n", [ArgList]), - {Args, Analysis} = analyze_args(ArgList, #args{}, #analysis{}), - %% if the mode has not been set, set it to the default mode (show) - {Args, case Analysis#analysis.mode of - undefined -> Analysis#analysis{mode = ?SHOW}; - Mode when is_atom(Mode) -> Analysis - end}. - -analyze_args([], Args, Analysis) -> - {Args, Analysis}; -analyze_args(ArgList, Args, Analysis) -> - {Result, Rest} = cl(ArgList), - {NewArgs, NewAnalysis} = analyze_result(Result, Args, Analysis), - analyze_args(Rest, NewArgs, NewAnalysis). - -cl(["-h"|_]) -> help_message(); -cl(["--help"|_]) -> help_message(); -cl(["-v"|_]) -> version_message(); -cl(["--version"|_]) -> version_message(); -cl(["--edoc"|Opts]) -> {edoc, Opts}; -cl(["--show"|Opts]) -> {{mode, ?SHOW}, Opts}; -cl(["--show_exported"|Opts]) -> {{mode, ?SHOW_EXPORTED}, Opts}; -cl(["--show-exported"|Opts]) -> {{mode, ?SHOW_EXPORTED}, Opts}; -cl(["--show_success_typings"|Opts]) -> {show_succ, Opts}; -cl(["--show-success-typings"|Opts]) -> {show_succ, Opts}; -cl(["--annotate"|Opts]) -> {{mode, ?ANNOTATE}, Opts}; -cl(["--annotate-inc-files"|Opts]) -> {{mode, ?ANNOTATE_INC_FILES}, Opts}; -cl(["--no_spec"|Opts]) -> {no_spec, Opts}; -cl(["--plt",Plt|Opts]) -> {{plt, Plt}, Opts}; -cl(["-D"++Def|Opts]) -> - case Def of - "" -> fatal_error("no variable name specified after -D"); - _ -> - DefPair = process_def_list(re:split(Def, "=", [{return, list}])), - {{def, DefPair}, Opts} - end; -cl(["-I",Dir|Opts]) -> {{inc, Dir}, Opts}; -cl(["-I"++Dir|Opts]) -> - case Dir of - "" -> fatal_error("no include directory specified after -I"); - _ -> {{inc, Dir}, Opts} - end; -cl(["-T"|Opts]) -> - {Files, RestOpts} = dialyzer_cl_parse:collect_args(Opts), - case Files of - [] -> fatal_error("no file or directory specified after -T"); - [_|_] -> {{trusted, Files}, RestOpts} - end; -cl(["-r"|Opts]) -> - {Files, RestOpts} = dialyzer_cl_parse:collect_args(Opts), - {{files_r, Files}, RestOpts}; -cl(["-pa",Dir|Opts]) -> {{pa,Dir}, Opts}; -cl(["-pz",Dir|Opts]) -> {{pz,Dir}, Opts}; -cl(["-"++H|_]) -> fatal_error("unknown option -"++H); -cl(Opts) -> - {Files, RestOpts} = dialyzer_cl_parse:collect_args(Opts), - {{files, Files}, RestOpts}. - -process_def_list(L) -> - case L of - [Name, Value] -> - {ok, Tokens, _} = erl_scan:string(Value ++ "."), - {ok, ErlValue} = erl_parse:parse_term(Tokens), - {list_to_atom(Name), ErlValue}; - [Name] -> - {list_to_atom(Name), true} - end. - -%% Get information about files that the user trusts and wants to analyze -analyze_result({files, Val}, Args, Analysis) -> - NewVal = Args#args.files ++ Val, - {Args#args{files = NewVal}, Analysis}; -analyze_result({files_r, Val}, Args, Analysis) -> - NewVal = Args#args.files_r ++ Val, - {Args#args{files_r = NewVal}, Analysis}; -analyze_result({trusted, Val}, Args, Analysis) -> - NewVal = Args#args.trusted ++ Val, - {Args#args{trusted = NewVal}, Analysis}; -analyze_result(edoc, Args, Analysis) -> - {Args, Analysis#analysis{edoc = true}}; -%% Get useful information for actual analysis -analyze_result({mode, Mode}, Args, Analysis) -> - case Analysis#analysis.mode of - undefined -> {Args, Analysis#analysis{mode = Mode}}; - OldMode -> mode_error(OldMode, Mode) - end; -analyze_result({def, Val}, Args, Analysis) -> - NewVal = Analysis#analysis.macros ++ [Val], - {Args, Analysis#analysis{macros = NewVal}}; -analyze_result({inc, Val}, Args, Analysis) -> - NewVal = Analysis#analysis.includes ++ [Val], - {Args, Analysis#analysis{includes = NewVal}}; -analyze_result({plt, Plt}, Args, Analysis) -> - {Args, Analysis#analysis{plt = Plt}}; -analyze_result(show_succ, Args, Analysis) -> - {Args, Analysis#analysis{show_succ = true}}; -analyze_result(no_spec, Args, Analysis) -> - {Args, Analysis#analysis{no_spec = true}}; -analyze_result({pa, Dir}, Args, Analysis) -> - true = code:add_patha(Dir), - {Args, Analysis}; -analyze_result({pz, Dir}, Args, Analysis) -> - true = code:add_pathz(Dir), - {Args, Analysis}. - -%%-------------------------------------------------------------------- -%% File processing. -%%-------------------------------------------------------------------- - --spec get_all_files(args()) -> [file:filename(),...]. - -get_all_files(#args{files = Fs, files_r = Ds}) -> - case filter_fd(Fs, Ds, fun test_erl_file_exclude_ann/1) of - [] -> fatal_error("no file(s) to analyze"); - AllFiles -> AllFiles - end. - --spec test_erl_file_exclude_ann(file:filename()) -> boolean(). - -test_erl_file_exclude_ann(File) -> - case is_erl_file(File) of - true -> %% Exclude files ending with ".ann.erl" - case re:run(File, "[\.]ann[\.]erl$") of - {match, _} -> false; - nomatch -> true - end; - false -> false - end. - --spec is_erl_file(file:filename()) -> boolean(). - -is_erl_file(File) -> - filename:extension(File) =:= ".erl". - --type test_file_fun() :: fun((file:filename()) -> boolean()). - --spec filter_fd(files(), files(), test_file_fun()) -> files(). - -filter_fd(File_Dir, Dir_R, Fun) -> - All_File_1 = process_file_and_dir(File_Dir, Fun), - All_File_2 = process_dir_rec(Dir_R, Fun), - remove_dup(All_File_1 ++ All_File_2). - --spec process_file_and_dir(files(), test_file_fun()) -> files(). - -process_file_and_dir(File_Dir, TestFun) -> - Fun = - fun (Elem, Acc) -> - case filelib:is_regular(Elem) of - true -> process_file(Elem, TestFun, Acc); - false -> check_dir(Elem, false, Acc, TestFun) - end - end, - lists:foldl(Fun, [], File_Dir). - --spec process_dir_rec(files(), test_file_fun()) -> files(). - -process_dir_rec(Dirs, TestFun) -> - Fun = fun (Dir, Acc) -> check_dir(Dir, true, Acc, TestFun) end, - lists:foldl(Fun, [], Dirs). - --spec check_dir(file:filename(), boolean(), files(), test_file_fun()) -> files(). - -check_dir(Dir, Recursive, Acc, Fun) -> - case file:list_dir(Dir) of - {ok, Files} -> - {TmpDirs, TmpFiles} = split_dirs_and_files(Files, Dir), - case Recursive of - false -> - FinalFiles = process_file_and_dir(TmpFiles, Fun), - Acc ++ FinalFiles; - true -> - TmpAcc1 = process_file_and_dir(TmpFiles, Fun), - TmpAcc2 = process_dir_rec(TmpDirs, Fun), - Acc ++ TmpAcc1 ++ TmpAcc2 - end; - {error, eacces} -> - fatal_error("no access permission to dir \""++Dir++"\""); - {error, enoent} -> - fatal_error("cannot access "++Dir++": No such file or directory"); - {error, _Reason} -> - fatal_error("error involving a use of file:list_dir/1") - end. - -%% Same order as the input list --spec process_file(file:filename(), test_file_fun(), files()) -> files(). - -process_file(File, TestFun, Acc) -> - case TestFun(File) of - true -> Acc ++ [File]; - false -> Acc - end. - -%% Same order as the input list --spec split_dirs_and_files(files(), file:filename()) -> {files(), files()}. - -split_dirs_and_files(Elems, Dir) -> - Test_Fun = - fun (Elem, {DirAcc, FileAcc}) -> - File = filename:join(Dir, Elem), - case filelib:is_regular(File) of - false -> {[File|DirAcc], FileAcc}; - true -> {DirAcc, [File|FileAcc]} - end - end, - {Dirs, Files} = lists:foldl(Test_Fun, {[], []}, Elems), - {lists:reverse(Dirs), lists:reverse(Files)}. - -%% Removes duplicate filenames but keeps the order of the input list --spec remove_dup(files()) -> files(). - -remove_dup(Files) -> - Test_Dup = fun (File, Acc) -> - case lists:member(File, Acc) of - true -> Acc; - false -> [File|Acc] - end - end, - Reversed_Elems = lists:foldl(Test_Dup, [], Files), - lists:reverse(Reversed_Elems). - -%%-------------------------------------------------------------------- -%% Collect information. -%%-------------------------------------------------------------------- - --type inc_file_info() :: {file:filename(), func_info()}. - --record(tmpAcc, {file :: file:filename(), - module :: atom(), - funcAcc = [] :: [func_info()], - incFuncAcc = [] :: [inc_file_info()], - dialyzerObj = [] :: [{mfa(), {_, _}}]}). - --spec collect_info(analysis()) -> analysis(). - -collect_info(Analysis) -> - NewPlt = - try get_dialyzer_plt(Analysis) of - DialyzerPlt -> - dialyzer_plt:merge_plts([Analysis#analysis.trust_plt, DialyzerPlt]) - catch - throw:{dialyzer_error,_Reason} -> - fatal_error("Dialyzer's PLT is missing or is not up-to-date; please (re)create it") - end, - NewAnalysis = lists:foldl(fun collect_one_file_info/2, - Analysis#analysis{trust_plt = NewPlt}, - Analysis#analysis.files), - %% Process Remote Types - TmpCServer = NewAnalysis#analysis.codeserver, - NewCServer = - try - TmpCServer1 = dialyzer_utils:merge_types(TmpCServer, NewPlt), - NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer), - OldExpTypes = dialyzer_plt:get_exported_types(NewPlt), - MergedExpTypes = sets:union(NewExpTypes, OldExpTypes), - TmpCServer2 = - dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), - TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), - dialyzer_contracts:process_contract_remote_types(TmpCServer3) - catch - throw:{error, ErrorMsg} -> - fatal_error(ErrorMsg) - end, - NewAnalysis#analysis{codeserver = NewCServer}. - -collect_one_file_info(File, Analysis) -> - Ds = [{d,Name,Val} || {Name,Val} <- Analysis#analysis.macros], - %% Current directory should also be included in "Includes". - Includes = [filename:dirname(File)|Analysis#analysis.includes], - Is = [{i,Dir} || Dir <- Includes], - Options = dialyzer_utils:src_compiler_opts() ++ Is ++ Ds, - case dialyzer_utils:get_abstract_code_from_src(File, Options) of - {error, Reason} -> - %% io:format("File=~p\n,Options=~p\n,Error=~p\n", [File,Options,Reason]), - compile_error(Reason); - {ok, AbstractCode} -> - case dialyzer_utils:get_core_from_abstract_code(AbstractCode, Options) of - error -> compile_error(["Could not get core erlang for "++File]); - {ok, Core} -> - case dialyzer_utils:get_record_and_type_info(AbstractCode) of - {error, Reason} -> compile_error([Reason]); - {ok, Records} -> - Mod = cerl:concrete(cerl:module_name(Core)), - case dialyzer_utils:get_spec_info(Mod, AbstractCode, Records) of - {error, Reason} -> compile_error([Reason]); - {ok, SpecInfo, CbInfo} -> - ExpTypes = get_exported_types_from_core(Core), - analyze_core_tree(Core, Records, SpecInfo, CbInfo, - ExpTypes, Analysis, File) - end - end - end - end. - -analyze_core_tree(Core, Records, SpecInfo, CbInfo, ExpTypes, Analysis, File) -> - Module = cerl:concrete(cerl:module_name(Core)), - TmpTree = cerl:from_records(Core), - CS1 = Analysis#analysis.codeserver, - NextLabel = dialyzer_codeserver:get_next_core_label(CS1), - {Tree, NewLabel} = cerl_trees:label(TmpTree, NextLabel), - CS2 = dialyzer_codeserver:insert(Module, Tree, CS1), - CS3 = dialyzer_codeserver:set_next_core_label(NewLabel, CS2), - CS4 = dialyzer_codeserver:store_temp_records(Module, Records, CS3), - CS5 = - case Analysis#analysis.no_spec of - true -> CS4; - false -> - dialyzer_codeserver:store_temp_contracts(Module, SpecInfo, CbInfo, CS4) - end, - OldExpTypes = dialyzer_codeserver:get_temp_exported_types(CS5), - MergedExpTypes = sets:union(ExpTypes, OldExpTypes), - CS6 = dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, CS5), - Ex_Funcs = [{0,F,A} || {_,_,{F,A}} <- cerl:module_exports(Tree)], - CG = Analysis#analysis.callgraph, - {V, E} = dialyzer_callgraph:scan_core_tree(Tree, CG), - dialyzer_callgraph:add_edges(E, V, CG), - Fun = fun analyze_one_function/2, - All_Defs = cerl:module_defs(Tree), - Acc = lists:foldl(Fun, #tmpAcc{file = File, module = Module}, All_Defs), - Exported_FuncMap = map__insert({File, Ex_Funcs}, Analysis#analysis.ex_func), - %% we must sort all functions in the file which - %% originate from this file by *numerical order* of lineNo - Sorted_Functions = lists:keysort(1, Acc#tmpAcc.funcAcc), - FuncMap = map__insert({File, Sorted_Functions}, Analysis#analysis.func), - %% we do not need to sort functions which are imported from included files - IncFuncMap = map__insert({File, Acc#tmpAcc.incFuncAcc}, - Analysis#analysis.inc_func), - FMs = Analysis#analysis.fms ++ [{File, Module}], - RecordMap = map__insert({File, Records}, Analysis#analysis.record), - Analysis#analysis{fms = FMs, - callgraph = CG, - codeserver = CS6, - ex_func = Exported_FuncMap, - inc_func = IncFuncMap, - record = RecordMap, - func = FuncMap}. - -analyze_one_function({Var, FunBody} = Function, Acc) -> - F = cerl:fname_id(Var), - A = cerl:fname_arity(Var), - TmpDialyzerObj = {{Acc#tmpAcc.module, F, A}, Function}, - NewDialyzerObj = Acc#tmpAcc.dialyzerObj ++ [TmpDialyzerObj], - Anno = cerl:get_ann(FunBody), - LineNo = get_line(Anno), - FileName = get_file(Anno), - BaseName = filename:basename(FileName), - FuncInfo = {LineNo, F, A}, - OriginalName = Acc#tmpAcc.file, - {FuncAcc, IncFuncAcc} = - case (FileName =:= OriginalName) orelse (BaseName =:= OriginalName) of - true -> %% Coming from original file - %% io:format("Added function ~p\n", [{LineNo, F, A}]), - {Acc#tmpAcc.funcAcc ++ [FuncInfo], Acc#tmpAcc.incFuncAcc}; - false -> - %% Coming from other sourses, including: - %% -- .yrl (yecc-generated file) - %% -- yeccpre.hrl (yecc-generated file) - %% -- other cases - {Acc#tmpAcc.funcAcc, Acc#tmpAcc.incFuncAcc ++ [{FileName, FuncInfo}]} - end, - Acc#tmpAcc{funcAcc = FuncAcc, - incFuncAcc = IncFuncAcc, - dialyzerObj = NewDialyzerObj}. - -get_line([Line|_]) when is_integer(Line) -> Line; -get_line([_|T]) -> get_line(T); -get_line([]) -> none. - -get_file([{file,File}|_]) -> File; -get_file([_|T]) -> get_file(T); -get_file([]) -> "no_file". % should not happen - --spec get_dialyzer_plt(analysis()) -> plt(). - -get_dialyzer_plt(#analysis{plt = PltFile0}) -> - PltFile = - case PltFile0 =:= none of - true -> dialyzer_plt:get_default_plt(); - false -> PltFile0 - end, - dialyzer_plt:from_file(PltFile). - -%% Exported Types - -get_exported_types_from_core(Core) -> - Attrs = cerl:module_attrs(Core), - ExpTypes1 = [cerl:concrete(L2) || {L1, L2} <- Attrs, - cerl:is_literal(L1), - cerl:is_literal(L2), - cerl:concrete(L1) =:= 'export_type'], - ExpTypes2 = lists:flatten(ExpTypes1), - M = cerl:atom_val(cerl:module_name(Core)), - sets:from_list([{M, F, A} || {F, A} <- ExpTypes2]). - -%%-------------------------------------------------------------------- -%% Utilities for error reporting. -%%-------------------------------------------------------------------- - --spec fatal_error(string()) -> no_return(). - -fatal_error(Slogan) -> - msg(io_lib:format("typer: ~s\n", [Slogan])), - erlang:halt(1). - --spec mode_error(mode(), mode()) -> no_return(). - -mode_error(OldMode, NewMode) -> - Msg = io_lib:format("Mode was previously set to '~s'; " - "can not set it to '~s' now", - [OldMode, NewMode]), - fatal_error(Msg). - --spec compile_error([string()]) -> no_return(). - -compile_error(Reason) -> - JoinedString = lists:flatten([X ++ "\n" || X <- Reason]), - Msg = "Analysis failed with error report:\n" ++ JoinedString, - fatal_error(Msg). - --spec msg(string()) -> 'ok'. - -msg(Msg) -> - io:format(standard_error, "~s", [Msg]). - -%%-------------------------------------------------------------------- -%% Version and help messages. -%%-------------------------------------------------------------------- - --spec version_message() -> no_return(). - -version_message() -> - io:format("TypEr version "++?VSN++"\n"), - erlang:halt(0). - --spec help_message() -> no_return(). - -help_message() -> - S = <<" Usage: typer [--help] [--version] [--plt PLT] [--edoc] - [--show | --show-exported | --annotate | --annotate-inc-files] - [-Ddefine]* [-I include_dir]* [-pa dir]* [-pz dir]* - [-T application]* [-r] file* - - Options: - -r dir* - search directories recursively for .erl files below them - --show - Prints type specifications for all functions on stdout. - (this is the default behaviour; this option is not really needed) - --show-exported (or --show_exported) - Same as --show, but prints specifications for exported functions only - Specs are displayed sorted alphabetically on the function's name - --annotate - Annotates the specified files with type specifications - --annotate-inc-files - Same as --annotate but annotates all -include() files as well as - all .erl files (use this option with caution - has not been tested much) - --edoc - Prints type information as Edoc @spec comments, not as type specs - --plt PLT - Use the specified dialyzer PLT file rather than the default one - -T file* - The specified file(s) already contain type specifications and these - are to be trusted in order to print specs for the rest of the files - (Multiple files or dirs, separated by spaces, can be specified.) - -Dname (or -Dname=value) - pass the defined name(s) to TypEr - (The syntax of defines is the same as that used by \"erlc\".) - -I include_dir - pass the include_dir to TypEr - (The syntax of includes is the same as that used by \"erlc\".) - -pa dir - -pz dir - Set code path options to TypEr - (This is useful for files that use parse tranforms.) - --version (or -v) - prints the Typer version and exits - --help (or -h) - prints this message and exits - - Note: - * denotes that multiple occurrences of these options are possible. -">>, - io:put_chars(S), - erlang:halt(0). - -%%-------------------------------------------------------------------- -%% Handle messages. -%%-------------------------------------------------------------------- - -rcv_ext_types() -> - Self = self(), - Self ! {Self, done}, - rcv_ext_types(Self, []). - -rcv_ext_types(Self, ExtTypes) -> - receive - {Self, ext_types, ExtType} -> - rcv_ext_types(Self, [ExtType|ExtTypes]); - {Self, done} -> - lists:usort(ExtTypes) - end. - -%%-------------------------------------------------------------------- -%% A convenient abstraction of a Key-Value mapping data structure -%% specialized for the uses in this module -%%-------------------------------------------------------------------- - --type map_dict() :: dict:dict(). - --spec map__new() -> map_dict(). -map__new() -> - dict:new(). - --spec map__insert({term(), term()}, map_dict()) -> map_dict(). -map__insert(Object, Map) -> - {Key, Value} = Object, - dict:store(Key, Value, Map). - --spec map__lookup(term(), map_dict()) -> term(). -map__lookup(Key, Map) -> - try dict:fetch(Key, Map) catch error:_ -> none end. - --spec map__from_list([{fa(), term()}]) -> map_dict(). -map__from_list(List) -> - dict:from_list(List). - --spec map__remove(term(), map_dict()) -> map_dict(). -map__remove(Key, Dict) -> - dict:erase(Key, Dict). - --spec map__fold(fun((term(), term(), term()) -> map_dict()), map_dict(), map_dict()) -> map_dict(). -map__fold(Fun, Acc0, Dict) -> - dict:fold(Fun, Acc0, Dict). diff --git a/lib/typer/test/Makefile b/lib/typer/test/Makefile deleted file mode 100644 index fb5570d9f0..0000000000 --- a/lib/typer/test/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - typer_SUITE - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -INSTALL_PROGS= $(TARGET_FILES) - -EMAKEFILE=Emakefile - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/typer_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += - -EBIN = . - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ - > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ - >> $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) $(GEN_FILES) - rm -f core - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) typer.spec "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - -release_docs_spec: diff --git a/lib/typer/test/typer.spec b/lib/typer/test/typer.spec deleted file mode 100644 index 79f51b6781..0000000000 --- a/lib/typer/test/typer.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../typer_test",all}. diff --git a/lib/typer/test/typer_SUITE.erl b/lib/typer/test/typer_SUITE.erl deleted file mode 100644 index 25f0229640..0000000000 --- a/lib/typer/test/typer_SUITE.erl +++ /dev/null @@ -1,57 +0,0 @@ -%% ``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. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% --module(typer_SUITE). - --compile([export_all]). --include_lib("common_test/include/ct.hrl"). - -suite() -> - [{ct_hooks, [ts_install_cth]}]. - -all() -> - case application:ensure_all_started(typer) of - {ok, Apps} -> - [application:stop(App) || App <- lists:reverse(Apps)], - [app, appup]; - _ -> - [appup] - end. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -app() -> - [{doc, "Test that the typer app file is ok"}]. -app(Config) when is_list(Config) -> - ok = ?t:app_test(typer). - -appup() -> - [{doc, "Test that the typer appup file is ok"}]. -appup(Config) when is_list(Config) -> - ok = ?t:appup_test(typer). diff --git a/lib/typer/vsn.mk b/lib/typer/vsn.mk deleted file mode 100644 index ed12e067c1..0000000000 --- a/lib/typer/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -TYPER_VSN = 0.9.11 diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 2b9b37b5f3..f3470b2809 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -145,10 +145,11 @@ parse_dtd(Xml, State) -> %% [1] document ::= prolog element Misc* %%---------------------------------------------------------------------- parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> - {Rest1, State1} = parse_xml_decl(Rest, State), + {Rest1, State1} = parse_byte_order_mark(Rest, State), {Rest2, State2} = parse_misc(Rest1, State1, true), {ok, Rest2, State2}. +?PARSE_BYTE_ORDER_MARK(Bytes, State). %%---------------------------------------------------------------------- %% Function: parse_xml_decl(Rest, State) -> Result @@ -159,15 +160,8 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' %%---------------------------------------------------------------------- --dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> - cf(?BYTE_ORDER_MARK_1, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_2, State) -> - cf(?BYTE_ORDER_MARK_2, State, fun parse_xml_decl/2); -parse_xml_decl(?BYTE_ORDER_MARK_REST(Rest), State) -> - cf(Rest, State, fun parse_xml_decl/2); parse_xml_decl(?STRING("<") = Bytes, State) -> cf(Bytes, State, fun parse_xml_decl/2); parse_xml_decl(?STRING("<?") = Bytes, State) -> @@ -179,31 +173,19 @@ parse_xml_decl(?STRING("<?xm") = Bytes, State) -> parse_xml_decl(?STRING("<?xml") = Bytes, State) -> cf(Bytes, State, fun parse_xml_decl/2); parse_xml_decl(?STRING_REST("<?xml", Rest1), State) -> - parse_xml_decl_1(Rest1, State); -parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> - case unicode:characters_to_list(Bytes, Enc) of - {incomplete, _, _} -> - cf(Bytes, State, fun parse_xml_decl/2); - {error, _Encoded, _Rest} -> - ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); - _ -> - parse_prolog(Bytes, State) - end; -parse_xml_decl(Bytes, State) -> - parse_prolog(Bytes, State). - + parse_xml_decl_rest(Rest1, State); +?PARSE_XML_DECL(Bytes, State). -parse_xml_decl_1(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> +parse_xml_decl_rest(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> if ?is_whitespace(C) -> {_XmlAttributes, Rest1, State1} = parse_version_info(Rest, State, []), - %State2 = event_callback({processingInstruction, "xml", XmlAttributes}, State1),% The XML decl. should not be reported as a PI parse_prolog(Rest1, State1); true -> parse_prolog(?STRING_REST("<?xml", Bytes), State) end; -parse_xml_decl_1(Bytes, State) -> - unicode_incomplete_check([Bytes, State, fun parse_xml_decl_1/2], undefined). +parse_xml_decl_rest(Bytes, State) -> + unicode_incomplete_check([Bytes, State, fun parse_xml_decl_rest/2], undefined). @@ -225,8 +207,6 @@ parse_prolog(?STRING_REST("<?", Rest), State) -> parse_prolog(Rest1, State1); {endDocument, Rest1, State1} -> parse_prolog(Rest1, State1) - % IValue = ?TO_INPUT_FORMAT("<?"), - % {?APPEND_STRING(IValue, Rest1), State1} end; parse_prolog(?STRING_REST("<!", Rest), State) -> parse_prolog_1(Rest, State); @@ -239,7 +219,6 @@ parse_prolog(Bytes, State) -> unicode_incomplete_check([Bytes, State, fun parse_prolog/2], "expecting < or whitespace"). - parse_prolog_1(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_prolog_1/2); parse_prolog_1(?STRING("D") = Bytes, State) -> @@ -1232,7 +1211,6 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- --dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1258,16 +1236,7 @@ whitespace(?STRING_REST("\r", Rest), State, Acc) -> whitespace(Rest, State#xmerl_sax_parser_state{line_no=N+1}, [?lf |Acc]); whitespace(?STRING_UNBOUND_REST(C, Rest), State, Acc) when ?is_whitespace(C) -> whitespace(Rest, State, [C|Acc]); -whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> - {lists:reverse(Acc), Bytes, State}; -whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> - case unicode:characters_to_list(Bytes, Enc) of - {incomplete, _, _} -> - cf(Bytes, State, Acc, fun whitespace/3); - {error, _Encoded, _Rest} -> - ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) - end. - +?WHITESPACE(Bytes, State, Acc). %%---------------------------------------------------------------------- %% Function: parse_reference(Rest, State, HaveToExist) -> Result @@ -1390,7 +1359,6 @@ parse_pe_reference_1(Bytes, State, Name) -> "missing ; after reference " ++ Name). - %%---------------------------------------------------------------------- %% Function: insert_reference(Reference, State) -> Result %% Parameters: Reference = string() @@ -1406,7 +1374,6 @@ insert_reference({Name, Type, Value}, Table) -> end. - %%---------------------------------------------------------------------- %% Function: look_up_reference(Reference, State) -> Result %% Parameters: Reference = string() @@ -1721,7 +1688,7 @@ handle_external_entity({http, Url}, State) -> ++ file:format_error(Reason)); {ok, FD} -> {?STRING_EMPTY, EntityState} = - parse_external_entity_1(<<>>, + parse_external_entity_byte_order_mark(<<>>, State#xmerl_sax_parser_state{continuation_state=FD, current_location=filename:dirname(Url), entity=filename:basename(Url), @@ -1737,6 +1704,8 @@ handle_external_entity({http, Url}, State) -> handle_external_entity({Tag, _Url}, State) -> ?fatal_error(State, "Unsupported URI type: " ++ atom_to_list(Tag)). +?PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State). + %%---------------------------------------------------------------------- %% Function : parse_external_entity_1(Rest, State) -> Result %% Parameters: Rest = string() | binary() @@ -1744,7 +1713,6 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- --dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> @@ -1754,12 +1722,6 @@ parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = Other -> throw(Other) end; -parse_external_entity_1(?BYTE_ORDER_MARK_1, State) -> - cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_1/2); -parse_external_entity_1(?BYTE_ORDER_MARK_2, State) -> - cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_1/2); -parse_external_entity_1(?BYTE_ORDER_MARK_REST(Rest), State) -> - parse_external_entity_1(Rest, State); parse_external_entity_1(?STRING("<") = Bytes, State) -> cf(Bytes, State, fun parse_external_entity_1/2); parse_external_entity_1(?STRING("<?") = Bytes, State) -> diff --git a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc index 961806bf4c..6e59347fb8 100644 --- a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% 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. @@ -34,8 +34,36 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, latin1)). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, undefined_bom2). --define(BYTE_ORDER_MARK_REST(Rest), <<undefined, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc index 624a621d92..6a4435b1d9 100644 --- a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc @@ -36,6 +36,19 @@ %% In the list case we can't use a '++' when matchin against an unbound variable -define(STRING_UNBOUND_REST(MatchChar, Rest), [MatchChar | Rest]). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, undefined_bom2). --define(BYTE_ORDER_MARK_REST(Rest), [undefined|Rest]). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc index ff84ece97a..ec89024729 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% 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. @@ -34,8 +34,50 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, big})). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/big-utf16, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, <<16#FE>>). +-define(BYTE_ORDER_MARK_1, <<16#FE>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#FE, 16#FF, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc index a330fce8d0..566333a045 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% 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. @@ -34,8 +34,50 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, {utf16, little})). -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/little-utf16, Rest/binary>>). --define(BYTE_ORDER_MARK_1, undefined_bom1). --define(BYTE_ORDER_MARK_2, <<16#FF>>). +-define(BYTE_ORDER_MARK_1, <<16#FF>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#FF, 16#FE, Rest/binary>>). + +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). + +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). diff --git a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc index d46d60d237..f41d06d013 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% 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. @@ -34,11 +34,55 @@ -define(APPEND_STRING(Rest, New), <<Rest/binary, New/binary>>). -define(TO_INPUT_FORMAT(Val), unicode:characters_to_binary(Val, unicode, utf8)). - -%% STRING_REST and STRING_UNBOUND_REST is only different in the list case -define(STRING_UNBOUND_REST(MatchChar, Rest), <<MatchChar/utf8, Rest/binary>>). -define(BYTE_ORDER_MARK_1, <<16#EF>>). -define(BYTE_ORDER_MARK_2, <<16#EF, 16#BB>>). -define(BYTE_ORDER_MARK_REST(Rest), <<16#EF, 16#BB, 16#BF, Rest/binary>>). +-define(PARSE_BYTE_ORDER_MARK(Bytes, State), + parse_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_2, State) -> + cf(?BYTE_ORDER_MARK_2, State, fun parse_byte_order_mark/2); + parse_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_xml_decl(Rest, State); + parse_byte_order_mark(Bytes, State) -> + parse_xml_decl(Bytes, State)). + +-define(PARSE_XML_DECL(Bytes, State), + parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, fun parse_xml_decl/2); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))); + _ -> + parse_prolog(Bytes, State) + end; + parse_xml_decl(Bytes, State) -> + parse_prolog(Bytes, State)). + +-define(WHITESPACE(Bytes, State, Acc), + whitespace(?STRING_UNBOUND_REST(_C, _) = Bytes, State, Acc) -> + {lists:reverse(Acc), Bytes, State}; + whitespace(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State, Acc) when is_binary(Bytes) -> + case unicode:characters_to_list(Bytes, Enc) of + {incomplete, _, _} -> + cf(Bytes, State, Acc, fun whitespace/3); + {error, _Encoded, _Rest} -> + ?fatal_error(State, lists:flatten(io_lib:format("Bad character, not in ~p\n", [Enc]))) + end). +-define(PARSE_EXTERNAL_ENTITY_BYTE_ORDER_MARK(Bytes, State), + parse_external_entity_byte_order_mark(?STRING_EMPTY, State) -> + cf(?STRING_EMPTY, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_1, State) -> + cf(?BYTE_ORDER_MARK_1, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_2, State) -> + cf(?BYTE_ORDER_MARK_2, State, fun parse_external_entity_byte_order_mark/2); + parse_external_entity_byte_order_mark(?BYTE_ORDER_MARK_REST(Rest), State) -> + parse_external_entity_1(Rest, State); + parse_external_entity_byte_order_mark(Bytes, State) -> + parse_external_entity_1(Bytes, State)). |