diff options
Diffstat (limited to 'lib')
148 files changed, 8909 insertions, 2019 deletions
diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 7887a2c3ea..081adeaec7 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -72,14 +72,15 @@ <fsummary>Returns the list of all test case groups and test cases in the module.</fsummary> <type> - <v>Tests = [TestCase | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> + <v>Tests = [TestCase | {testcase,TestCase,TCRepeatProps} | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> <v>GroupName = atom()</v> - <v>Properties = [parallel | sequence | Shuffle | {RepeatType,N}] | default</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}] | default</v> <v>SubGroups = [{GroupName,Properties} | {GroupName,Properties,SubGroups}]</v> <v>Shuffle = shuffle | {shuffle,Seed}</v> <v>Seed = {integer(),integer(),integer()}</v> - <v>RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> <v>N = integer() | forever</v> <v>Reason = term()</v> </type> @@ -91,7 +92,8 @@ test suite module to be executed. This list also specifies the order the cases and groups are executed by <c>Common Test</c>. A test case is represented by an atom, - the name of the test case function. A test case group is + the name of the test case function, or a <c>testcase</c> tuple + indicating that the test case shall be repeated. A test case group is represented by a <c>group</c> tuple, where <c>GroupName</c>, an atom, is the name of the group (defined in <seealso marker="#Module:groups-0"><c>groups/0</c></seealso>). @@ -121,12 +123,13 @@ <v>GroupDefs = [Group]</v> <v>Group = {GroupName,Properties,GroupsAndTestCases}</v> <v>GroupName = atom()</v> - <v>Properties = [parallel | sequence | Shuffle | {RepeatType,N}]</v> - <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase]</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase | {testcase,TestCase,TCRepeatProps}]</v> <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> <v>Shuffle = shuffle | {shuffle,Seed}</v> <v>Seed = {integer(),integer(),integer()}</v> - <v>RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> <v>N = integer() | forever</v> </type> diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index ff0d0117cd..ff9969ebc3 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -109,6 +109,131 @@ </func> <func> + <name since="OTP @OTP-14746@">Module:post_groups(SuiteName, GroupDefs) -> NewGroupDefs</name> + <fsummary>Called after groups/0.</fsummary> + <type> + <v>SuiteName = atom()</v> + <v>GroupDefs = NewGroupDefs = [Group]</v> + <v>Group = {GroupName,Properties,GroupsAndTestCases}</v> + <v>GroupName = atom()</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase | {testcase,TestCase,TCRepeatProps}]</v> + <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> + <v>Shuffle = shuffle | {shuffle,Seed}</v> + <v>Seed = {integer(),integer(),integer()}</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>N = integer() | forever</v> + </type> + <desc> + <p>OPTIONAL</p> + + <p>This function is called after + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso>. + It is used to modify the test group definitions, for + instance to add or remove groups or change group properties.</p> + + <p><c>GroupDefs</c> is what + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso> + returned, that is, a list of group definitions.</p> + + <p><c>NewGroupDefs</c> is the possibly modified version of this list.</p> + + <p>This function is called only if the CTH is added before + <c>init_per_suite</c> is run. For details, see section + <seealso marker="ct_hooks_chapter#scope">CTH Scope</seealso> + in the User's Guide.</p> + + <p>Notice that for CTHs that are installed by means of the + <seealso marker="common_test#Module:suite-0"><c>suite/0</c></seealso> + function, <c>post_groups/2</c> is called before + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + hook function. However, for CTHs that are installed by means + of the CT start flag, + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + function is called first.</p> + + <note> + <p>Prior to each test execution, Common Test does a + simulated test run in order to count test suites, groups + and cases for logging purposes. This causes + the <c>post_groups/2</c> hook function to always be called + twice. For this reason, side effects are best avoided in + this callback.</p> + </note> + </desc> + </func> + + <func> + <name since="OTP @OTP-14746@">Module:post_all(SuiteName, Return, GroupDefs) -> NewReturn</name> + <fsummary>Called after all/0.</fsummary> + <type> + <v>SuiteName = atom()</v> + <v>Return = NewReturn = Tests | {skip,Reason}</v> + <v>Tests = [TestCase | {testcase,TestCase,TCRepeatProps} | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> + <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> + <v>GroupName = atom()</v> + <v>Properties = GroupProperties | default</v> + <v>SubGroups = [{GroupName,Properties} | {GroupName,Properties,SubGroups}]</v> + <v>Shuffle = shuffle | {shuffle,Seed}</v> + <v>Seed = {integer(),integer(),integer()}</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>N = integer() | forever</v> + <v>GroupDefs = NewGroupDefs = [Group]</v> + <v>Group = {GroupName,GroupProperties,GroupsAndTestCases}</v> + <v>GroupProperties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase]</v> + <v>Reason = term()</v> + </type> + <desc> + <p>OPTIONAL</p> + + <p>This function is called after + <seealso marker="common_test#Module:all-0"><c>all/0</c></seealso>. + It is used to modify the set of test cases and test group to + be executed, for instance to add or remove test cases and + groups, change group properties, or even skip all tests in + the suite.</p> + + <p><c>Return</c> is what + <seealso marker="common_test#Module:all-0"><c>all/0</c></seealso> + returned, that is, a list of test cases and groups to be + executed, or a tuple <c>{skip,Reason}</c>.</p> + + <p><c>GroupDefs</c> is what + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso> + or the <c>post_groups/2</c> hook returned, that is, a list + of group definitions.</p> + + <p><c>NewReturn</c> is the possibly modified version of <c>Return</c>.</p> + + <p>This function is called only if the CTH is added before + <c>init_per_suite</c> is run. For details, see section + <seealso marker="ct_hooks_chapter#scope">CTH Scope</seealso> + in the User's Guide.</p> + + <p>Notice that for CTHs that are installed by means of the + <seealso marker="common_test#Module:suite-0"><c>suite/0</c></seealso> + function, <c>post_all/2</c> is called before + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + hook function. However, for CTHs that are installed by means + of the CT start flag, + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + function is called first.</p> + + <note> + <p>Prior to each test execution, Common Test does a + simulated test run in order to count test suites, groups + and cases for logging purposes. This causes + the <c>post_all/3</c> hook function to always be called + twice. For this reason, side effects are best avoided in + this callback.</p> + </note> + </desc> + </func> + + <func> <name since="OTP R14B02">Module:pre_init_per_suite(SuiteName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_suite.</fsummary> <type> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index c8e0722a0f..a68cc3cca7 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,21 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.17.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + OTP internal test improvements.</p> + <p> + Own Id: OTP-15716</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.17</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -135,6 +150,72 @@ </section> +<section><title>Common_Test 1.15.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The test result when a hook function fails is in general + the same as if the function that the hook is associated + with fails. For example, if <c>post_init_per_testcase</c> + fails the result is that the test case is skipped, as is + the case when <c>init_per_testcase</c> fails.This, + however, was earlier not true for timetrap timeouts or + other error situations where the process running the hook + function was killed. This is now corrected, so the error + handling should be the same no matter how the hook + function fails.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15717 Aux Id: ERIERL-334 </p> + </item> + <item> + <p> + In some rare cases, when two common_test nodes used the + same log directory, a timing problem could occur which + caused common_test to crash because it's log cache file + was unexpectedly empty. This is now corrected.</p> + <p> + Own Id: OTP-15758 Aux Id: ERIERL-342 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Two new common_test hook functions are introduced:</p> + <p> + <c>post_groups/2</c>, which is called after + <c>Suite:groups/0</c><br/> <c>post_all/3</c>, which is + called after <c>Suite:all/0</c></p> + <p> + These functions allow modifying the return values from + the <c>groups/0</c> and <c>all/0</c> functions, + respectively.</p> + <p> + A new term, <c>{testcase,TestCase,RepeatProperties}</c> + is now also allowed in the return from <c>all/0</c>. This + can be used for repeating a single test case a specific + number of times, or until it fails or succeeds once.</p> + <p> + Own Id: OTP-14746 Aux Id: ERIERL-143 </p> + </item> + <item> + <p> + OTP internal test improvements.</p> + <p> + Own Id: OTP-15716</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.15.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 82dc06834f..5eed748b08 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -455,8 +455,10 @@ GroupDefs = [GroupDef] GroupDef = {GroupName,Properties,GroupsAndTestCases} GroupName = atom() - GroupsAndTestCases = [GroupDef | {group,GroupName} | TestCase] - TestCase = atom()</pre> + GroupsAndTestCases = [GroupDef | {group,GroupName} | TestCase | + {testcase,TestCase,TCRepeatProps}] + TestCase = atom() + TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</pre> <p><c>GroupName</c> is the name of the group and must be unique within the test suite module. Groups can be nested, by including a group definition @@ -464,11 +466,11 @@ <c>Properties</c> is the list of execution properties for the group. The possible values are as follows:</p> <pre> - Properties = [parallel | sequence | Shuffle | {RepeatType,N}] + Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}] Shuffle = shuffle | {shuffle,Seed} Seed = {integer(),integer(),integer()} - RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | - repeat_until_any_ok | repeat_until_any_fail + GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | + repeat_until_any_ok | repeat_until_any_fail N = integer() | forever</pre> <p><em>Explanations:</em></p> @@ -481,8 +483,8 @@ Dependencies Between Test Cases and Suites.</p></item> <tag><c>shuffle</c></tag> <item><p>The cases in the group are executed in random order.</p></item> - <tag><c>repeat</c></tag> - <item><p>Orders <c>Common Test</c> to repeat execution of the cases in the + <tag><c>repeat, repeat_until_*</c></tag> + <item><p>Orders <c>Common Test</c> to repeat execution of all the cases in the group a given number of times, or until any, or all, cases fail or succeed.</p></item> </taglist> @@ -496,7 +498,7 @@ <c>{group,GroupName}</c> to the <c>all/0</c> list.</p> <p><em>Example:</em></p> <pre> - all() -> [testcase1, {group,group1}, testcase2, {group,group2}].</pre> + all() -> [testcase1, {group,group1}, {testcase,testcase2,[{repeat,10}]}, {group,group2}].</pre> <p>Execution properties with a group tuple in <c>all/0</c>: <c>{group,GroupName,Properties}</c> can also be specified. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 506147474f..bce6420042 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -696,9 +696,16 @@ end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) -> end end; -end_tc(Mod,Func0,TCPid,Result,Args,Return) -> +end_tc(Mod,Func00,TCPid,Result,Args,Return) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), + {OnlyCleanup,Func0} = + case Func00 of + {cleanup,F0} -> + {true,F0}; + _ -> + {false,Func00} + end, {Func,FuncSpec,HookFunc} = case Func0 of {end_per_testcase_not_run,F} -> @@ -742,6 +749,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> case HookFunc of undefined -> {ok,Result}; + _ when OnlyCleanup -> + {ok,Result}; _ -> case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of '$ct_no_change' -> @@ -752,6 +761,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, FinalResult = case get('$test_server_framework_test') of + _ when OnlyCleanup -> + Result1; undefined -> %% send sync notification so that event handlers may print %% in the log file before it gets closed @@ -1056,21 +1067,40 @@ group_or_func(Func, _Config) -> %%% should be returned. get_suite(Mod, all) -> - case catch apply(Mod, groups, []) of - {'EXIT',_} -> - get_all(Mod, []); - GroupDefs when is_list(GroupDefs) -> - case catch ct_groups:find_groups(Mod, all, all, GroupDefs) of - {error,_} = Error -> - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Error properly - [{?MODULE,error_in_suite,[[Error]]}]; - ConfTests -> - get_all(Mod, ConfTests) - end; - _ -> + case safe_apply_groups_0(Mod,{ok,[]}) of + {ok,GroupDefs} -> + try ct_groups:find_groups(Mod, all, all, GroupDefs) of + ConfTests when is_list(ConfTests) -> + get_all(Mod, ConfTests) + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + {error,{bad_return,_Bad}} -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", - [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}] + [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]; + {error,{bad_hook_return,Bad}} -> + E = "Bad return value from post_groups/2 hook function", + [{?MODULE,error_in_suite,[[{error,{list_to_atom(E),Bad}}]]}]; + {error,{failed,ExitReason}} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:groups/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(?def_gl, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":groups/0 failed"), + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end; %%!============================================================ @@ -1080,54 +1110,74 @@ get_suite(Mod, all) -> %% group get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> - Name = ?val(name, Props), - case catch apply(Mod, groups, []) of - {'EXIT',_} -> - [Group]; - GroupDefs when is_list(GroupDefs) -> - case catch ct_groups:find_groups(Mod, Name, TCs, GroupDefs) of - {error,_} = Error -> - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Error properly - [{?MODULE,error_in_suite,[[Error]]}]; - [] -> - []; - ConfTests -> - case lists:member(skipped, Props) of - true -> - %% a *subgroup* specified *only* as skipped (and not - %% as an explicit test) should not be returned, or - %% init/end functions for top groups will be executed - case catch ?val(name, element(2, hd(ConfTests))) of - Name -> % top group - ct_groups:delete_subs(ConfTests, ConfTests); - _ -> - [] - end; - false -> - ConfTests1 = ct_groups:delete_subs(ConfTests, - ConfTests), - case ?val(override, Props) of - undefined -> - ConfTests1; - [] -> - ConfTests1; - ORSpec -> - ORSpec1 = if is_tuple(ORSpec) -> [ORSpec]; - true -> ORSpec end, - ct_groups:search_and_override(ConfTests1, - ORSpec1, Mod) - end - end - end; - _ -> + case safe_apply_groups_0(Mod,{ok,[Group]}) of + {ok,GroupDefs} -> + Name = ?val(name, Props), + try ct_groups:find_groups(Mod, Name, TCs, GroupDefs) of + [] -> + []; + ConfTests when is_list(ConfTests) -> + case lists:member(skipped, Props) of + true -> + %% a *subgroup* specified *only* as skipped (and not + %% as an explicit test) should not be returned, or + %% init/end functions for top groups will be executed + try ?val(name, element(2, hd(ConfTests))) of + Name -> % top group + ct_groups:delete_subs(ConfTests, ConfTests); + _ -> [] + catch + _:_ -> [] + end; + false -> + ConfTests1 = ct_groups:delete_subs(ConfTests, + ConfTests), + case ?val(override, Props) of + undefined -> + ConfTests1; + [] -> + ConfTests1; + ORSpec -> + ORSpec1 = if is_tuple(ORSpec) -> [ORSpec]; + true -> ORSpec end, + ct_groups:search_and_override(ConfTests1, + ORSpec1, Mod) + end + end + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + {error,{bad_return,_Bad}} -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", - [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}] + [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]; + {error,{bad_hook_return,Bad}} -> + E = "Bad return value from post_groups/2 hook function", + [{?MODULE,error_in_suite,[[{error,{list_to_atom(E),Bad}}]]}]; + {error,{failed,ExitReason}} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:groups/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(?def_gl, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":groups/0 failed"), + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end; %% testcase get_suite(Mod, Name) -> - get_seq(Mod, Name). + get_seq(Mod, Name). %%%----------------------------------------------------------------- @@ -1161,21 +1211,48 @@ get_all_cases1(_, []) -> %%%----------------------------------------------------------------- -get_all(Mod, ConfTests) -> - case catch apply(Mod, all, []) of - {'EXIT',{undef,[{Mod,all,[],_} | _]}} -> +get_all(Mod, ConfTests) -> + case safe_apply_all_0(Mod) of + {ok,AllTCs} -> + %% expand group references using ConfTests + try ct_groups:expand_groups(AllTCs, ConfTests, Mod) of + {error,_} = Error -> + [{?MODULE,error_in_suite,[[Error]]}]; + Tests0 -> + Tests = ct_groups:delete_subs(Tests0, Tests0), + expand_tests(Mod, Tests) + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + Skip = {skip,_Reason} -> + Skip; + {error,undef} -> + Reason = + case code:which(Mod) of + non_existing -> + list_to_atom( + atom_to_list(Mod)++ + " cannot be compiled or loaded"); + _ -> + list_to_atom( + atom_to_list(Mod)++":all/0 is missing") + end, + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Reason properly + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,{bad_return,_Bad}} -> Reason = - case code:which(Mod) of - non_existing -> - list_to_atom(atom_to_list(Mod)++ - " cannot be compiled or loaded"); - _ -> - list_to_atom(atom_to_list(Mod)++":all/0 is missing") - end, - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Reason properly + list_to_atom("Bad return value from "++ + atom_to_list(Mod)++":all/0"), [{?MODULE,error_in_suite,[[{error,Reason}]]}]; - {'EXIT',ExitReason} -> + {error,{bad_hook_return,Bad}} -> + Reason = + list_to_atom("Bad return value from post_all/3 hook function"), + [{?MODULE,error_in_suite,[[{error,{Reason,Bad}}]]}]; + {error,{failed,ExitReason}} -> case ct_util:get_testdata({error_in_suite,Mod}) of undefined -> ErrStr = io_lib:format("~n*** ERROR *** " @@ -1192,28 +1269,8 @@ get_all(Mod, ConfTests) -> %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Reason properly [{?MODULE,error_in_suite,[[{error,Reason}]]}]; - AllTCs when is_list(AllTCs) -> - case catch save_seqs(Mod,AllTCs) of - {error,What} -> - [{?MODULE,error_in_suite,[[{error,What}]]}]; - SeqsAndTCs -> - %% expand group references in all() using ConfTests - case catch ct_groups:expand_groups(SeqsAndTCs, - ConfTests, - Mod) of - {error,_} = Error -> - [{?MODULE,error_in_suite,[[Error]]}]; - Tests -> - ct_groups:delete_subs(Tests, Tests) - end - end; - Skip = {skip,_Reason} -> - Skip; - _ -> - Reason = - list_to_atom("Bad return value from "++ - atom_to_list(Mod)++":all/0"), - [{?MODULE,error_in_suite,[[{error,Reason}]]}] + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end. %%!============================================================ @@ -1571,3 +1628,74 @@ get_html_wrapper(TestName, PrintLabel, Cwd, TableCols, Encoding) -> %%% -spec get_log_dir() -> {ok,LogDir} get_log_dir() -> ct_logs:get_log_dir(true). + +%%%----------------------------------------------------------------- +%%% Call all and group callbacks and post_* hooks with error handling +safe_apply_all_0(Mod) -> + try apply(Mod, all, []) of + AllTCs0 when is_list(AllTCs0) -> + try save_seqs(Mod,AllTCs0) of + SeqsAndTCs when is_list(SeqsAndTCs) -> + all_hook(Mod,SeqsAndTCs) + catch throw:{error,What} -> + {error,What} + end; + {skip,_}=Skip -> + all_hook(Mod,Skip); + Bad -> + {error,{bad_return,Bad}} + catch + _:Reason:Stacktrace -> + handle_callback_crash(Reason,Stacktrace,Mod,all,{error,undef}) + end. + +all_hook(Mod, All) -> + case ct_hooks:all(Mod, All) of + AllTCs when is_list(AllTCs) -> + {ok,AllTCs}; + {skip,_}=Skip -> + Skip; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end. + +safe_apply_groups_0(Mod,Default) -> + try apply(Mod, groups, []) of + GroupDefs when is_list(GroupDefs) -> + case ct_hooks:groups(Mod, GroupDefs) of + GroupDefs1 when is_list(GroupDefs1) -> + {ok,GroupDefs1}; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end; + Bad -> + {error,{bad_return,Bad}} + catch + _:Reason:Stacktrace -> + handle_callback_crash(Reason,Stacktrace,Mod,groups,Default) + end. + +handle_callback_crash(undef,[{Mod,Func,[],_}|_],Mod,Func,Default) -> + case ct_hooks:Func(Mod, []) of + [] -> + Default; + List when is_list(List) -> + {ok,List}; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end; +handle_callback_crash(Reason,Stacktrace,_Mod,_Func,_Default) -> + {error,{failed,{Reason,Stacktrace}}}. + +expand_tests(Mod, [{testcase,Case,[Prop]}|Tests]) -> + [{repeat,{Mod,Case},Prop}|expand_tests(Mod,Tests)]; +expand_tests(Mod,[Test|Tests]) -> + [Test|expand_tests(Mod,Tests)]; +expand_tests(_Mod,[]) -> + []. diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index d867069dce..f4b12c41c0 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -101,23 +101,34 @@ find(Mod, [], TCs, Tests, _Known, _Defs, false) -> [{Mod,TC}]; ({group,_}) -> []; + ({testcase,TC,[Prop]}) when is_atom(TC), TC ==all -> + [{repeat,{Mod,TC},Prop}]; ({_,_}=TC) when TCs == all -> [TC]; - (TC) -> - if is_atom(TC) -> - Tuple = {Mod,TC}, - case lists:member(Tuple, TCs) of - true -> - [Tuple]; - false -> - case lists:member(TC, TCs) of - true -> [{Mod,TC}]; - false -> [] - end - end; - true -> - [] - end + (TC) when is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + [Tuple]; + false -> + case lists:member(TC, TCs) of + true -> [Tuple]; + false -> [] + end + end; + ({testcase,TC,[Prop]}) when is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + [{repeat,Tuple,Prop}]; + false -> + case lists:member(TC, TCs) of + true -> [{repeat,Tuple,Prop}]; + false -> [] + end + end; + (_) -> + [] end, Tests), if Cases == [] -> ['NOMATCH']; true -> Cases @@ -172,12 +183,19 @@ find(Mod, GrNames, all, [{M,TC} | Gs], Known, Defs, FindAll) when is_atom(M), M /= group, is_atom(TC) -> [{M,TC} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; +%% Save test case +find(Mod, GrNames, all, [{testcase,TC,[Prop]} | Gs], Known, + Defs, FindAll) when is_atom(TC) -> + [{repeat,{Mod,TC},Prop} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; + %% Check if test case should be saved -find(Mod, GrNames, TCs, [TC | Gs], Known, - Defs, FindAll) when is_atom(TC) orelse - ((size(TC) == 2) and (element(1,TC) /= group)) -> +find(Mod, GrNames, TCs, [TC | Gs], Known, Defs, FindAll) + when is_atom(TC) orelse + ((size(TC) == 3) andalso (element(1,TC) == testcase)) orelse + ((size(TC) == 2) and (element(1,TC) /= group)) -> Case = - if is_atom(TC) -> + case TC of + _ when is_atom(TC) -> Tuple = {Mod,TC}, case lists:member(Tuple, TCs) of true -> @@ -188,7 +206,18 @@ find(Mod, GrNames, TCs, [TC | Gs], Known, false -> [] end end; - true -> + {testcase,TC0,[Prop]} when is_atom(TC0) -> + Tuple = {Mod,TC0}, + case lists:member(Tuple, TCs) of + true -> + {repeat,Tuple,Prop}; + false -> + case lists:member(TC0, TCs) of + true -> {repeat,{Mod,TC0},Prop}; + false -> [] + end + end; + _ -> case lists:member(TC, TCs) of true -> {Mod,TC}; false -> [] @@ -289,12 +318,22 @@ modify_tc_list(GrSpecTs, TSCs, []) -> modify_tc_list1(GrSpecTs, TSCs); modify_tc_list(GrSpecTs, _TSCs, _) -> - [Test || Test <- GrSpecTs, not is_atom(Test)]. + [Test || Test <- GrSpecTs, not is_atom(Test), element(1,Test)=/=testcase]. modify_tc_list1(GrSpecTs, TSCs) -> %% remove all cases in group tc list that should not be executed GrSpecTs1 = - lists:flatmap(fun(Test) when is_tuple(Test), + lists:flatmap(fun(Test={testcase,TC,_}) -> + case lists:keysearch(TC, 2, TSCs) of + {value,_} -> + [Test]; + _ -> + case lists:member(TC, TSCs) of + true -> [Test]; + false -> [] + end + end; + (Test) when is_tuple(Test), (size(Test) > 2) -> [Test]; (Test={group,_}) -> diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 49587b3edd..97c349578f 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -22,6 +22,8 @@ %% API Exports -export([init/1]). +-export([groups/2]). +-export([all/2]). -export([init_tc/3]). -export([end_tc/5]). -export([terminate/1]). @@ -37,7 +39,8 @@ opts = [], prio = ctfirst }]). --record(ct_hook_config, {id, module, prio, scope, opts = [], state = []}). +-record(ct_hook_config, {id, module, prio, scope, opts = [], + state = [], groups = []}). %% ------------------------------------------------------------------------- %% API Functions @@ -49,6 +52,48 @@ init(Opts) -> call(get_builtin_hooks(Opts) ++ get_new_hooks(Opts, undefined), ok, init, []). +%% Call the post_groups/2 hook callback +groups(Mod, Groups) -> + Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of + CTHooks when is_list(CTHooks) -> + [{?config_name,CTHooks}]; + CTHook when is_atom(CTHook) -> + [{?config_name,[CTHook]}] + catch _:_ -> + %% since this might be the first time Mod:suite() + %% is called, and it might just fail or return + %% something bad, we allow any failure here - it + %% will be catched later if there is something + %% really wrong. + [{?config_name,[]}] + end, + case call(fun call_generic/3, Info ++ [{'$ct_groups',Groups}], [post_groups, Mod]) of + [{'$ct_groups',NewGroups}] -> + NewGroups; + Other -> + Other + end. + +%% Call the post_all/3 hook callback +all(Mod, Tests) -> + Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of + CTHooks when is_list(CTHooks) -> + [{?config_name,CTHooks}]; + CTHook when is_atom(CTHook) -> + [{?config_name,[CTHook]}] + catch _:_ -> + %% just allow any failure here - it will be catched + %% later if there is something really wrong. + [{?config_name,[]}] + end, + case call(fun call_generic/3, Info ++ [{'$ct_all',Tests}], [post_all, Mod]) of + [{'$ct_all',NewTests}] -> + NewTests; + Other -> + Other + end. + +%% Called after all suites are done. -spec terminate(Hooks :: term()) -> ok. terminate(Hooks) -> @@ -80,6 +125,7 @@ init_tc(Mod, init_per_suite, Config) -> [{?config_name,[]}] end, call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]); + 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) -> @@ -153,7 +199,7 @@ call_id(#ct_hook_config{ module = Mod, opts = Opts} = Hook, Config, Scope) -> {Config, Hook#ct_hook_config{ id = Id, scope = scope(Scope)}}. call_init(#ct_hook_config{ module = Mod, opts = Opts, id = Id, prio = P} = Hook, - Config,_Meta) -> + Config, _Meta) -> case Mod:init(Id, Opts) of {ok, NewState} when P =:= undefined -> {Config, Hook#ct_hook_config{ state = NewState, prio = 0 } }; @@ -184,6 +230,18 @@ call_generic(Hook, Value, Meta) -> call_generic_fallback(Hook, Value, Meta) -> do_call_generic(Hook, Value, Meta, true). +do_call_generic(#ct_hook_config{ module = Mod} = Hook, + [{'$ct_groups',Groups}], [post_groups | Args], Fallback) -> + NewGroups = catch_apply(Mod, post_groups, Args ++ [Groups], + Groups, Fallback), + {[{'$ct_groups',NewGroups}], Hook#ct_hook_config{ groups = NewGroups } }; + +do_call_generic(#ct_hook_config{ module = Mod, groups = Groups} = Hook, + [{'$ct_all',Tests}], [post_all | Args], Fallback) -> + NewTests = catch_apply(Mod, post_all, Args ++ [Tests, Groups], + Tests, Fallback), + {[{'$ct_all',NewTests}], Hook}; + do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, Value, [Function | Args], Fallback) -> {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], @@ -218,6 +276,12 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> Rest ++ [{NewId, call_init}]}; ExistingHook when is_tuple(ExistingHook) -> {Hooks, Rest}; + _ when hd(Meta)=:=post_groups; hd(Meta)=:=post_all -> + %% If CTH is started because of a call from + %% groups/2 or all/2, CTH:init/1 must not be + %% called (the suite scope should be used). + {Hooks ++ [NewHook], + Rest ++ [{NewId,NextFun}]}; _ -> {Hooks ++ [NewHook], Rest ++ [{NewId, call_init}, {NewId,NextFun}]} @@ -226,8 +290,8 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> catch Error:Reason:Trace -> ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp", [Error,{Reason,Trace}]), - call([], {fail,"Failed to start CTH" - ", see the CT Log for details"}, Meta, Hooks) + call([], {fail,"Failed to start CTH, " + "see the CT Log for details"}, Meta, Hooks) end; call([{HookId, call_init} | Rest], Config, Meta, Hooks) -> call([{HookId, fun call_init/3} | Rest], Config, Meta, Hooks); @@ -267,6 +331,10 @@ scope([pre_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; scope([post_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; +scope([post_groups, SuiteName|_]) -> + [post_groups, SuiteName]; +scope([post_all, SuiteName|_]) -> + [post_all, SuiteName]; scope(init) -> none. @@ -353,6 +421,7 @@ resort(Calls,Hooks,[F|_R]) when F == pre_end_per_testcase; F == pre_end_per_suite; F == post_end_per_suite -> lists:reverse(resort(Calls,Hooks)); + resort(Calls,Hooks,_Meta) -> resort(Calls,Hooks). diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 814b80b8bd..ca262b350f 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -149,7 +149,7 @@ close(Info, StartDir) -> ok; CacheBin -> %% save final version of the log cache to file - _ = file:write_file(?log_cache_name,CacheBin), + write_log_cache(CacheBin), put(ct_log_cache,undefined) end end, @@ -2022,7 +2022,7 @@ update_all_runs_in_cache(AllRunsData) -> %% read from file as long as this logger process is alive put(ct_log_cache,term_to_binary(LogCache)); _ -> - file:write_file(?log_cache_name,term_to_binary(LogCache)) + write_log_cache(term_to_binary(LogCache)) end; SavedLogCache -> update_all_runs_in_cache(AllRunsData,binary_to_term(SavedLogCache)) @@ -2036,7 +2036,7 @@ update_all_runs_in_cache(AllRunsData, LogCache) -> %% read from file as long as this logger process is alive put(ct_log_cache,term_to_binary(LogCache1)); _ -> - file:write_file(?log_cache_name,term_to_binary(LogCache1)) + write_log_cache(term_to_binary(LogCache1)) end. sort_all_runs(Dirs) -> @@ -2668,7 +2668,7 @@ update_tests_in_cache(TempData,LogCache=#log_cache{tests=Tests}) -> {_Pid,_Pid} -> put(ct_log_cache,CacheBin); _ -> - file:write_file(?log_cache_name,CacheBin) + write_log_cache(CacheBin) end. %% @@ -3400,3 +3400,9 @@ unexpected_io(Pid, _Category, _Importance, Content, CtLogFd, EscChars) -> Data = io_lib:format("~ts", [lists:foldl(IoFun, [], Content)]), test_server_io:print_unexpected(Data), ok. + +write_log_cache(LogCacheBin) when is_binary(LogCacheBin) -> + TmpFile = ?log_cache_name++".tmp", + _ = file:write_file(TmpFile,LogCacheBin), + _ = file:rename(TmpFile,?log_cache_name), + ok. diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 9eda3f2152..756cd4d692 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -384,8 +384,8 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> {Result,DetFail,ProcBef,ProcAft}. -type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | - 'end_per_testcase' | {'framework',atom(),atom()} | - 'tc'. + 'end_per_testcase' | {'framework',{atom(),atom(),list}} | + 'tc'. -record(st, { ref :: reference(), @@ -653,8 +653,8 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> #st{config=Config,mf={Mod,Func},pid=Pid} = St, spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), St; -handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, - config=Config,pid=Pid}=St) -> +handle_tc_exit(Reason, #st{status={framework,{FwMod,FwFunc,_}=FwMFA}, + config=Config,mf={Mod,Func},pid=Pid}=St) -> R = case Reason of {timetrap_timeout,TVal,_} -> {timetrap,TVal}; @@ -666,7 +666,7 @@ handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, Other end, Error = {framework_error,R}, - spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()), + spawn_fw_call(Mod, Func, Config, Pid, {Error,FwMFA}, unknown, self()), St; handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) when is_list(Config0) -> @@ -870,22 +870,48 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid, end, spawn_link(FwCall); -spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> +spawn_fw_call(Mod,Func,Conf,Pid,{{framework_error,FwError}, + {FwMod,FwFunc,[A1,A2|_]}=FwMFA},_,SendTo) -> FwCall = fun() -> ct_util:mark_process(), - test_server_sup:framework_call(report, [framework_error, - {{FwMod,FwFunc}, - FwError}]), + Time = + case FwError of + {timetrap,TVal} -> + TVal/1000; + _ -> + died + end, + {Ret,Loc,WarnOrError} = + cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,FwMFA), Comment = - lists:flatten( - io_lib:format("<font color=\"red\">" - "WARNING! ~w:~tw failed!</font>", - [FwMod,FwFunc])), + case WarnOrError of + warn -> + group_leader() ! + {printout,12, + "WARNING! ~w:~tw(~w,~tw,...) failed!\n" + " Reason: ~tp\n", + [FwMod,FwFunc,A1,A2,FwError]}, + lists:flatten( + io_lib:format("<font color=\"red\">" + "WARNING! ~w:~tw(~w,~tw,...) " + "failed!</font>", + [FwMod,FwFunc,A1,A2])); + error -> + group_leader() ! + {printout,12, + "Error! ~w:~tw(~w,~tw,...) failed!\n" + " Reason: ~tp\n", + [FwMod,FwFunc,A1,A2,FwError]}, + lists:flatten( + io_lib:format("<font color=\"red\">" + "ERROR! ~w:~tw(~w,~tw,...) " + "failed!</font>", + [FwMod,FwFunc,A1,A2])) + end, %% finished, report back SendTo ! {self(),fw_notify_done, - {died,{error,{FwMod,FwFunc,FwError}}, - {FwMod,FwFunc},[],Comment}} + {Time,Ret,Loc,[],Comment}} end, spawn_link(FwCall); @@ -930,6 +956,163 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> end, spawn_link(FwCall). +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=init_tc, + [Mod,{init_per_testcase,Func}=IPTC|_]}) -> + %% Failed during pre_init_per_testcase, the test must be skipped + Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, + try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[Conf]}, FwError), + do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, + [Conf],{ok,[Conf]}), + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,Skip,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {Skip,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=end_tc,[Mod,{init_per_testcase,Func}|_]}) -> + %% Failed during post_init_per_testcase, the test must be skipped + Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, + try begin do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, + [Conf],{ok,[Conf]}), + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,Skip,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {Skip,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=init_tc,[Mod,{end_per_testcase,Func}|_]}) -> + %% Failed during pre_end_per_testcase. Warn about it. + {RetVal,Loc} = + case {proplists:get_value(tc_status, Conf), + proplists:get_value(tc_fail_loc, Conf, unknown)} of + {undefined,_} -> + {{failed,{FwMod,FwFunc,FwError}},{FwMod,FwFunc}}; + {E = {failed,_Reason},unknown} -> + {E,[{Mod,Func}]}; + {Result,FailLoc} -> + {Result,FailLoc} + end, + try begin do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,RetVal,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,Loc,warn}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError, + {FwMod,FwFunc=end_tc,[Mod,{end_per_testcase,Func}|_]}) -> + %% Failed during post_end_per_testcase. Warn about it. + {RetVal,Report,Loc} = + case {proplists:get_value(tc_status, Conf), + proplists:get_value(tc_fail_loc, Conf, unknown)} of + {undefined,_} -> + {{failed,{FwMod,FwFunc,FwError}}, + {{FwMod,FwError},FwError}, + {FwMod,FwFunc}}; + {E = {failed,_Reason},unknown} -> + {E,{Mod,Func,E},[{Mod,Func}]}; + {Result,FailLoc} -> + {Result,{Mod,Func,Result},FailLoc} + end, + try begin do_end_tc_call(Mod,{cleanup,{end_per_testcase_not_run,Func}}, + {Pid,RetVal,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + test_server_sup:framework_call(report,[framework_error,Report]), + {RetVal,Loc,warn}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) + when Func =:= init_per_suite; Func =:=init_per_group -> + %% Failed during pre_init_per_suite or pre_init_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) + when Func =:= init_per_suite; Func =:=init_per_group -> + %% Failed during post_init_per_suite or post_init_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + ReportFunc = + case Func of + init_per_group -> + case proplists:get_value(tc_group_properties,Conf) of + undefined -> + {Func,unknown,[]}; + GProps -> + Name = proplists:get_value(name,GProps), + {Func,Name,proplists:delete(name,GProps)} + end; + _ -> + Func + end, + test_server_sup:framework_call(report,[framework_error, + {Mod,ReportFunc,RetVal}]), + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) + when Func =:= end_per_suite; Func =:=end_per_group -> + %% Failed during pre_end_per_suite or pre_end_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) + when Func =:= end_per_suite; Func =:=end_per_group -> + %% Failed during post_end_per_suite or post_end_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + ReportFunc = + case Func of + end_per_group -> + case proplists:get_value(tc_group_properties,Conf) of + undefined -> + {Func,unknown,[]}; + GProps -> + Name = proplists:get_value(name,GProps), + {Func,Name,proplists:delete(name,GProps)} + end; + _ -> + Func + end, + test_server_sup:framework_call(report,[framework_error, + {Mod,ReportFunc,RetVal}]), + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,_Conf,_Pid,FwError,{FwMod,FwFunc,_}) -> + %% This is unexpected + test_server_sup:framework_call(report, + [framework_error, + {{FwMod,FwFunc}, + FwError}]), + {FwError,{FwMod,FwFunc},error}. + %% The job proxy process forwards messages between the test case %% process on a shielded node (and its descendants) and the job process. %% @@ -1105,6 +1288,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), + %% save updated config in controller loop + set_tc_state(tc, EndConf1), + %% We can't handle fails or skips here EndConf2 = case do_init_tc_call(Mod,{end_per_testcase,Func}, diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 1518c6e8d6..003d08d70d 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -1443,6 +1443,8 @@ remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) -> true -> remove_conf(Cases, [C|NoConf], Repeats) end; +remove_conf([C={repeat,_,_}|Cases], NoConf, _Repeats) -> + remove_conf(Cases, [C|NoConf], true); remove_conf([C|Cases], NoConf, Repeats) -> remove_conf(Cases, [C|NoConf], Repeats); remove_conf([], NoConf, true) -> @@ -2061,6 +2063,14 @@ add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod) [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; +add_init_and_end_per_suite([{repeat,{Mod,_},_}=Case|Cases], LastMod, LastRef, FwMod) + when Mod =/= LastMod, Mod =/= FwMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; +add_init_and_end_per_suite([{repeat,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod -> {PreCases, NextMod, NextRef} = @@ -2138,7 +2148,7 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> %% 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,Mod}], + [{conf,LastRef,[{suite,LastMod}], {FwMod,end_per_suite}}|Init]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] @@ -2926,6 +2936,29 @@ run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0], Config, _TimetrapData, _Mode, _Status) -> erlang:error(badarg, [Conf,Config]); +run_test_cases_loop([{repeat,Case,{RepeatType,N}}|Cases0], Config, + TimeTrapData, Mode, Status) -> + Ref = make_ref(), + Parallel = check_prop(parallel, Mode) =/= false, + Sequence = check_prop(sequence, Mode) =/= false, + RepeatStop = RepeatType=:=repeat_until_fail + orelse RepeatType=:=repeat_until_ok, + + if Parallel andalso RepeatStop -> + %% Cannot check results of test case during parallal + %% execution, so only RepeatType=:=repeat is allowed in + %% combination with parallel groups. + erlang:error({illegal_combination,{parallel,RepeatType}}); + Sequence andalso RepeatStop -> + %% Sequence is stop on fail + skip rest, so only + %% RepeatType=:=repeat makes sense inside a sequence. + erlang:error({illegal_combination,{sequence,RepeatType}}); + true -> + Mode1 = [{Ref,[{repeat,{RepeatType,1,N}}],?now}|Mode], + run_test_cases_loop([Case | Cases0], Config, TimeTrapData, + Mode1, Status) + end; + run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> ActualCfg = case get(test_server_create_priv_dir) of @@ -2938,7 +2971,7 @@ run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config, TimetrapData, Mode, Status); -run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) -> +run_test_cases_loop([{Mod,Func,Args}=Case|Cases], Config, TimetrapData, Mode0, Status) -> {Num,RunInit} = case FwMod = get_fw_mod(?MODULE) of Mod when Func == error_in_suite -> @@ -2948,6 +2981,14 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) run_init} end, + Mode = + case Mode0 of + [{_,[{repeat,{_,_,_}}],_}|RestMode] -> + RestMode; + _ -> + Mode0 + end, + %% check the current execution mode and save info about the case if %% detected that printouts to common log files is handled later @@ -2975,36 +3016,42 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) if is_tuple(RetVal) -> element(1,RetVal); true -> undefined end, - {Failed,Status1} = + {Result,Failed,Status1} = case RetTag of Skip when Skip==skip; Skip==skipped -> - {false,update_status(skipped, Mod, Func, Status)}; + {skipped,false,update_status(skipped, Mod, Func, Status)}; Fail when Fail=='EXIT'; Fail==failed -> - {true,update_status(failed, Mod, Func, Status)}; + {failed,true,update_status(failed, Mod, Func, Status)}; _ when Time==died, RetVal=/=ok -> - {true,update_status(failed, Mod, Func, Status)}; + {failed,true,update_status(failed, Mod, Func, Status)}; _ -> - {false,update_status(ok, Mod, Func, Status)} + {ok,false,update_status(ok, Mod, Func, Status)} end, case check_prop(sequence, Mode) of false -> + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), stop_minor_log_file(), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1); Ref -> %% the case is in a sequence; we must check the result and %% determine if the following cases should run or be skipped if not Failed -> % proceed with next case + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), stop_minor_log_file(), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1); true -> % skip rest of cases in sequence print(minor, "~n*** ~tw failed.~n" " Skipping all other cases in sequence.", [Func]), + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), Reason = {failed,{Mod,Func}}, - Cases2 = skip_cases_upto(Ref, Cases, Reason, tc, + Cases2 = skip_cases_upto(Ref, Cases1, Reason, tc, Mode, auto_skip_case), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1) + run_test_cases_loop(Cases2, Config, TimetrapData, Mode1, Status1) end end; %% the test case is being executed in parallel with the main process (and @@ -3013,7 +3060,8 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) %% io from Pid will be buffered by the test_server_io process and %% handled later, so we have to save info about the case queue_test_case_io(undefined, Pid, Num+1, Mod, Func), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status) + {Cases1,Mode1} = check_repeat_testcase(Case,ok,Cases,Mode0), + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status) end; %% TestSpec processing finished @@ -3452,9 +3500,19 @@ modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType}, T, Orig, Alt) end; -%% next is some other case, ignore or copy -modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_Other|T], Orig, Alt) -> +%% next is a repeated test case +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op, + [{repeat,{_M,_F}=MF,_Repeat}|T], Orig, Alt) -> + modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{MF,Reason},Mode}|Alt]); + +%% next is an already skipped case, ignore or copy +modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [{SkipType,_,_}|T], Orig, Alt) + when SkipType=:=skip_case; SkipType=:=auto_skip_case -> modify_cases_upto1(Ref, Op, T, Orig, Alt); + +%% next is some other case, mark as skipped or copy +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op, [Other|T], Orig, Alt) -> + modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{Other,Reason},Mode}|Alt]); modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) -> modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]). @@ -3842,6 +3900,10 @@ 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={auto_skip,_Why}} -> + %% died in init_per_testcase or in a hook in this context + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); {died,{Skip,Reason}} when Skip==skip; Skip==skipped -> %% died in init_per_testcase progress(skip, Num, Mod, Func, GrName, Loc, Reason, @@ -4800,6 +4862,14 @@ collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) -> {error,_Reason} = Error -> Error end; +collect_cases({repeat,{Module, Case}, Repeat}, St, Mode) -> + case catch collect_case([Case], St#cc{mod=Module}, [], Mode) of + {ok, [{Module,Case}], _} -> + {ok, [{repeat,{Module, Case}, Repeat}], St}; + Other -> + {error,Other} + end; + collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of Result = {ok,_,_} -> @@ -5763,3 +5833,42 @@ encoding(File) -> E -> E end. + +check_repeat_testcase(Case,Result,Cases, + [{Ref,[{repeat,RepeatData0}],StartTime}|Mode0]) -> + case do_update_repeat_data(Result,RepeatData0) of + false -> + {Cases,Mode0}; + RepeatData -> + {[Case|Cases],[{Ref,[{repeat,RepeatData}],StartTime}|Mode0]} + end; +check_repeat_testcase(_,_,Cases,Mode) -> + {Cases,Mode}. + +do_update_repeat_data(_,{RT,N,N}) when is_integer(N) -> + report_repeat_testcase(N,N), + report_stop_repeat_testcase(done,{RT,N}), + false; +do_update_repeat_data(ok,{repeat_until_ok=RT,M,N}) -> + report_repeat_testcase(M,N), + report_stop_repeat_testcase(RT,{RT,N}), + false; +do_update_repeat_data(failed,{repeat_until_fail=RT,M,N}) -> + report_repeat_testcase(M,N), + report_stop_repeat_testcase(RT,{RT,N}), + false; +do_update_repeat_data(_,{RT,M,N}) when is_integer(M) -> + report_repeat_testcase(M,N), + {RT,M+1,N}; +do_update_repeat_data(_,{_,M,N}=RepeatData) -> + report_repeat_testcase(M,N), + RepeatData. + +report_stop_repeat_testcase(Reason,RepVal) -> + print(minor, "~n*** Stopping test case repeat operation: ~w", [Reason]), + print(1, "Stopping test case repeat operation: ~w", [RepVal]). + +report_repeat_testcase(M,forever) -> + print(minor, "~n=== Repeated test case: ~w of infinity", [M]); +report_repeat_testcase(M,N) -> + print(minor, "~n=== Repeated test case: ~w of ~w", [M,N]). diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index c11b9071cf..f77d5a4966 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(test_server_node). --compile(r16). +-compile(r20). %%% %%% The same compiled code for this module must be possible to load diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index 26e7534c6c..ab8066a88d 100644 --- a/lib/common_test/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl @@ -770,7 +770,7 @@ framework_call(Callback,Func,Args,DefaultReturn) -> end, case SetTcState of true -> - test_server:set_tc_state({framework,Mod,Func}); + test_server:set_tc_state({framework,{Mod,Func,Args}}); false -> ok end, diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index ecd1f727a2..e510b74d6a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -74,7 +74,9 @@ MODULES= \ ct_SUITE \ ct_keep_logs_SUITE \ ct_unicode_SUITE \ - ct_auto_clean_SUITE + ct_auto_clean_SUITE \ + ct_util_SUITE \ + ct_tc_repeat_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 7468ebe9d9..d31bd26273 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -648,33 +648,35 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_11_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_12_SUITE,tc1}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,{timetrap,500}}}}, - {?eh,test_stats,{13,8,{0,19}}}, + {?eh,tc_done,{cfg_error_12_SUITE,tc1, + {auto_skipped, + {failed,{ct_framework,init_tc,{timetrap,500}}}}}}, + {?eh,test_stats,{13,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc2}}, {?eh,tc_done,{cfg_error_12_SUITE,tc2,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{14,8,{0,19}}}, + {?eh,test_stats,{14,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc3}}, {?eh,tc_done,{cfg_error_12_SUITE,tc3,ok}}, - {?eh,test_stats,{15,8,{0,19}}}, + {?eh,test_stats,{15,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc4}}, {?eh,tc_done,{cfg_error_12_SUITE,tc4,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{16,8,{0,19}}}, + {?eh,test_stats,{16,7,{0,20}}}, {?eh,tc_start,{cfg_error_13_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_13_SUITE,tc1}}, {?eh,tc_done,{cfg_error_13_SUITE,tc1,ok}}, - {?eh,test_stats,{17,8,{0,19}}}, + {?eh,test_stats,{17,7,{0,20}}}, {?eh,tc_start,{cfg_error_13_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,tc1}}, {?eh,tc_done,{cfg_error_14_SUITE,tc1,ok}}, - {?eh,test_stats,{18,8,{0,19}}}, + {?eh,test_stats,{18,7,{0,20}}}, {?eh,tc_start,{cfg_error_14_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,end_per_suite, {comment, @@ -728,25 +730,30 @@ test_events(lib_error) -> {lib_error_1_SUITE,no_lines_throw,{failed,{error,{thrown,catch_me_if_u_can}}}}}, {?eh,test_stats,{0,8,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_error}}, - {?eh,tc_done,{ct_framework,init_tc, - {framework_error,{{badmatch,[1,2]},'_'}}}}, - {?eh,test_stats,{0,9,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_error, + {auto_skipped, + {failed, + {ct_framework,init_tc, + {{badmatch,[1,2]},'_'}}}}}}, + {?eh,test_stats,{0,8,{0,1}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_exit}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,byebye}}}, - {?eh,test_stats,{0,10,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_exit, + {auto_skipped,{failed,{ct_framework,init_tc,byebye}}}}}, + {?eh,test_stats,{0,8,{0,2}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_throw}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,catch_me_if_u_can}}}, - {?eh,test_stats,{0,11,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_throw, + {auto_skipped,{failed,{ct_framework,init_tc, + catch_me_if_u_can}}}}}, + {?eh,test_stats,{0,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_error}}, - {?eh,tc_done,{ct_framework,end_tc, - {framework_error,{{badmatch,[1,2]},'_'}}}}, - {?eh,test_stats,{0,12,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_error,ok}}, % warning in comment + {?eh,test_stats,{1,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_exit}}, - {?eh,tc_done,{ct_framework,end_tc,{framework_error,byebye}}}, - {?eh,test_stats,{0,13,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_exit,ok}}, % warning in comment + {?eh,test_stats,{2,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_throw}}, - {?eh,tc_done,{ct_framework,end_tc,{framework_error,catch_me_if_u_can}}}, - {?eh,test_stats,{0,14,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_throw,ok}}, % warning in comment + {?eh,test_stats,{3,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_per_suite}}, {?eh,tc_done,{lib_error_1_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 44b86b1dfe..340b8f3d52 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -73,11 +73,15 @@ all() -> all(suite) -> lists:reverse( [ + crash_groups, crash_all, bad_return_groups, bad_return_all, + illegal_values_groups, illegal_values_all, alter_groups, alter_all, + alter_all_to_skip, alter_all_from_skip, one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init, faulty_cth_exit_in_init, faulty_cth_exit_in_id, faulty_cth_exit_in_init_scope_suite, minimal_cth, minimal_and_maximal_cth, faulty_cth_undef, scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, + scope_suite_group_only_cth, scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, @@ -152,6 +156,11 @@ scope_suite_cth(Config) when is_list(Config) -> do_test(scope_suite_cth, "ct_scope_suite_cth_SUITE.erl", [],Config). +scope_suite_group_only_cth(Config) when is_list(Config) -> + do_test(scope_suite_group_only_cth, + "ct_scope_suite_group_only_cth_SUITE.erl", + [],Config,ok,2,[{group,g1}]). + scope_per_group_cth(Config) when is_list(Config) -> do_test(scope_per_group_cth, "ct_scope_per_group_cth_SUITE.erl", [],Config). @@ -304,10 +313,74 @@ repeat_force_stop(Config) -> [{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 +%% fails due to clash in config alias names config_clash(Config) -> do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config). +%% Test post_groups and post_all hook callbacks, introduced by OTP-14746 +alter_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_groups_return,[{new_group,[tc1,tc2]}]}, + {post_all_return,[{group,new_group}]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,[tc2]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all_from_skip(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{all_return,{skip,"skipped by all/0"}}, + {post_all_return,[tc2]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all_to_skip(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_all_return,{skip,"skipped by post_all/3"}}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +bad_return_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_groups_return,not_a_list}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +bad_return_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,not_a_list}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +illegal_values_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_groups_return,[{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +illegal_values_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_all_return,[{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}]}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +crash_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_groups_return,crash}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +crash_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,crash}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -327,6 +400,7 @@ do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) -> 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), @@ -352,6 +426,13 @@ reformat(Events, EH) -> %reformat(Events, _EH) -> % Events. +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- @@ -370,13 +451,16 @@ test_events(one_empty_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{empty_cth,id,[[]]}}, {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + %% check that post_groups and post_all comes after init when hook + %% is installed with start flag/option. + {?eh,cth,{empty_cth,post_groups,[ct_cth_empty_SUITE,[]]}}, + {?eh,cth,{empty_cth,post_all,[ct_cth_empty_SUITE,[test_case],[]]}}, {?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','_',[]]}}, @@ -585,6 +669,10 @@ test_events(scope_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + %% check that post_groups and post_all comes before init when hook + %% is installed in suite/0 + {?eh,cth,{'_',post_groups,['_',[]]}}, + {?eh,cth,{'_',post_all,['_','_',[]]}}, {?eh,tc_start,{ct_scope_suite_cth_SUITE,init_per_suite}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, @@ -606,6 +694,34 @@ test_events(scope_suite_cth) -> {?eh,stop_logging,[]} ]; +test_events(scope_suite_group_only_cth) -> + Suite = ct_scope_suite_group_only_cth_SUITE, + CTH = empty_cth, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,1}}, + %% check that post_groups and post_all comes before init when hook + %% is installed in suite/0 + {?eh,cth,{CTH,post_groups,['_',['_']]}}, + {negative, + {?eh,cth,{CTH,post_all,['_','_','_']}}, + {?eh,tc_start,{Suite,init_per_suite}}}, + {?eh,cth,{CTH,id,[[]]}}, + {?eh,cth,{CTH,init,['_',[]]}}, + {?eh,cth,{CTH,pre_init_per_suite,[Suite,'$proplist',mystate]}}, + {?eh,cth,{CTH,post_init_per_suite,[Suite,'$proplist','$proplist',mystate]}}, + {?eh,tc_done,{Suite,init_per_suite,ok}}, + + {?eh,tc_start,{Suite,end_per_suite}}, + {?eh,cth,{CTH,pre_end_per_suite,[Suite,'$proplist',mystate]}}, + {?eh,cth,{CTH,post_end_per_suite,[Suite,'$proplist','_',mystate]}}, + {?eh,cth,{CTH,terminate,[mystate]}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + test_events(scope_per_group_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, @@ -665,6 +781,8 @@ test_events(scope_suite_state_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',post_groups,['_',[]]}}, + {?eh,cth,{'_',post_all,['_','_',[]]}}, {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,init_per_suite}}, {?eh,cth,{'_',id,[[test]]}}, {?eh,cth,{'_',init,['_',[test]]}}, @@ -2313,6 +2431,229 @@ test_events(config_clash) -> %% Make sure no 'cth_error' events are received! [{negative,{?eh,cth_error,'_'},E} || E <- Events]; +test_events(alter_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{new_group,[tc1,tc2]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[{group,new_group}], + [{new_group,[tc1,tc2]}]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{new_group,[tc1,tc2]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[{group,new_group}], + [{new_group,[tc1,tc2]}]]}}, + {?eh,tc_start,{all_and_groups_SUITE,{init_per_group,new_group,[]}}}, + {?eh,tc_done,{all_and_groups_SUITE, + {init_per_group,new_group,'$proplist'},ok}}, + {?eh,tc_start,{all_and_groups_SUITE,tc1}}, + {?eh,tc_done,{all_and_groups_SUITE,tc1,ok}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,tc_start,{all_and_groups_SUITE,{end_per_group,new_group,[]}}}, + {?eh,tc_done,{all_and_groups_SUITE, + {end_per_group,new_group,'$proplist'},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2], + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2],'_']}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all_from_skip) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2], + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2],'_']}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all_to_skip) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE, + {skip,"skipped by post_all/3"}, + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE, + {skip,"skipped by post_all/3"}, + '_']}}, + {?eh,tc_user_skip,{all_and_groups_SUITE,all,"skipped by post_all/3"}}, + {?eh,cth,{'_',on_tc_skip,[all_and_groups_SUITE,all, + {tc_user_skip,"skipped by post_all/3"}, + []]}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(illegal_values_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups, + [all_and_groups_SUITE, + [{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups, + [all_and_groups_SUITE, + [{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite,{failed,{error,'_'}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(illegal_values_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all, + [all_and_groups_SUITE, + [{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}],'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all, + [all_and_groups_SUITE, + [{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}],'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error,'Invalid reference to group this_group_does_not_exist in all_and_groups_SUITE:all/0'}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(bad_return_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,not_a_list]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,not_a_list]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error, + {'Bad return value from post_groups/2 hook function',not_a_list}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(bad_return_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,not_a_list,'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,not_a_list,'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error,{'Bad return value from post_all/3 hook function',not_a_list}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(crash_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,crash]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,crash]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed, + {error,"all_and_groups_cth:post_groups/2 CTH call failed"}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(crash_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,crash,'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,crash,'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed, + {error,"all_and_groups_cth:post_all/3 CTH call failed"}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(ok) -> ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl new file mode 100644 index 0000000000..adc86005f9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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_and_groups_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_group(_Group,Config) -> + Config. + +end_per_group(_Group,Config) -> + ok. + +all() -> + ct:get_config(all_return,[{group,test_group}]). + +groups() -> + [{test_group,[tc1]}]. + +%% Test cases starts here. +tc1(Config) -> + ok. + +tc2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl new file mode 100644 index 0000000000..9ebc00e9de --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl @@ -0,0 +1,100 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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_and_groups_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). + +post_groups(Suite,Groups) -> + case empty_cth:post_groups(Suite,ct:get_config(post_groups_return,Groups)) of + crash -> error(crash_in_post_groups); + R -> R + end. + +post_all(Suite,Tests,Groups) -> + case empty_cth:post_all(Suite,ct:get_config(post_all_return,Tests),Groups) of + crash -> error(crash_in_post_all); + R -> R + end. + +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). + +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/ct_match_state_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_match_state_cth.erl new file mode 100644 index 0000000000..38c9da903d --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_match_state_cth.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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_match_state_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +post_groups(Suite, Groups) -> + empty_cth:post_groups(Suite, Groups). + +post_all(Suite, Tests, Groups) -> + empty_cth:post_all(Suite, Tests, Groups). + +init(Id, Opts) -> + empty_cth:init(Id, Opts), + {ok,mystate}. + +%% In the following, always match against the state value, to ensure +%% that init has indeed been called before the rest of the hooks. +pre_init_per_suite(Suite,Config,mystate) -> + empty_cth:pre_init_per_suite(Suite,Config,mystate). + +post_init_per_suite(Suite,Config,Return,mystate) -> + empty_cth:post_init_per_suite(Suite,Config,Return,mystate). + +pre_end_per_suite(Suite,Config,mystate) -> + empty_cth:pre_end_per_suite(Suite,Config,mystate). + +post_end_per_suite(Suite,Config,Return,mystate) -> + empty_cth:post_end_per_suite(Suite,Config,Return,mystate). + +terminate(mystate) -> + empty_cth:terminate(mystate). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_SUITE.erl new file mode 100644 index 0000000000..537c97d3f0 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_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_scope_suite_group_only_cth_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 +suite() -> + [{ct_hooks,[ct_match_state_cth]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [test_case]. + +groups() -> + [{g1,[test_case]}]. + +%% Test cases starts here. +test_case(Config) when is_list(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 c648367838..60488e84c6 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 @@ -39,6 +39,9 @@ -export([id/1]). -export([init/2]). +-export([post_all/3]). +-export([post_groups/2]). + -export([pre_init_per_suite/3]). -export([post_init_per_suite/4]). -export([pre_end_per_suite/3]). @@ -71,6 +74,31 @@ -record(state, { id = ?MODULE :: term()}). +%% Called after groups/0. +%% You can change the return value in this function. +-spec post_groups(Suite :: atom(), Groups :: list()) -> list(). +post_groups(Suite,Groups) -> + gen_event:notify( + ?CT_EVMGR_REF, #event{ name = cth, node = node(), + data = {?MODULE, post_groups, + [Suite,Groups]}}), + ct:log("~w:post_groups(~w) called", [?MODULE,Suite]), + Groups. + +%% Called after all/0. +%% You can change the return value in this function. +-spec post_all(Suite :: atom(), + Tests :: list(), + Groups :: term()) -> + list(). +post_all(Suite,Tests,Groups) -> + gen_event:notify( + ?CT_EVMGR_REF, #event{ name = cth, node = node(), + data = {?MODULE, post_all, + [Suite,Tests,Groups]}}), + ct:log("~w:post_all(~w) called", [?MODULE,Suite]), + Tests. + %% Always called before any other callback function. Use this to initiate %% any common state. It should return an state for this CTH. -spec init(Id :: term(), Opts :: proplists:proplist()) -> diff --git a/lib/common_test/test/ct_tc_repeat_SUITE.erl b/lib/common_test/test/ct_tc_repeat_SUITE.erl new file mode 100644 index 0000000000..433b5456fe --- /dev/null +++ b/lib/common_test/test/ct_tc_repeat_SUITE.erl @@ -0,0 +1,438 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-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(ct_tc_repeat_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + DataDir = ?config(data_dir, Config), + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + + +suite() -> + [{timetrap,{minutes,1}}]. + +all() -> + all(suite). + +all(suite) -> + [ + repeat, + repeat_parallel_until_ok, + repeat_parallel_until_fail, + repeat_sequence_until_ok, + repeat_sequence_until_fail, + pick_one_test_from_group, + pick_one_test_from_subgroup + ]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +%% Test post_groups and post_all hook callbacks, introduced by OTP-14746 +repeat(Config) -> + ok = do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [], [], Config). + +repeat_parallel_until_ok(Config) -> + {error,{{illegal_combination,{parallel,repeat_until_ok}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_parallel_until_ok}], + [], Config, 1, []). + +repeat_parallel_until_fail(Config) -> + {error,{{illegal_combination,{parallel,repeat_until_fail}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_parallel_until_fail}], + [], Config, 1, []). + +repeat_sequence_until_ok(Config) -> + {error,{{illegal_combination,{sequence,repeat_until_ok}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_sequence_until_ok}], + [], Config, 1, []). + +repeat_sequence_until_fail(Config) -> + {error,{{illegal_combination,{sequence,repeat_until_fail}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_sequence_until_fail}], + [], Config, 1, []). + +pick_one_test_from_group(Config) -> + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_mixed},{testcase,tc2}], + [], Config, 1, []). + +pick_one_test_from_subgroup(Config) -> + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", + [{group,[[g_mixed,subgroup]]},{testcase,tc2}], + [], Config, 1, []). + + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +do_test(Tag, Suite, WTT, CTHs, Config) -> + do_test(Tag, Suite, WTT, CTHs, Config, 2, []). + +do_test(Tag, Suite0, WTT, CTHs, Config, EC, ExtraOpts) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join([DataDir,Suite0]), + {Opts,ERPid} = + setup([{suite,Suite}|WTT]++[{ct_hooks,CTHs},{label,Tag}|ExtraOpts], + Config), + Res = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + %% io:format("~p~n",[Events]), + + ct_test_support:log_events(Tag, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Tag, EC), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + Res. + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(repeat) -> + S = tc_repeat_SUITE, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,unknown}}, + + %% tc1, {repeat,2} + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + %% tc2, {repeat_until_ok,3} + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + %% tc3, {repeat_until_ok,3} + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{tc_repeat_SUITE,tc3, + {failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,1,{0,0}}}, + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{S,tc3,{failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,2,{0,0}}}, + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{S,tc3,{failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,3,{0,0}}}, + %% tc4, {repeat_until_fail,3} + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{4,3,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{4,4,{0,0}}}, + %% g, tc1, {repeat,2} + {?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{5,4,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{6,4,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}, + %% g_until_ok, tc2, {repeat_until_ok,3} + {?eh,tc_start,{S,{init_per_group,g_until_ok,[]}}}, + {?eh,tc_done,{S,{init_per_group,g_until_ok,[]},ok}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{7,4,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g_until_ok,[]}}}, + {?eh,tc_done,{S,{end_per_group,g_until_ok,[]},ok}}, + %% g_until_fail, tc4, {repeat_until_fail,3} + {?eh,tc_start,{S,{init_per_group,g_until_fail,[]}}}, + {?eh,tc_done,{S,{init_per_group,g_until_fail,[]},ok}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{8,4,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{8,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g_until_fail,[]}}}, + {?eh,tc_done,{S,{end_per_group,g_until_fail,[]},ok}}, + %% g, parallel, tc1, {repeat,2} + {parallel, + [{?eh,tc_start,{S,{init_per_group,g,[parallel]}}}, + {?eh,tc_done,{S,{init_per_group,g,[parallel]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{9,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{10,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[parallel]}}}, + {?eh,tc_done,{S,{end_per_group,g,[parallel]},ok}}]}, + %% g, sequence, tc1, {repeat,2} + {?eh,tc_start,{S,{init_per_group,g,[sequence]}}}, + {?eh,tc_done,{S,{init_per_group,g,[sequence]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{11,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{12,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[sequence]}}}, + {?eh,tc_done,{S,{end_per_group,g,[sequence]},ok}}, + %% g_sequence_skip_rest, + {?eh,tc_start,{S,{init_per_group,g_mixed,[sequence]}}}, + {?eh,tc_done,{S,{init_per_group,g_mixed,[sequence]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{13,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{14,5,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{15,5,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{15,6,{0,0}}}, + %% ----> fail in sequence, so skip rest + {?eh,tc_auto_skip,{S,{tc4,g_mixed}, % last of current repeat tc4 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,1}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,2}}}, + {?eh,tc_auto_skip,{S,{tc1,g}, % group g, tc1, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,3}}}, + {?eh,tc_auto_skip,{S,{tc1,subgroup}, % subgroup, single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,4}}}, + {?eh,tc_auto_skip,{S,{tc2,subgroup}, % subgroup, tc2, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,5}}}, + {?eh,tc_auto_skip,{S,{tc2,g_mixed}, % tc2, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,6}}}, + {?eh,tc_auto_skip,{S,{tc2,g_mixed}, % single tc2 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,7}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % tc1, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,8}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,9}}}, + {?eh,tc_start,{S,{end_per_group,g_mixed,'_'}}}, + {?eh,tc_done,{S,{end_per_group,g_mixed,'_'},ok}}, + %% done + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_parallel_until_ok) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_parallel_until_ok,[parallel]}}}, + {?eh,tc_done,{'_',{init_per_group,g_parallel_until_ok,[parallel]},ok}}, + {?eh,severe_error,{{illegal_combination,{parallel,repeat_until_ok}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_parallel_until_fail) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_parallel_until_fail,[parallel]}}}, + {?eh,tc_done,{'_',{init_per_group,g_parallel_until_fail,[parallel]},ok}}, + {?eh,severe_error,{{illegal_combination,{parallel,repeat_until_fail}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_sequence_until_ok) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_sequence_until_ok,[sequence]}}}, + {?eh,tc_done,{'_',{init_per_group,g_sequence_until_ok,[sequence]},ok}}, + {?eh,severe_error,{{illegal_combination,{sequence,repeat_until_ok}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_sequence_until_fail) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_sequence_until_fail,[sequence]}}}, + {?eh,tc_done,{'_',{init_per_group,g_sequence_until_fail,[sequence]},ok}}, + {?eh,severe_error,{{illegal_combination,{sequence,repeat_until_fail}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(pick_one_test_from_group) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_mixed,[]}}}, + {?eh,tc_done,{'_',{init_per_group,g_mixed,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',tc2}}}, % single tc2 + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, % tc2, {repeat,2} + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_done,{'_',tc2,ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',{end_per_group,g_mixed,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,g_mixed,[]},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(pick_one_test_from_subgroup) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_mixed,[]}}}, + {?eh,tc_done,{'_',{init_per_group,g_mixed,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_start,{'_',{init_per_group,subgroup,[]}}}}, + {?eh,tc_done,{'_',{init_per_group,subgroup,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',tc2}}}, % tc2, {repeat,2} + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_done,{'_',tc2,ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',{end_per_group,subgroup,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,subgroup,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_start,{'_',{end_per_group,g_mixed,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,g_mixed,[]},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(ok) -> + ok. + +%% test events help functions +contains(List) -> + fun(Proplist) when is_list(Proplist) -> + contains(List,Proplist) + end. + +contains([{not_in_order,List}|T],Rest) -> + contains_parallel(List,Rest), + contains(T,Rest); +contains([{Ele,Pos}|T] = L,[H|T2]) -> + case element(Pos,H) of + Ele -> + contains(T,T2); + _ -> + contains(L,T2) + end; +contains([Ele|T],[{Ele,_}|T2])-> + contains(T,T2); +contains([Ele|T],[Ele|T2])-> + contains(T,T2); +contains(List,[_|T]) -> + contains(List,T); +contains([],_) -> + match. + +contains_parallel([Key | T], Elems) -> + contains([Key],Elems), + contains_parallel(T,Elems); +contains_parallel([],_Elems) -> + match. + +not_contains(List) -> + fun(Proplist) when is_list(Proplist) -> + [] = [Ele || {Ele,_} <- Proplist, + Test <- List, + Test =:= Ele] + end. diff --git a/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl b/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl new file mode 100644 index 0000000000..f5d960d12f --- /dev/null +++ b/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl @@ -0,0 +1,85 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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(tc_repeat_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_group(_Group,Config) -> + Config. + +end_per_group(_Group,Config) -> + ok. + +all() -> + [{testcase,tc1,[{repeat,2}]}, + {testcase,tc2,[{repeat_until_ok,3}]}, + {testcase,tc3,[{repeat_until_ok,3}]}, + {testcase,tc4,[{repeat_until_fail,3}]}, + {group,g}, + {group,g_until_ok}, + {group,g_until_fail}, + {group,g,[parallel]}, + {group,g,[sequence]}, + {group,g_mixed,[sequence]}]. + +groups() -> + [{g,[{testcase,tc1,[{repeat,2}]}]}, + {g_until_ok,[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_until_fail,[{testcase,tc4,[{repeat_until_fail,3}]}]}, + {g_parallel_until_ok,[parallel],[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_parallel_until_fail,[parallel],[{testcase,tc1,[{repeat_until_fail,2}]}]}, + {g_sequence_until_ok,[sequence],[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_sequence_until_fail,[sequence],[{testcase,tc1,[{repeat_until_fail,2}]}]}, + {g_mixed,[{testcase,tc1,[{repeat,2}]}, + {testcase,tc4,[{repeat,3}]}, + tc1, + {group,g}, + {subgroup,[tc1,{testcase,tc2,[{repeat,2}]}]}, + {testcase,tc2,[{repeat,2}]}, + tc2, + {testcase,tc1,[{repeat,2}]}, + tc1]}]. + +%% Test cases starts here. +tc1(_Config) -> + ok. + +tc2(_Config) -> + ok. + +tc3(_Config) -> + ct:fail(always_fail). + +tc4(Config) -> + case ?config(saved_config,Config) of + {tc4,_} -> + ct:fail(second_time_fail); + undefined -> + {save_config,Config} + end. + +tc5(_Config) -> + {skip,"just skip this"}. diff --git a/lib/common_test/test/ct_util_SUITE.erl b/lib/common_test/test/ct_util_SUITE.erl new file mode 100644 index 0000000000..1d773855da --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE.erl @@ -0,0 +1,490 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-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(ct_util_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + DataDir = ?config(data_dir, Config), + CTHs = filelib:wildcard(filename:join(DataDir,"*_cth.erl")), + io:format("CTHs: ~p",[CTHs]), + [io:format("Compiling ~p: ~p", + [FileName,compile:file(FileName,[{outdir,DataDir},debug_info])]) || + FileName <- CTHs], + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + + +suite() -> + [{timetrap,{minutes,1}}]. + +all() -> + all(suite). + +all(suite) -> + [ + pre_init_per_suite, + post_init_per_suite, + pre_end_per_suite, + post_end_per_suite, + pre_init_per_group, + post_init_per_group, + pre_end_per_group, + post_end_per_group, + pre_init_per_testcase, + post_init_per_testcase, + pre_end_per_testcase, + post_end_per_testcase + ]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +pre_init_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + + +pre_init_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_init_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_testcase, + {curr_tc_SUITE,tc1,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_testcase, + {curr_tc_SUITE,tc1,{timeout,5000}}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_testcase, + {curr_tc_SUITE,tc1,{timeout,5000}}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_testcase, + {curr_tc_SUITE,tc1,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +do_test(Tag, Suite, RunTestArgs, Config) -> + do_test(Tag, Suite, RunTestArgs, Config, 2). + +do_test(Tag, Suite0, RunTestArgs, Config, EC) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join([DataDir,Suite0]), + {Opts,ERPid} = setup([{suite,Suite}]++[{label,Tag}|RunTestArgs],Config), + Res = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + %% io:format("~p~n",[Events]), + + ct_test_support:log_events(Tag, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Tag, EC), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + Res. + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(IPS) when IPS=:=pre_init_per_suite; IPS=:=post_init_per_suite -> + S = curr_tc_SUITE, + FwFunc = + case IPS of + pre_init_per_suite -> init_tc; + post_init_per_suite -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,E}}, + {?eh,tc_auto_skip,{S,tc1,{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,tc2,{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,{tc1,g},{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,{tc2,g},{failed,{S,init_per_suite,E}}}}, + {?eh,test_stats,{0,0,{0,4}}}, + {?eh,tc_auto_skip,{S,end_per_suite,{failed,{S,init_per_suite,E}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPS) when EPS=:=pre_end_per_suite; EPS=:=post_end_per_suite -> + S = curr_tc_SUITE, + FwFunc = + case EPS of + pre_end_per_suite -> init_tc; + post_end_per_suite -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,E}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(IPG) when IPG=:=pre_init_per_group; IPG=:=post_init_per_group -> + S = curr_tc_SUITE, + FwFunc = + case IPG of + pre_init_per_group -> init_tc; + post_init_per_group -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},E}}, + {?eh,tc_auto_skip,{S,{tc1,g},{failed,{S,init_per_group,E}}}}, + {?eh,tc_auto_skip,{S,{tc2,g},{failed,{S,init_per_group,E}}}}, + {?eh,test_stats,{2,0,{0,2}}}, + {?eh,tc_auto_skip,{S,{end_per_group,g},{failed,{S,init_per_group,E}}}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPG) when EPG=:=pre_end_per_group; EPG=:=post_end_per_group -> + S = curr_tc_SUITE, + FwFunc = + case EPG of + pre_end_per_group -> init_tc; + post_end_per_group -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},E}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(IPTC) when IPTC=:=pre_init_per_testcase; + IPTC=:=post_init_per_testcase -> + S = curr_tc_SUITE, + E = case IPTC of + pre_init_per_testcase -> + {failed,{ct_framework,init_tc,{test_case_failed,hahahahahah}}}; + post_init_per_testcase -> + {failed,{ct_framework,end_tc,{timetrap,3000}}} + end, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,{auto_skipped,E}}}, + {?eh,test_stats,{0,0,{0,1}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{1,0,{0,1}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,{auto_skipped,E}}}, + {?eh,test_stats,{1,0,{0,2}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,2}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPTC) when EPTC=:=pre_end_per_testcase; EPTC=:=post_end_per_testcase-> + S = curr_tc_SUITE, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. + +%% test events help functions +contains(List) -> + fun(Proplist) when is_list(Proplist) -> + contains(List,Proplist) + end. + +contains([{not_in_order,List}|T],Rest) -> + contains_parallel(List,Rest), + contains(T,Rest); +contains([{Ele,Pos}|T] = L,[H|T2]) -> + case element(Pos,H) of + Ele -> + contains(T,T2); + _ -> + contains(L,T2) + end; +contains([Ele|T],[{Ele,_}|T2])-> + contains(T,T2); +contains([Ele|T],[Ele|T2])-> + contains(T,T2); +contains(List,[_|T]) -> + contains(List,T); +contains([],_) -> + match. + +contains_parallel([Key | T], Elems) -> + contains([Key],Elems), + contains_parallel(T,Elems); +contains_parallel([],_Elems) -> + match. + +not_contains(List) -> + fun(Proplist) when is_list(Proplist) -> + [] = [Ele || {Ele,_} <- Proplist, + Test <- List, + Test =:= Ele] + end. diff --git a/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl b/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl new file mode 100644 index 0000000000..34c1568a87 --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl @@ -0,0 +1,105 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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_util_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 + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + erlang:system_time(second). + +init(Id, Opts) -> + {ok,ok}. + +pre_init_per_suite(Suite,Config,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Config, State}. + +post_init_per_suite(Suite,Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Return, State}. + +pre_end_per_suite(Suite,Config,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Config, State}. + +post_end_per_suite(Suite,Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Return, State}. + +pre_init_per_group(Suite, Group, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Config,State}. + +post_init_per_group(Suite, Group, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Return,State}. + +pre_end_per_group(Suite, Group, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Config,State}. + +post_end_per_group(Suite, Group, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Return,State}. + +pre_init_per_testcase(Suite, TC, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Config,State}. + +post_init_per_testcase(Suite, TC, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Return,State}. + +pre_end_per_testcase(Suite, TC, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Config,State}. + +post_end_per_testcase(Suite, TC, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Return,State}. + +%%%----------------------------------------------------------------- +maybe_sleep(FuncName,Suite) -> + maybe_sleep(FuncName,Suite,undefined). +maybe_sleep(FuncName,Suite,GroupOrTC) -> + case ct:get_config(FuncName) of + {Suite,GroupOrTC,Fail} -> + fail(Fail); + {Suite,Fail} when GroupOrTC=:=undefined -> + fail(Fail); + _ -> + ok + end. + +fail({timeout,T}) -> + timer:sleep(T); +fail(kill) -> + spawn_link(fun() -> ct:fail(hahahahahah) end), + timer:sleep(10000). + diff --git a/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl b/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl new file mode 100644 index 0000000000..b48ba4d24e --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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(curr_tc_SUITE). + +-suite_defaults([{timetrap, {seconds, 3}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_suite(Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + Config. + +end_per_suite(Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +init_per_group(_Group,Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + Config. + +end_per_group(_Group,Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +all() -> + [tc1,tc2,{group,g}]. + +groups() -> + [{g,[tc1,tc2]}]. + +%% Test cases starts here. +tc1(_Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +tc2(_Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 23eb8d9656..14a3622a00 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.17 +COMMON_TEST_VSN = 1.17.1 diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index bc1290f6fd..df09dcb06c 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -407,14 +407,14 @@ encode_arg({atom, Atom}, Dict0) when is_atom(Atom) -> {Index, Dict} = beam_dict:atom(Atom, Dict0), {encode(?tag_a, Index), Dict}; encode_arg({integer, N}, Dict) -> - %% Conservatily assume that all integers whose absolute + %% Conservatively assume that all integers whose absolute %% value is greater than 1 bsl 128 will be bignums in %% the runtime system. if N >= 1 bsl 128 -> - encode_arg({literal, N}, Dict); + encode_literal(N, Dict); N =< -(1 bsl 128) -> - encode_arg({literal, N}, Dict); + encode_literal(N, Dict); true -> {encode(?tag_i, N), Dict} end; @@ -434,7 +434,7 @@ encode_arg({list, List}, Dict0) -> {L, Dict} = encode_list(List, Dict0, []), {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict}; encode_arg({float, Float}, Dict) when is_float(Float) -> - encode_arg({literal,Float}, Dict); + encode_literal(Float, Dict); encode_arg({fr,Fr}, Dict) -> {[encode(?tag_z, 2),encode(?tag_u, Fr)], Dict}; encode_arg({field_flags,Flags0}, Dict) -> @@ -442,12 +442,24 @@ encode_arg({field_flags,Flags0}, Dict) -> {encode(?tag_u, Flags), Dict}; encode_arg({alloc,List}, Dict) -> encode_alloc_list(List, Dict); -encode_arg({literal,Lit}, Dict0) -> - {Index,Dict} = beam_dict:literal(Lit, Dict0), - {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}; +encode_arg({literal,Lit}, Dict) -> + if + Lit =:= [] -> + encode_arg(nil, Dict); + is_atom(Lit) -> + encode_arg({atom,Lit}, Dict); + is_integer(Lit) -> + encode_arg({integer,Lit}, Dict); + true -> + encode_literal(Lit, Dict) + end; encode_arg(Int, Dict) when is_integer(Int) -> {encode(?tag_u, Int),Dict}. +encode_literal(Literal, Dict0) -> + {Index,Dict} = beam_dict:literal(Literal, Dict0), + {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}. + %%flag_to_bit(aligned) -> 16#01; %% No longer useful. flag_to_bit(little) -> 16#02; flag_to_bit(big) -> 16#00; diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c index 20707c0531..75cddeb1e9 100644 --- a/lib/crypto/c_src/algorithms.c +++ b/lib/crypto/c_src/algorithms.c @@ -255,29 +255,66 @@ void init_algorithms_types(ErlNifEnv* env) ASSERT(algo_rsa_opts_cnt <= sizeof(algo_rsa_opts)/sizeof(ERL_NIF_TERM)); } -ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) + +ERL_NIF_TERM hash_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_hash_fips_cnt : +#endif + algo_hash_cnt; + + return enif_make_list_from_array(env, algo_hash, cnt); +} + +ERL_NIF_TERM pubkey_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_pubkey_fips_cnt : +#endif + algo_pubkey_cnt; + + return enif_make_list_from_array(env, algo_pubkey, cnt); +} + + +ERL_NIF_TERM cipher_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return cipher_types_as_list(env); /* Exclude old api ciphers */ +} + +ERL_NIF_TERM mac_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_mac_fips_cnt : +#endif + algo_mac_cnt; + + return enif_make_list_from_array(env, algo_mac, cnt); +} + + +ERL_NIF_TERM curve_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + unsigned int cnt = #ifdef FIPS_SUPPORT - int fips_mode = FIPS_mode(); + FIPS_mode() ? algo_curve_fips_cnt : +#endif + algo_curve_cnt; + + return enif_make_list_from_array(env, algo_curve, cnt); +} + + +ERL_NIF_TERM rsa_opts_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_rsa_opts_fips_cnt : +#endif + algo_rsa_opts_cnt; - unsigned int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt; - unsigned int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt; - unsigned int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt; - unsigned int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt; - unsigned int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt; -#else - unsigned int hash_cnt = algo_hash_cnt; - unsigned int pubkey_cnt = algo_pubkey_cnt; - unsigned int mac_cnt = algo_mac_cnt; - unsigned int curve_cnt = algo_curve_cnt; - unsigned int rsa_opts_cnt = algo_rsa_opts_cnt; -#endif - return enif_make_tuple6(env, - enif_make_list_from_array(env, algo_hash, hash_cnt), - enif_make_list_from_array(env, algo_pubkey, pubkey_cnt), - cipher_types_as_list(env), - enif_make_list_from_array(env, algo_mac, mac_cnt), - enif_make_list_from_array(env, algo_curve, curve_cnt), - enif_make_list_from_array(env, algo_rsa_opts, rsa_opts_cnt) - ); + return enif_make_list_from_array(env, algo_rsa_opts, cnt); } diff --git a/lib/crypto/c_src/algorithms.h b/lib/crypto/c_src/algorithms.h index 068fb661ec..4ad8b56db8 100644 --- a/lib/crypto/c_src/algorithms.h +++ b/lib/crypto/c_src/algorithms.h @@ -25,6 +25,11 @@ void init_algorithms_types(ErlNifEnv* env); -ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM hash_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM pubkey_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM cipher_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM mac_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM curve_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM rsa_opts_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_ALGORITHMS_H__ */ diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index 0793ffa6ca..059c14690f 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -70,6 +70,7 @@ ERL_NIF_TERM atom_onbasis; ERL_NIF_TERM atom_aes_cfb8; ERL_NIF_TERM atom_aes_cfb128; +ERL_NIF_TERM atom_aes_ige256; #ifdef HAVE_GCM ERL_NIF_TERM atom_aes_gcm; #endif @@ -188,6 +189,7 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); + atom_aes_ige256 = enif_make_atom(env, "aes_ige256"); #ifdef HAVE_GCM atom_aes_gcm = enif_make_atom(env, "aes_gcm"); #endif diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index 24f6dc26fd..f5913de96f 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -74,6 +74,7 @@ extern ERL_NIF_TERM atom_onbasis; extern ERL_NIF_TERM atom_aes_cfb8; extern ERL_NIF_TERM atom_aes_cfb128; +extern ERL_NIF_TERM atom_aes_ige256; #ifdef HAVE_GCM extern ERL_NIF_TERM atom_aes_gcm; #endif diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index 8f0c93c5db..00072af632 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -62,34 +62,18 @@ static struct cipher_type_t cipher_types[] = {{"blowfish_ecb"}, {NULL}, 0, 0}, #endif - {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16, 0}, - {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24, 0}, - {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32, 0}, - {{"aes_128_cbc"}, {&EVP_aes_128_cbc}, 16, 0}, {{"aes_192_cbc"}, {&EVP_aes_192_cbc}, 24, 0}, {{"aes_256_cbc"}, {&EVP_aes_256_cbc}, 32, 0}, - {{"aes_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_128_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_192_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_256_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_128_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_192_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_256_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L}, - {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L}, - {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L}, - {{"aes_128_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L}, {{"aes_192_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L}, {{"aes_256_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L}, @@ -98,16 +82,10 @@ static struct cipher_type_t cipher_types[] = {{"aes_128_ctr"}, {&EVP_aes_128_ctr}, 16, 0}, {{"aes_192_ctr"}, {&EVP_aes_192_ctr}, 24, 0}, {{"aes_256_ctr"}, {&EVP_aes_256_ctr}, 32, 0}, - {{"aes_ctr"}, {&EVP_aes_128_ctr}, 16, 0}, - {{"aes_ctr"}, {&EVP_aes_192_ctr}, 24, 0}, - {{"aes_ctr"}, {&EVP_aes_256_ctr}, 32, 0}, #else {{"aes_128_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, {{"aes_192_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, {{"aes_256_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, #endif #if defined(HAVE_CHACHA20) @@ -124,28 +102,20 @@ static struct cipher_type_t cipher_types[] = #endif #if defined(HAVE_GCM) - {{"aes_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, {{"aes_128_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, {{"aes_192_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, {{"aes_256_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, #else - {{"aes_gcm"}, {NULL}, 0, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, {{"aes_128_gcm"}, {NULL}, 16, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, {{"aes_192_gcm"}, {NULL}, 24, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, {{"aes_256_gcm"}, {NULL}, 32, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, #endif #if defined(HAVE_CCM) - {{"aes_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, {{"aes_128_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, {{"aes_192_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, {{"aes_256_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, #else - {{"aes_ccm"}, {NULL}, 0, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, {{"aes_128_ccm"}, {NULL}, 16, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, {{"aes_192_ccm"}, {NULL}, 24, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, {{"aes_256_ccm"}, {NULL}, 32, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, @@ -359,13 +329,15 @@ ERL_NIF_TERM cipher_types_as_list(ErlNifEnv* env) prev = atom_undefined; for (p = cipher_types; (p->type.atom & (p->type.atom != atom_false)); p++) { - if ((prev != p->type.atom) && - ((p->cipher.p != NULL) || - (p->flags & (NON_EVP_CIPHER|AES_CTR_COMPAT)) ) && /* Special handling. Bad indeed... */ - ! FORBIDDEN_IN_FIPS(p) - ) - hd = enif_make_list_cell(env, p->type.atom, hd); - prev = p->type.atom; + if ((prev == p->type.atom) || + FORBIDDEN_IN_FIPS(p) ) + continue; + + if ((p->cipher.p != NULL) || + (p->type.atom == atom_aes_ige256)) /* Special handling. Bad indeed... */ + { + hd = enif_make_list_cell(env, p->type.atom, hd); + } } return hd; diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index a8014745c8..d533cba140 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -63,7 +63,12 @@ static ErlNifFunc nif_funcs[] = { {"info_lib", 0, info_lib, 0}, {"info_fips", 0, info_fips, 0}, {"enable_fips_mode", 1, enable_fips_mode, 0}, - {"algorithms", 0, algorithms, 0}, + {"hash_algorithms", 0, hash_algorithms, 0}, + {"pubkey_algorithms", 0, pubkey_algorithms, 0}, + {"cipher_algorithms", 0, cipher_algorithms, 0}, + {"mac_algorithms", 0, mac_algorithms, 0}, + {"curve_algorithms", 0, curve_algorithms, 0}, + {"rsa_opts_algorithms", 0, rsa_opts_algorithms, 0}, {"hash_info", 1, hash_info_nif, 0}, {"hash_nif", 2, hash_nif, 0}, {"hash_init_nif", 1, hash_init_nif, 0}, diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index c0b302734e..195c9d029d 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed build link error on Windows. Unresolved symbol + 'bcmp'.</p> + <p> + Own Id: OTP-15750 Aux Id: ERL-905 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 3b431cceba..98378412d4 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -61,7 +61,8 @@ crypto_one_time/4, crypto_one_time/5, crypto_one_time_aead/6, crypto_one_time_aead/7, crypto_dyn_iv_init/3, - crypto_dyn_iv_update/3 + crypto_dyn_iv_update/3, + supports/1 ]). @@ -499,15 +500,22 @@ stop() -> Macs :: [hmac | cmac | poly1305], Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()], RSAopts :: [rsa_sign_verify_opt() | rsa_opt()] . -supports()-> - {Hashs, PubKeys, Ciphers, Macs, Curves, RsaOpts} = algorithms(), - [{hashs, Hashs}, - {ciphers, prepend_cipher_aliases(Ciphers)}, - {public_keys, PubKeys}, - {macs, Macs}, - {curves, Curves}, - {rsa_opts, RsaOpts} - ]. +supports() -> + [{hashs, hash_algorithms()}, + {ciphers, prepend_old_aliases( cipher_algorithms())}, + {public_keys, pubkey_algorithms()}, + {macs, mac_algorithms()}, + {curves, curve_algorithms()}, + {rsa_opts, rsa_opts_algorithms()} + ]. + +supports(hashs) -> hash_algorithms(); +supports(public_keys) -> pubkey_algorithms(); +supports(ciphers) -> cipher_algorithms(); +supports(macs) -> mac_algorithms(); +supports(curves) -> curve_algorithms(); +supports(rsa_opts) -> rsa_opts_algorithms(). + -spec info_lib() -> [{Name,VerNum,VerStr}] when Name :: binary(), VerNum :: integer(), @@ -700,7 +708,7 @@ poly1305(Key, Data) -> | xts_mode . -%% These ciphers are not available via the EVP interface on older cryptolibs. +%% %% These ciphers are not available via the EVP interface on older cryptolibs. cipher_info(aes_ctr) -> #{block_size => 1,iv_length => 16,key_length => 32,mode => ctr_mode,type => undefined}; cipher_info(aes_128_ctr) -> @@ -709,9 +717,36 @@ cipher_info(aes_192_ctr) -> #{block_size => 1,iv_length => 16,key_length => 24,mode => ctr_mode,type => undefined}; cipher_info(aes_256_ctr) -> #{block_size => 1,iv_length => 16,key_length => 32,mode => ctr_mode,type => undefined}; -%% This cipher is handled specialy. +%% %% This cipher is handled specialy. cipher_info(aes_ige256) -> #{block_size => 16,iv_length => 32,key_length => 16,mode => ige_mode,type => undefined}; +%% %% These ciphers belong to the "old" interface: +%% cipher_info(aes_cbc) -> +%% #{block_size => 16,iv_length => 16,key_length => 24,mode => cbc_mode,type => 423}; +%% cipher_info(aes_cbc128) -> +%% #{block_size => 16,iv_length => 16,key_length => 16,mode => cbc_mode,type => 419}; +%% cipher_info(aes_cbc256) -> +%% #{block_size => 16,iv_length => 16,key_length => 32,mode => cbc_mode,type => 427}; +%% cipher_info(aes_ccm) -> +%% #{block_size => 1,iv_length => 12,key_length => 24,mode => ccm_mode,type => 899}; +%% cipher_info(aes_cfb128) -> +%% #{block_size => 1,iv_length => 16,key_length => 32,mode => cfb_mode,type => 429}; +%% cipher_info(aes_cfb8) -> +%% #{block_size => 1,iv_length => 16,key_length => 32,mode => cfb_mode,type => 429}; +%% cipher_info(aes_ecb) -> +%% #{block_size => 16,iv_length => 0,key_length => 24,mode => ecb_mode,type => 422}; +%% cipher_info(aes_gcm) -> +%% #{block_size => 1,iv_length => 12,key_length => 24,mode => gcm_mode,type => 898}; +%% cipher_info(des3_cbc) -> +%% #{block_size => 8,iv_length => 8,key_length => 24,mode => cbc_mode,type => 44}; +%% cipher_info(des3_cbf) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; +%% cipher_info(des3_cfb) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; +%% cipher_info(des_ede3) -> +%% #{block_size => 8,iv_length => 8,key_length => 24,mode => cbc_mode,type => 44}; +%% cipher_info(des_ede3_cbf) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; cipher_info(Type) -> cipher_info_nif(alias(Type)). @@ -1058,20 +1093,34 @@ ng_crypto_one_time_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. %%%---------------------------------------------------------------- %%% Cipher aliases %%% -prepend_cipher_aliases(L0) -> - L = - case lists:member(des_ede3_cbc, L0) of +-define(if_also(Cipher, Ciphers, AliasCiphers), + case lists:member(Cipher, Ciphers) of true -> - [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb | L0]; + AliasCiphers; false -> - L0 - end, - case lists:member(aes_128_cbc, L0) of - true -> - [aes_cbc128, aes_cbc256 | L]; - false -> - L - end. + Ciphers + end). + + +prepend_old_aliases(L0) -> + L1 = ?if_also(des_ede3_cbc, L0, + [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb | L0]), + L2 = ?if_also(aes_128_cbc, L1, + [aes_cbc, aes_cbc128, aes_cbc256 | L1]), + L3 = ?if_also(aes_128_ctr, L2, + [aes_ctr | L2]), + L4 = ?if_also(aes_128_ccm, L3, + [aes_ccm | L3]), + L5 = ?if_also(aes_128_gcm, L4, + [aes_gcm | L4]), + L6 = ?if_also(aes_128_cfb8, L5, + [aes_cfb8 | L5]), + L7 = ?if_also(aes_128_cfb128, L6, + [aes_cfb128 | L6]), + L8 = ?if_also(aes_128_ecb, L7, + [aes_ecb | L7]), + L8. + %%%---- des_ede3_cbc @@ -1088,42 +1137,37 @@ alias(aes_cbc256) -> aes_256_cbc; alias(Alg) -> Alg. -%%%---- des_ede3_cbc -alias(des3_cbc, _) -> des_ede3_cbc; -alias(des_ede3, _) -> des_ede3_cbc; -%%%---- des_ede3_cfb -alias(des_ede3_cbf,_ ) -> des_ede3_cfb; -alias(des3_cbf, _) -> des_ede3_cfb; -alias(des3_cfb, _) -> des_ede3_cfb; -%%%---- aes_*_cbc -alias(aes_cbc128, _) -> aes_128_cbc; -alias(aes_cbc256, _) -> aes_256_cbc; +alias(Ciph, Key) -> alias2(alias(Ciph), Key). + +alias2(aes_cbc, Key) when size(Key)==16 -> aes_128_cbc; +alias2(aes_cbc, Key) when size(Key)==24 -> aes_192_cbc; +alias2(aes_cbc, Key) when size(Key)==32 -> aes_256_cbc; -alias(aes_cbc, Key) when size(Key)==128 -> aes_128_cbc; -alias(aes_cbc, Key) when size(Key)==192 -> aes_192_cbc; -alias(aes_cbc, Key) when size(Key)==256 -> aes_256_cbc; +alias2(aes_cfb8, Key) when size(Key)==16 -> aes_128_cfb8; +alias2(aes_cfb8, Key) when size(Key)==24 -> aes_192_cfb8; +alias2(aes_cfb8, Key) when size(Key)==32 -> aes_256_cfb8; -alias(aes_cfb8, Key) when size(Key)==128 -> aes_128_cfb8; -alias(aes_cfb8, Key) when size(Key)==192 -> aes_192_cfb8; -alias(aes_cfb8, Key) when size(Key)==256 -> aes_256_cfb8; +alias2(aes_cfb128, Key) when size(Key)==16 -> aes_128_cfb128; +alias2(aes_cfb128, Key) when size(Key)==24 -> aes_192_cfb128; +alias2(aes_cfb128, Key) when size(Key)==32 -> aes_256_cfb128; -alias(aes_cfb128, Key) when size(Key)==128 -> aes_128_cfb128; -alias(aes_cfb128, Key) when size(Key)==192 -> aes_192_cfb128; -alias(aes_cfb128, Key) when size(Key)==256 -> aes_256_cfb128; +alias2(aes_ctr, Key) when size(Key)==16 -> aes_128_ctr; +alias2(aes_ctr, Key) when size(Key)==24 -> aes_192_ctr; +alias2(aes_ctr, Key) when size(Key)==32 -> aes_256_ctr; -alias(aes_ctr, Key) when size(Key)==128 -> aes_128_ctr; -alias(aes_ctr, Key) when size(Key)==192 -> aes_192_ctr; -alias(aes_ctr, Key) when size(Key)==256 -> aes_256_ctr; +alias2(aes_ecb, Key) when size(Key)==16 -> aes_128_ecb; +alias2(aes_ecb, Key) when size(Key)==24 -> aes_192_ecb; +alias2(aes_ecb, Key) when size(Key)==32 -> aes_256_ecb; -alias(aes_gcm, Key) when size(Key)==128 -> aes_128_gcm; -alias(aes_gcm, Key) when size(Key)==192 -> aes_192_gcm; -alias(aes_gcm, Key) when size(Key)==256 -> aes_256_gcm; +alias2(aes_gcm, Key) when size(Key)==16 -> aes_128_gcm; +alias2(aes_gcm, Key) when size(Key)==24 -> aes_192_gcm; +alias2(aes_gcm, Key) when size(Key)==32 -> aes_256_gcm; -alias(aes_ccm, Key) when size(Key)==128 -> aes_128_ccm; -alias(aes_ccm, Key) when size(Key)==192 -> aes_192_ccm; -alias(aes_ccm, Key) when size(Key)==256 -> aes_256_ccm; +alias2(aes_ccm, Key) when size(Key)==16 -> aes_128_ccm; +alias2(aes_ccm, Key) when size(Key)==24 -> aes_192_ccm; +alias2(aes_ccm, Key) when size(Key)==32 -> aes_256_ccm; -alias(Alg, _) -> Alg. +alias2(Alg, _) -> Alg. %%%================================================================ %%% @@ -2387,7 +2431,13 @@ exor(Data1, Data2, _Size, MaxByts, Acc) -> do_exor(_A, _B) -> ?nif_stub. -algorithms() -> ?nif_stub. +hash_algorithms() -> ?nif_stub. +pubkey_algorithms() -> ?nif_stub. +cipher_algorithms() -> ?nif_stub. +mac_algorithms() -> ?nif_stub. +curve_algorithms() -> ?nif_stub. +rsa_opts_algorithms() -> ?nif_stub. + int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []); int_to_bin(X) -> int_to_bin_pos(X, []). diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 880fd7ab0b..56691223c4 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -116,8 +116,6 @@ groups() -> {group, blowfish_ecb}, {group, blowfish_ofb64}, - {group, aes_cfb128}, - {group, aes_cfb8}, {group, aes_ige256}, {group, des_cbc}, {group, des_cfb}, @@ -125,7 +123,15 @@ groups() -> {group, rc4}, ?NEW_CIPHER_TYPE_SCHEMA, - ?RETIRED_TYPE_ALIASES + {group, aes_128_cfb128}, + {group, aes_192_cfb128}, + {group, aes_256_cfb128}, + {group, aes_128_cfb8}, + {group, aes_192_cfb8}, + {group, aes_256_cfb8}, + ?RETIRED_TYPE_ALIASES, + {group, aes_cfb128}, + {group, aes_cfb8} ]}, {fips, [], [ {group, no_blake2b}, @@ -210,9 +216,15 @@ groups() -> {des_ede3_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {des_ede3_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {rc2_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cfb8, [], [block]}, + {aes_128_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {no_aes_cfb8, [], [no_support, no_block]}, - {aes_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cfb128, [], [block]}, + {aes_128_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {no_aes_cfb128, [], [no_support, no_block]}, {aes_ige256, [], [block]}, {no_aes_ige256, [], [no_support, no_block]}, @@ -478,7 +490,7 @@ poly1305(Config) -> %%-------------------------------------------------------------------- no_poly1305() -> [{doc, "Test disabled poly1305 function"}]. -no_poly1305(Config) -> +no_poly1305(_Config) -> Key = <<133,214,190,120,87,85,109,51,127,68,82,254,66,213,6,168,1, 3,128,138,251,13,178,253,74,191,246,175,65,73,245,27>>, Txt = <<"Cryptographic Forum Research Group">>, @@ -889,8 +901,24 @@ cipher_info(Config) when is_list(Config) -> #{type := _,key_length := _,iv_length := _, block_size := _,mode := _} = crypto:cipher_info(aes_128_cbc), {'EXIT',_} = (catch crypto:cipher_info(not_a_cipher)), - lists:foreach(fun(C) -> crypto:cipher_info(C) end, - proplists:get_value(ciphers, crypto:supports())). + case lists:foldl(fun(C,Ok) -> + try crypto:cipher_info(C) + of + _ -> Ok + catch Cls:Exc -> + ct:pal("~p:~p ~p",[Cls,Exc,C]), + false + end + end, + true, +crypto:supports(ciphers)) of +%% proplists:get_value(ciphers, crypto:supports())) of + true -> + ok; + false -> + ct:fail('Cipher unsupported',[]) + end. + %%-------------------------------------------------------------------- hash_info() -> @@ -1553,7 +1581,7 @@ rand_uniform_aux_test(N) -> rand_uniform_aux_test(N-1). crypto_rand_uniform(L,H) -> - R1 = crypto:rand_uniform(L, H), + R1 = (L-1) + rand:uniform(H-L), case (R1 >= L) and (R1 < H) of true -> ok; @@ -2591,6 +2619,22 @@ aes_cfb8(Config) -> "CFB8VarTxt256.rsp", "CFB8VarKey256.rsp", "CFB8GFSbox256.rsp", "CFB8KeySbox256.rsp", "CFB8MMT128.rsp", "CFB8MMT192.rsp", "CFB8MMT256.rsp"]). +aes_128_cfb8(Config) -> + read_rsp(Config, aes_128_cfb8, + ["CFB8VarTxt128.rsp", "CFB8VarKey128.rsp", "CFB8GFSbox128.rsp", "CFB8KeySbox128.rsp", + "CFB8MMT128.rsp"]). + +aes_192_cfb8(Config) -> + read_rsp(Config, aes_192_cfb8, + ["CFB8VarTxt192.rsp", "CFB8VarKey192.rsp", "CFB8GFSbox192.rsp", "CFB8KeySbox192.rsp", + "CFB8MMT192.rsp"]). + +aes_256_cfb8(Config) -> + read_rsp(Config, aes_256_cfb8, + ["CFB8VarTxt256.rsp", "CFB8VarKey256.rsp", "CFB8GFSbox256.rsp", "CFB8KeySbox256.rsp", + "CFB8MMT256.rsp"]). + + aes_cfb128(Config) -> read_rsp(Config, aes_cfb128, ["CFB128VarTxt128.rsp", "CFB128VarKey128.rsp", "CFB128GFSbox128.rsp", "CFB128KeySbox128.rsp", @@ -2598,6 +2642,22 @@ aes_cfb128(Config) -> "CFB128VarTxt256.rsp", "CFB128VarKey256.rsp", "CFB128GFSbox256.rsp", "CFB128KeySbox256.rsp", "CFB128MMT128.rsp", "CFB128MMT192.rsp", "CFB128MMT256.rsp"]). +aes_128_cfb128(Config) -> + read_rsp(Config, aes_128_cfb128, + ["CFB128VarTxt128.rsp", "CFB128VarKey128.rsp", "CFB128GFSbox128.rsp", "CFB128KeySbox128.rsp", + "CFB128MMT128.rsp"]). + +aes_192_cfb128(Config) -> + read_rsp(Config, aes_192_cfb128, + ["CFB128VarTxt192.rsp", "CFB128VarKey192.rsp", "CFB128GFSbox192.rsp", "CFB128KeySbox192.rsp", + "CFB128MMT192.rsp"]). + +aes_256_cfb128(Config) -> + read_rsp(Config, aes_256_cfb128, + ["CFB128VarTxt256.rsp", "CFB128VarKey256.rsp", "CFB128GFSbox256.rsp", "CFB128KeySbox256.rsp", + "CFB128MMT256.rsp"]). + + blowfish_cbc(_) -> [{blowfish_cbc, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index deba17fb66..0a3d9f45e4 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.4.1 +CRYPTO_VSN = 4.4.2 diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 5777225ae7..8dcba93273 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -43,6 +43,23 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 2.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix inadvertently broad monitor that resulted in + gen_server cast messages to hidden nodes from module + diameter_dist.</p> + <p> + Own Id: OTP-15768</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/src/base/diameter_dist.erl b/lib/diameter/src/base/diameter_dist.erl index 5c29ea95a4..ed23152b8b 100644 --- a/lib/diameter/src/base/diameter_dist.erl +++ b/lib/diameter/src/base/diameter_dist.erl @@ -454,7 +454,8 @@ start_link() -> init([]) -> ets:new(?NODE_TABLE, [set, named_table]), ets:new(?SERVICE_TABLE, [bag, named_table]), - ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]), + ok = net_kernel:monitor_nodes(true, [{node_type, visible}, + nodedown_reason]), ets:insert(?NODE_TABLE, [{?B(N), N} || N <- [node() | nodes()]]), abcast({attach, node()}), {ok, sets:new()}. @@ -521,5 +522,14 @@ terminate(_, _) -> %% code_change/3 +%% Old code inadvertently monitored all nodes: start a new +%% subscription and remove the old one. +code_change(_OldVsn, State, "2.2") -> + ok = net_kernel:monitor_nodes(true, [{node_type, visible}, + nodedown_reason]), + ok = net_kernel:monitor_nodes(false, [{node_type, all}, + nodedown_reason]), + {ok, State}; + code_change(_OldVsn, State, _Extra) -> {ok, State}. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 52263633fb..bb2a4a8e92 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -61,7 +61,8 @@ {"2.1.4", [{restart_application, diameter}]}, %% 20.3 {"2.1.4.1", [{restart_application, diameter}]}, %% 20.3.8.19 {"2.1.5", [{restart_application, diameter}]}, %% 21.0 - {"2.1.6", [{restart_application, diameter}]} %% 21.1 + {"2.1.6", [{restart_application, diameter}]}, %% 21.1 + {"2.2", [{update, diameter_dist, {advanced, "2.2"}}]} %% 21.3 ], [ {"0.9", [{restart_application, diameter}]}, @@ -104,6 +105,7 @@ {"2.1.4", [{restart_application, diameter}]}, {"2.1.4.1", [{restart_application, diameter}]}, {"2.1.5", [{restart_application, diameter}]}, - {"2.1.6", [{restart_application, diameter}]} + {"2.1.6", [{restart_application, diameter}]}, + {"2.2", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index a900e8f28e..a8fbca5bc8 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 2.2 +DIAMETER_VSN = 2.2.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/edoc.dtd b/lib/edoc/doc/edoc.dtd new file mode 120000 index 0000000000..43f4b27db6 --- /dev/null +++ b/lib/edoc/doc/edoc.dtd @@ -0,0 +1 @@ +../priv/edoc.dtd
\ No newline at end of file diff --git a/lib/edoc/doc/edoc_doclet.hrl b/lib/edoc/doc/edoc_doclet.hrl new file mode 120000 index 0000000000..4623b18bb4 --- /dev/null +++ b/lib/edoc/doc/edoc_doclet.hrl @@ -0,0 +1 @@ +../include/edoc_doclet.hrl
\ No newline at end of file diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile index aba94a6802..3e53e75c75 100644 --- a/lib/edoc/doc/src/Makefile +++ b/lib/edoc/doc/src/Makefile @@ -79,6 +79,11 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +INCLUDES_DIR = ../../include +INCLUDES = $(INCLUDES_DIR)/edoc_doclet.hrl + +DTDS_DIR = ../../priv +DTDS = $(DTDS_DIR)/edoc.dtd # ---------------------------------------------------- # FLAGS @@ -135,5 +140,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DATA) $(INCLUDES) $(DTDS) "$(RELSYSDIR)/doc/html" release_spec: diff --git a/lib/edoc/include/edoc_doclet.hrl b/lib/edoc/include/edoc_doclet.hrl index 1429ee5971..a05a9cb2bc 100644 --- a/lib/edoc/include/edoc_doclet.hrl +++ b/lib/edoc/include/edoc_doclet.hrl @@ -43,7 +43,7 @@ %% @type no_app(). %% A value used to mark absence of an Erlang application %% context. Use the macro `NO_APP' defined in -%% <a href="../include/edoc_doclet.hrl">`edoc_doclet.hrl'</a> +%% <a href="edoc_doclet.hrl">`edoc_doclet.hrl'</a> %% to produce this value. %% @type doclet_gen() = #doclet_gen{sources = [string()], diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index e9d62d3283..62483602aa 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -734,7 +734,7 @@ get_doc(File) -> %% %% @type edoc_module(). The EDoc documentation data for a module, %% expressed as an XML document in {@link //xmerl. XMerL} format. See -%% the file <a href="../priv/edoc.dtd">`edoc.dtd'</a> for details. +%% the file <a href="edoc.dtd">`edoc.dtd'</a> for details. %% %% @doc Reads a source code file and extracts EDoc documentation data. %% Note that without an environment parameter (see {@link get_doc/3}), diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 6cb3095507..604291374a 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -62,7 +62,7 @@ %% @spec (Command::doclet_gen() | doclet_toc(), edoc_context()) -> ok %% @doc Main doclet entry point. See the file <a -%% href="../include/edoc_doclet.hrl">`edoc_doclet.hrl'</a> for the data +%% href="edoc_doclet.hrl">`edoc_doclet.hrl'</a> for the data %% structures used for passing parameters. %% %% Also see {@link edoc:layout/2} for layout-related options, and diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index 2c9aa2e3a3..5342d02947 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -1260,7 +1260,6 @@ get_text(#xmlElement{content=[E]}) -> %% text_and_name_only(Es) -> {N, Ts} text_and_a_name_only(Es) -> - erlang:display(Es), case [Name || #xmlElement{ name = a, attributes = [#xmlAttribute{name=name}]}=Name <- Es] of diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index f081ca926a..254ae27cc8 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -183,6 +183,35 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret><nametext>ei_decode_bitstring(const char *buf, int *index, void *p, size_t plen, size_t *bitsp)</nametext></name> + <fsummary>Decode a bitstring.</fsummary> + <desc> + <p>Decodes a bitstring from the binary format.</p> + <taglist> + <tag><c>p</c></tag> + <item><p>Either <c>NULL</c> or points to a buffer where the bytes of the + bitstring will be written.</p> + </item> + <tag><c>plen</c></tag> + <item><p>The max size of the bitstring in <em>bytes</em>, that is the + size of the buffer if <c>p != NULL</c>.</p> + </item> + <tag><c>*bitsp</c></tag> + <item><p>If <c>bitsp</c> is not <c>NULL</c>, set to the actual + number of <em>bits</em> of the bitstring.</p> + </item> + </taglist> + <p>Returns <c>0</c> if it was a bitstring no longer than <c>plen</c> + bytes. The actual length of the bitstring will be + <c>(*bitsp+7)/8</c> bytes. If <c>(*bitsp % 8) > 0</c> only the high + <c>(*bitsp % 8)</c> bits of the last byte are significant.</p> + <p>Number of bits may be divisible by 8, which means a binary + decodable by <c>ei_decode_binary</c> is also decodable by + <c>ei_decode_bitstring</c>.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_decode_boolean(const char *buf, int *index, int *p)</nametext></name> <fsummary>Decode a boolean.</fsummary> <desc> @@ -349,8 +378,10 @@ typedef enum { <c>t</c> is actually an <c>ETERM**</c> (see <seealso marker="erl_eterm"><c>erl_eterm</c></seealso>). The term is later to be deallocated.</p> - <p>Notice that this function is located in the <c>Erl_Interface</c> - library.</p> + <note><p>This function is deprecated as of OTP 22 and will be removed in + OTP 23 together with the old legacy <c>erl_interface</c> library (functions + with prefix <c>erl_</c>).</p> + </note> </desc> </func> @@ -459,6 +490,18 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret><nametext>ei_encode_bitstring(char *buf, int *index, const void *p, size_t bits)</nametext></name> + <name since="OTP @OTP-15712@"><ret>int</ret><nametext>ei_x_encode_bitstring(ei_x_buff* x, const void *p, size_t bits)</nametext></name> + <fsummary>Encode a bitstring.</fsummary> + <desc> + <p>Encodes a bitstring in the binary format. The data is at + <c>p</c>. The size of the data is <c>bits</c> bits or + <c>(bits+7)/8</c> bytes. If <c>(bits%8) > 0</c> only the high + <c>(bits%8)</c> bits of the last byte are significant.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_encode_boolean(char *buf, int *index, int p)</nametext></name> <name since=""><ret>int</ret><nametext>ei_x_encode_boolean(ei_x_buff* x, int p)</nametext></name> <fsummary>Encode a boolean.</fsummary> @@ -656,6 +699,10 @@ ei_x_encode_string(&x, "Banana");</pre> <c>erl_interface</c>. Parameter <c>t</c> is actually an <c>ETERM</c> pointer. This function does not free the <c>ETERM</c>.</p> + <note><p>These functions are deprecated as of OTP 22 and will be removed in + OTP 23 together with the old legacy <c>erl_interface</c> library + (functions with prefix <c>erl_</c>).</p> + </note> </desc> </func> <func> @@ -725,12 +772,12 @@ ei_encode_tuple_header(buf, &i, 0);</pre> <name since=""><ret>int</ret><nametext>ei_get_type(const char *buf, const int *index, int *type, int *size)</nametext></name> <fsummary>Fetch the type and size of an encoded term.</fsummary> <desc> - <p>Returns the type in <c>type</c> and size in - <c>size</c> of the encoded term. For strings and atoms, + <p>Returns the type in <c>*type</c> and size in + <c>*size</c> of the encoded term. For strings and atoms, size is the number of characters <em>not</em> including the - terminating <c>NULL</c>. For binaries, <c>size</c> is the number of - bytes. For lists and tuples, <c>size</c> is the arity of - the object. For other types, <c>size</c> is 0. In all + terminating <c>NULL</c>. For binaries and bitstrings, <c>*size</c> is + the number of bytes. For lists, tuples and maps, <c>*size</c> is the + arity of the object. For other types, <c>*size</c> is 0. In all cases, <c>index</c> is left unchanged.</p> </desc> </func> diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 32d28b853b..fc6a1bb548 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix handling of Makefile dependencies so that parallel + make works properly.</p> + <p> + Own Id: OTP-15757</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.11.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -153,6 +169,22 @@ </section> +<section><title>Erl_Interface 3.10.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix handling of Makefile dependencies so that parallel + make works properly.</p> + <p> + Own Id: OTP-15757</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.10.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1603,4 +1635,3 @@ </section> </section> </chapter> - diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index aa2a49098f..591367dc95 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -154,11 +154,14 @@ typedef LONG_PTR ssize_t; /* Sigh... */ #define ERL_STRING_EXT 'k' #define ERL_LIST_EXT 'l' #define ERL_BINARY_EXT 'm' +#define ERL_BIT_BINARY_EXT 'M' #define ERL_SMALL_BIG_EXT 'n' #define ERL_LARGE_BIG_EXT 'o' #define ERL_NEW_FUN_EXT 'p' #define ERL_MAP_EXT 't' #define ERL_FUN_EXT 'u' +#define ERL_EXPORT_EXT 'q' + #define ERL_NEW_CACHE 'N' /* c nodes don't know these two */ #define ERL_CACHED_ATOM 'C' @@ -269,15 +272,23 @@ typedef struct { typedef struct { long arity; char module[MAXATOMLEN_UTF8]; - erlang_char_encoding module_org_enc; - char md5[16]; - long index; - long old_index; - long uniq; - long n_free_vars; - erlang_pid pid; - long free_var_len; - char* free_vars; + enum { EI_FUN_CLOSURE, EI_FUN_EXPORT } type; + union { + struct { + char md5[16]; + long index; + long old_index; + long uniq; + long n_free_vars; + erlang_pid pid; + long free_var_len; + char* free_vars; + } closure; + struct { + char* func; + int func_allocated; + } export; + } u; } erlang_fun; /* a big */ @@ -515,7 +526,9 @@ int ei_x_encode_atom_len(ei_x_buff* x, const char* s, int len); int ei_x_encode_atom_len_as(ei_x_buff* x, const char* s, int len, erlang_char_encoding from, erlang_char_encoding to); int ei_encode_binary(char *buf, int *index, const void *p, long len); +int ei_encode_bitstring(char *buf, int *index, const void *p, size_t bits); int ei_x_encode_binary(ei_x_buff* x, const void* s, int len); +int ei_x_encode_bitstring(ei_x_buff* x, const void* p, size_t bits); int ei_encode_pid(char *buf, int *index, const erlang_pid *p); int ei_x_encode_pid(ei_x_buff* x, const erlang_pid* pid); int ei_encode_fun(char* buf, int* index, const erlang_fun* p); @@ -524,8 +537,8 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p); int ei_x_encode_port(ei_x_buff* x, const erlang_port *p); int ei_encode_ref(char *buf, int *index, const erlang_ref *p); int ei_x_encode_ref(ei_x_buff* x, const erlang_ref *p); -int ei_encode_term(char *buf, int *index, void *t); /* ETERM* actually */ -int ei_x_encode_term(ei_x_buff* x, void* t); +int ei_encode_term(char *buf, int *index, void *t) EI_DEPRECATED_ATTR; +int ei_x_encode_term(ei_x_buff* x, void* t) EI_DEPRECATED_ATTR; int ei_encode_trace(char *buf, int *index, const erlang_trace *p); int ei_x_encode_trace(ei_x_buff* x, const erlang_trace *p); int ei_encode_tuple_header(char *buf, int *index, int arity); @@ -547,8 +560,6 @@ int ei_x_encode_map_header(ei_x_buff* x, long n); */ int ei_get_type(const char *buf, const int *index, int *type, int *size); -int ei_get_type_internal(const char *buf, const int *index, int *type, - int *size); /* Step through buffer, decoding the given type into the buffer * provided. On success, 0 is returned and index is updated to point @@ -567,12 +578,13 @@ int ei_decode_string(const char *buf, int *index, char *p); int ei_decode_atom(const char *buf, int *index, char *p); int ei_decode_atom_as(const char *buf, int *index, char *p, int destlen, erlang_char_encoding want, erlang_char_encoding* was, erlang_char_encoding* result); int ei_decode_binary(const char *buf, int *index, void *p, long *len); +int ei_decode_bitstring(const char *buf, int *index, void *p, size_t plen, size_t *bitsp); int ei_decode_fun(const char* buf, int* index, erlang_fun* p); void free_fun(erlang_fun* f); int ei_decode_pid(const char *buf, int *index, erlang_pid *p); int ei_decode_port(const char *buf, int *index, erlang_port *p); int ei_decode_ref(const char *buf, int *index, erlang_ref *p); -int ei_decode_term(const char *buf, int *index, void *t); /* ETERM** actually */ +int ei_decode_term(const char *buf, int *index, void *t) EI_DEPRECATED_ATTR; int ei_decode_trace(const char *buf, int *index, erlang_trace *p); int ei_decode_tuple_header(const char *buf, int *index, int *arity); int ei_decode_list_header(const char *buf, int *index, int *arity); diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 7a304e6d4f..0cbad235cc 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1846,6 +1846,7 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, const char* function[] = {"SEND_NAME", "SEND_CHALLENGE"}; int err; ssize_t len; + unsigned int flags; if (f_chall) siz += 4; @@ -1867,7 +1868,7 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, } put8(s, 'n'); put16be(s, version); - put32be(s, (DFLAG_EXTENDED_REFERENCES + flags = (DFLAG_EXTENDED_REFERENCES | DFLAG_DIST_MONITOR | DFLAG_EXTENDED_PIDS_PORTS | DFLAG_FUN_TAGS @@ -1876,7 +1877,14 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, | DFLAG_SMALL_ATOM_TAGS | DFLAG_UTF8_ATOMS | DFLAG_MAP_TAG - | DFLAG_BIG_CREATION)); + | DFLAG_BIG_CREATION + | DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES); + if (ei_internal_use_21_bitstr_expfun()) { + flags &= ~(DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES); + } + put32be(s, flags); if (f_chall) put32be(s, challenge); memcpy(s, nodename, strlen(nodename)); @@ -1941,8 +1949,7 @@ static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, goto error; } - if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS) - && !ei_internal_use_r9_pids_ports()) { + if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS)) { EI_TRACE_ERR0("recv_challenge","<- RECV_CHALLENGE peer cannot " "handle extended pids and ports"); erl_errno = EIO; @@ -2236,8 +2243,7 @@ static int recv_name(ei_socket_callbacks *cbs, void *ctx, goto error; } - if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS) - && !ei_internal_use_r9_pids_ports()) { + if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS)) { EI_TRACE_ERR0("recv_name","<- RECV_NAME peer cannot " "handle extended pids and ports"); erl_errno = EIO; diff --git a/lib/erl_interface/src/connect/ei_connect_int.h b/lib/erl_interface/src/connect/ei_connect_int.h index 0bcccaa84b..b41a5f2b23 100644 --- a/lib/erl_interface/src/connect/ei_connect_int.h +++ b/lib/erl_interface/src/connect/ei_connect_int.h @@ -102,6 +102,8 @@ extern int h_errno; #define DFLAG_FUN_TAGS 16 #define DFLAG_NEW_FUN_TAGS 0x80 #define DFLAG_EXTENDED_PIDS_PORTS 0x100 +#define DFLAG_EXPORT_PTR_TAG 0x200 +#define DFLAG_BIT_BINARIES 0x400 #define DFLAG_NEW_FLOATS 0x800 #define DFLAG_SMALL_ATOM_TAGS 0x4000 #define DFLAG_UTF8_ATOMS 0x10000 diff --git a/lib/erl_interface/src/decode/decode_binary.c b/lib/erl_interface/src/decode/decode_binary.c index 5b8d234984..2799438bef 100644 --- a/lib/erl_interface/src/decode/decode_binary.c +++ b/lib/erl_interface/src/decode/decode_binary.c @@ -40,4 +40,40 @@ int ei_decode_binary(const char *buf, int *index, void *p, long *lenp) return 0; } +int ei_decode_bitstring(const char *buf, int *index, void *p, size_t plen, + size_t *bitsp) +{ + const char *s = buf + *index; + const char *s0 = s; + unsigned long len; + unsigned char last_bits; + const unsigned char tag = get8(s); + + if (tag == ERL_BINARY_EXT) { + long bytes; + int ret = ei_decode_binary(buf, index, p, &bytes); + if (bitsp) + *bitsp = (size_t)bytes * 8; + return ret; + } + + if (tag != ERL_BIT_BINARY_EXT) + return -1; + + len = get32be(s); + last_bits = get8(s); + + if (len > plen || ((last_bits==0) != (len==0)) || last_bits > 8) + return -1; + + if (p) + memcpy(p, s, len); + s += len; + + if (bitsp) + *bitsp = (len == 0) ? 0 : ((len-1) * 8) + last_bits; + + *index += s-s0; + return 0; +} diff --git a/lib/erl_interface/src/decode/decode_fun.c b/lib/erl_interface/src/decode/decode_fun.c index f944c028af..32a950433e 100644 --- a/lib/erl_interface/src/decode/decode_fun.c +++ b/lib/erl_interface/src/decode/decode_fun.c @@ -33,22 +33,20 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) int i, ix, ix0, n; erlang_pid* p_pid; char* p_module; - erlang_char_encoding* p_module_org_enc; long* p_index; long* p_uniq; long* p_old_index; if (p != NULL) { - p_pid = &p->pid; + p_pid = &p->u.closure.pid; p_module = &p->module[0]; - p_module_org_enc = &p->module_org_enc; - p_index = &p->index; - p_uniq = &p->uniq; - p_old_index = &p->old_index; + p_index = &p->u.closure.index; + p_uniq = &p->u.closure.uniq; + p_old_index = &p->u.closure.old_index; } else { - p_pid = NULL; p_module = NULL; p_module_org_enc = NULL; p_index = NULL; p_uniq = NULL; p_old_index = NULL; + p_pid = NULL; p_module = NULL; } switch (get8(s)) { @@ -63,7 +61,7 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) return -1; /* then the module (atom) */ if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, - p_module_org_enc, NULL) < 0) + NULL, NULL) < 0) return -1; /* then the index */ if (ei_decode_long(s, &ix, p_index) < 0) @@ -78,11 +76,11 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) return -1; } if (p != NULL) { - p->n_free_vars = n; - p->free_var_len = ix - ix0; - p->free_vars = ei_malloc(ix - ix0); - if (!(p->free_vars)) return -1; - memcpy(p->free_vars, s + ix0, ix - ix0); + p->u.closure.n_free_vars = n; + p->u.closure.free_var_len = ix - ix0; + p->u.closure.free_vars = ei_malloc(ix - ix0); + if (!(p->u.closure.free_vars)) return -1; + memcpy(p->u.closure.free_vars, s + ix0, ix - ix0); } s += ix; *index += s-s0; @@ -93,20 +91,23 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) n = get32be(s); /* then the arity */ i = get8(s); - if (p != NULL) p->arity = i; - /* then md5 */ - if (p != NULL) memcpy(p->md5, s, 16); + if (p != NULL) { + p->type = EI_FUN_CLOSURE; + p->arity = i; + /* then md5 */ + memcpy(p->u.closure.md5, s, 16); + } s += 16; /* then index */ i = get32be(s); - if (p != NULL) p->index = i; + if (p != NULL) p->u.closure.index = i; /* then the number of free vars (environment) */ i = get32be(s); - if (p != NULL) p->n_free_vars = i; + if (p != NULL) p->u.closure.n_free_vars = i; /* then the module (atom) */ ix = 0; if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, - p_module_org_enc, NULL) < 0) + NULL, NULL) < 0) return -1; /* then the old_index */ if (ei_decode_long(s, &ix, p_old_index) < 0) @@ -122,17 +123,56 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) n = n - (s - s0) + 1; if (n < 0) return -1; if (p != NULL) { - p->free_var_len = n; + p->u.closure.free_var_len = n; if (n > 0) { - p->free_vars = malloc(n); - if (!(p->free_vars)) return -1; - memcpy(p->free_vars, s, n); + p->u.closure.free_vars = malloc(n); + if (!(p->u.closure.free_vars)) return -1; + memcpy(p->u.closure.free_vars, s, n); } } s += n; *index += s-s0; return 0; break; + case ERL_EXPORT_EXT: { + char* p_func; + long* p_arity; + int used; + + if (p) { + p->type = EI_FUN_EXPORT; + p_arity = &p->arity; + } + else { + p_arity = NULL; + } + if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, + NULL, NULL) < 0) + return -1; + if (p) { + /* try use module buffer for function name */ + used = strlen(p->module) + 1; + p_func = p->module + used; + p->u.export.func = p_func; + p->u.export.func_allocated = 0; + } + else { + used = 0; + p_func = NULL; + } + while (ei_decode_atom_as(s, &ix, p_func, MAXATOMLEN_UTF8-used, + ERLANG_UTF8, NULL, NULL) < 0) { + if (!used) + return -1; + p_func = malloc(MAXATOMLEN_UTF8); + p->u.export.func = p_func; + p->u.export.func_allocated = 1; + used = 0; + } + if (ei_decode_long(s, &ix, p_arity) < 0) + return -1; + return 0; + } default: return -1; } @@ -140,6 +180,14 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) void free_fun(erlang_fun* f) { - if (f->free_var_len > 0) - ei_free(f->free_vars); + switch (f->type) { + case EI_FUN_CLOSURE: + if (f->u.closure.free_var_len > 0) + ei_free(f->u.closure.free_vars); + break; + case EI_FUN_EXPORT: + if (f->u.export.func_allocated) + ei_free(f->u.export.func); + break; + } } diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c index 0db315f09b..11d3bc1786 100644 --- a/lib/erl_interface/src/decode/decode_skip.c +++ b/lib/erl_interface/src/decode/decode_skip.c @@ -21,13 +21,21 @@ #include "eiext.h" #include "decode_skip.h" +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif + +#ifndef SIZE_MAX +# define SIZE_MAX (~((size_t)0)) +#endif + int ei_skip_term(const char* buf, int* index) { int i, n, ty; /* ASSERT(ep != NULL); */ - ei_get_type_internal(buf, index, &ty, &n); + ei_get_type(buf, index, &ty, &n); switch (ty) { case ERL_ATOM_EXT: /* FIXME: what if some weird locale is in use? */ @@ -54,7 +62,7 @@ int ei_skip_term(const char* buf, int* index) if (ei_decode_list_header(buf, index, &n) < 0) return -1; for (i = 0; i < n; ++i) ei_skip_term(buf, index); - if (ei_get_type_internal(buf, index, &ty, &n) < 0) return -1; + if (ei_get_type(buf, index, &ty, &n) < 0) return -1; if (ty != ERL_NIL_EXT) ei_skip_term(buf, index); else @@ -79,6 +87,10 @@ int ei_skip_term(const char* buf, int* index) if (ei_decode_binary(buf, index, NULL, NULL) < 0) return -1; break; + case ERL_BIT_BINARY_EXT: + if (ei_decode_bitstring(buf, index, NULL, SIZE_MAX, NULL) < 0) + return -1; + break; case ERL_SMALL_INTEGER_EXT: case ERL_INTEGER_EXT: if (ei_decode_long(buf, index, NULL) < 0) return -1; diff --git a/lib/erl_interface/src/encode/encode_binary.c b/lib/erl_interface/src/encode/encode_binary.c index 4471c51769..4aa9f6bc16 100644 --- a/lib/erl_interface/src/encode/encode_binary.c +++ b/lib/erl_interface/src/encode/encode_binary.c @@ -40,3 +40,27 @@ int ei_encode_binary(char *buf, int *index, const void *p, long len) return 0; } +int ei_encode_bitstring(char *buf, int *index, const void *p, size_t bits) +{ + char *s = buf + *index; + char *s0 = s; + size_t bytes = (bits + 7) / 8; + char last_bits = bits % 8; + + if (bytes == 0 || last_bits == 0) + return ei_encode_binary(buf, index, p, bytes); + + if (!buf) s += 6; + else { + put8(s, ERL_BIT_BINARY_EXT); + put32be(s, bytes); + put8(s, last_bits); + memcpy(s, p, bytes); + s[bytes-1] &= (0xff << (8-last_bits)); + } + s += bytes; + + *index += s-s0; + + return 0; +} diff --git a/lib/erl_interface/src/encode/encode_fun.c b/lib/erl_interface/src/encode/encode_fun.c index 3bfc7530d1..38ba7c5b30 100644 --- a/lib/erl_interface/src/encode/encode_fun.c +++ b/lib/erl_interface/src/encode/encode_fun.c @@ -26,56 +26,72 @@ int ei_encode_fun(char *buf, int *index, const erlang_fun *p) { int ix = *index; - if (p->arity == -1) { - /* ERL_FUN_EXT */ - if (buf != NULL) { - char* s = buf + ix; - put8(s, ERL_FUN_EXT); - put32be(s, p->n_free_vars); - } - ix += sizeof(char) + 4; - if (ei_encode_pid(buf, &ix, &p->pid) < 0) - return -1; - if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, p->module_org_enc) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->index) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->uniq) < 0) - return -1; - if (buf != NULL) - memcpy(buf + ix, p->free_vars, p->free_var_len); - ix += p->free_var_len; - } else { - char *size_p; - /* ERL_NEW_FUN_EXT */ - if (buf != NULL) { - char* s = buf + ix; - put8(s, ERL_NEW_FUN_EXT); - size_p = s; - s += 4; - put8(s, p->arity); - memcpy(s, p->md5, sizeof(p->md5)); - s += sizeof(p->md5); - put32be(s, p->index); - put32be(s, p->n_free_vars); - } else - size_p = NULL; - ix += 1 + 4 + 1 + sizeof(p->md5) + 4 + 4; - if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, p->module_org_enc) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->old_index) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->uniq) < 0) - return -1; - if (ei_encode_pid(buf, &ix, &p->pid) < 0) - return -1; - if (buf != NULL) - memcpy(buf + ix, p->free_vars, p->free_var_len); - ix += p->free_var_len; - if (size_p != NULL) { - int sz = buf + ix - size_p; - put32be(size_p, sz); + switch (p->type) { + case EI_FUN_CLOSURE: + if (p->arity == -1) { + /* ERL_FUN_EXT */ + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_FUN_EXT); + put32be(s, p->u.closure.n_free_vars); + } + ix += sizeof(char) + 4; + if (ei_encode_pid(buf, &ix, &p->u.closure.pid) < 0) + return -1; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.index) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.uniq) < 0) + return -1; + if (buf != NULL) + memcpy(buf + ix, p->u.closure.free_vars, p->u.closure.free_var_len); + ix += p->u.closure.free_var_len; + } else { + char *size_p; + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_NEW_FUN_EXT); + size_p = s; + s += 4; + put8(s, p->arity); + memcpy(s, p->u.closure.md5, sizeof(p->u.closure.md5)); + s += sizeof(p->u.closure.md5); + put32be(s, p->u.closure.index); + put32be(s, p->u.closure.n_free_vars); + } else + size_p = NULL; + ix += 1 + 4 + 1 + sizeof(p->u.closure.md5) + 4 + 4; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.old_index) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.uniq) < 0) + return -1; + if (ei_encode_pid(buf, &ix, &p->u.closure.pid) < 0) + return -1; + if (buf != NULL) + memcpy(buf + ix, p->u.closure.free_vars, p->u.closure.free_var_len); + ix += p->u.closure.free_var_len; + if (size_p != NULL) { + int sz = buf + ix - size_p; + put32be(size_p, sz); + } } + break; + case EI_FUN_EXPORT: + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_EXPORT_EXT); + } + ix++; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_atom_as(buf, &ix, p->u.export.func, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->arity) < 0) + return -1; + break; } *index = ix; return 0; diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 7ed2bdbc93..7ecea83b1a 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -299,12 +299,7 @@ void erl_mk_pid_helper(ETERM *ep, unsigned int number, unsigned int serial, unsigned int creation) { ERL_PID_NUMBER(ep) = number & 0x7fff; /* 15 bits */ - if (ei_internal_use_r9_pids_ports()) { - ERL_PID_SERIAL(ep) = serial & 0x07; /* 3 bits */ - } - else { - ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ - } + ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ ERL_PID_CREATION(ep) = creation; /* 32 bits */ } @@ -334,12 +329,7 @@ ETERM *erl_mk_port(const char *node, void erl_mk_port_helper(ETERM* ep, unsigned number, unsigned int creation) { - if (ei_internal_use_r9_pids_ports()) { - ERL_PORT_NUMBER(ep) = number & 0x3ffff; /* 18 bits */ - } - else { - ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ - } + ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ ERL_PORT_CREATION(ep) = creation; /* 32 bits */ } diff --git a/lib/erl_interface/src/misc/ei_compat.c b/lib/erl_interface/src/misc/ei_compat.c index 93d7dbfb83..787895992e 100644 --- a/lib/erl_interface/src/misc/ei_compat.c +++ b/lib/erl_interface/src/misc/ei_compat.c @@ -22,19 +22,22 @@ #include "ei.h" #include "ei_internal.h" -#define EI_COMPAT_NO_REL (~((unsigned) 0)) +#include <limits.h> -static unsigned compat_rel = EI_COMPAT_NO_REL; +#ifndef EI_COMPAT +# define EI_COMPAT UINT_MAX +#endif + +static unsigned compat_rel = EI_COMPAT; void ei_set_compat_rel(unsigned rel) { - if (compat_rel == EI_COMPAT_NO_REL) - compat_rel = rel; + compat_rel = rel; } -int -ei_internal_use_r9_pids_ports(void) +int ei_internal_use_21_bitstr_expfun(void) { - return compat_rel < 10; + return compat_rel < 22; } + diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c index 63a7034508..8a4f7cc30d 100644 --- a/lib/erl_interface/src/misc/ei_decode_term.c +++ b/lib/erl_interface/src/misc/ei_decode_term.c @@ -87,6 +87,14 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) case ERL_BINARY_EXT: term->size = get32be(s); return 0; + case ERL_BIT_BINARY_EXT: { + int bytes = get32be(s); + int last_bits = get8(s); + if (((last_bits==0) != (bytes==0)) || last_bits > 8) + return -1; + term->size = bytes; + return 0; + } case ERL_SMALL_BIG_EXT: if ((term->arity = get8(s)) != 4) return -1; sign = get8(s); diff --git a/lib/erl_interface/src/misc/ei_internal.h b/lib/erl_interface/src/misc/ei_internal.h index f28dd6d668..ab12597c86 100644 --- a/lib/erl_interface/src/misc/ei_internal.h +++ b/lib/erl_interface/src/misc/ei_internal.h @@ -157,7 +157,7 @@ int ei_init_connect(void); void ei_trace_printf(const char *name, int level, const char *format, ...); -int ei_internal_use_r9_pids_ports(void); +int ei_internal_use_21_bitstr_expfun(void); int ei_get_cbs_ctx__(ei_socket_callbacks **cbs, void **ctx, int fd); diff --git a/lib/erl_interface/src/misc/ei_printterm.c b/lib/erl_interface/src/misc/ei_printterm.c index 058de00de5..a89b990ac1 100644 --- a/lib/erl_interface/src/misc/ei_printterm.c +++ b/lib/erl_interface/src/misc/ei_printterm.c @@ -131,7 +131,7 @@ static int print_term(FILE* fp, ei_x_buff* x, if (fp == NULL && x == NULL) return -1; doquote = 0; - ei_get_type_internal(buf, index, &ty, &n); + ei_get_type(buf, index, &ty, &n); switch (ty) { case ERL_ATOM_EXT: case ERL_ATOM_UTF8_EXT: @@ -189,7 +189,7 @@ static int print_term(FILE* fp, ei_x_buff* x, xputs(", ", fp, x); ch_written += 2; } } - if (ei_get_type_internal(buf, &tindex, &ty, &n) < 0) goto err; + if (ei_get_type(buf, &tindex, &ty, &n) < 0) goto err; if (ty != ERL_NIL_EXT) { xputs(" | ", fp, x); ch_written += 3; r = print_term(fp, x, buf, &tindex); @@ -249,6 +249,34 @@ static int print_term(FILE* fp, ei_x_buff* x, xputc('>', fp, x); ++ch_written; ei_free(p); break; + case ERL_BIT_BINARY_EXT: { + size_t bits; + int trunc = 0; + p = ei_malloc(n); + if (p == NULL) goto err; + if (ei_decode_bitstring(buf, index, p, n, &bits) < 0) { + ei_free(p); + goto err; + } + ch_written += xprintf(fp, x, "#Bits<"); + m = (bits+7) / 8; + if (m > BINPRINTSIZE) { + m = BINPRINTSIZE; + trunc = 1; + } + --m; + for (i = 0; i < m; ++i) { + ch_written += xprintf(fp, x, "%d,", p[i]); + } + ch_written += xprintf(fp, x, "%d", p[i]); + if (trunc) + ch_written += xprintf(fp, x, ",..."); + else if (bits % 8 != 0) + ch_written += xprintf(fp, x, ":%u", (unsigned)(bits % 8)); + xputc('>', fp, x); ++ch_written; + ei_free(p); + break; + } case ERL_SMALL_INTEGER_EXT: case ERL_INTEGER_EXT: if (ei_decode_long(buf, index, &l) < 0) goto err; diff --git a/lib/erl_interface/src/misc/ei_x_encode.c b/lib/erl_interface/src/misc/ei_x_encode.c index 4ff5974663..2da271795f 100644 --- a/lib/erl_interface/src/misc/ei_x_encode.c +++ b/lib/erl_interface/src/misc/ei_x_encode.c @@ -117,6 +117,16 @@ int ei_x_encode_binary(ei_x_buff* x, const void* p, int len) return ei_encode_binary(x->buff, &x->index, p, len); } +int ei_x_encode_bitstring(ei_x_buff* x, const void* p, size_t bits) +{ + int i = x->index; + if (ei_encode_bitstring(NULL, &i, p, bits) == -1) + return -1; + if (!x_fix_buff(x, i)) + return -1; + return ei_encode_bitstring(x->buff, &x->index, p, bits); +} + int ei_x_encode_long(ei_x_buff* x, long n) { int i = x->index; diff --git a/lib/erl_interface/src/misc/get_type.c b/lib/erl_interface/src/misc/get_type.c index aa69cd4d60..eef58a9363 100644 --- a/lib/erl_interface/src/misc/get_type.c +++ b/lib/erl_interface/src/misc/get_type.c @@ -27,17 +27,8 @@ /* for types with meaningful length attributes, return the length too. In other cases, return length 0 */ -/* FIXME working on this one.... */ - int ei_get_type(const char *buf, const int *index, int *type, int *len) { - return ei_get_type_internal(buf, index, type, len); -} - - -int ei_get_type_internal(const char *buf, const int *index, - int *type, int *len) -{ const char *s = buf + *index; *type = get8(s); @@ -64,7 +55,9 @@ int ei_get_type_internal(const char *buf, const int *index, case ERL_LARGE_TUPLE_EXT: case ERL_LIST_EXT: + case ERL_MAP_EXT: case ERL_BINARY_EXT: + case ERL_BIT_BINARY_EXT: *len = get32be(s); break; diff --git a/lib/erl_interface/src/misc/show_msg.c b/lib/erl_interface/src/misc/show_msg.c index 5868cccba6..2d49eb6449 100644 --- a/lib/erl_interface/src/misc/show_msg.c +++ b/lib/erl_interface/src/misc/show_msg.c @@ -24,6 +24,13 @@ #include <stdlib.h> #include <stdarg.h> #include <string.h> +#ifdef HAVE_STDINT_H +# include <stdint.h> +#endif + +#ifndef SIZE_MAX +# define SIZE_MAX (~((size_t)0)) +#endif #include <sys/types.h> @@ -342,7 +349,7 @@ static void show_term(const char *termbuf, int *index, FILE *stream) int i, len; char *s; - ei_get_type_internal(termbuf,index,&type,&len); + ei_get_type(termbuf,index,&type,&len); switch (type) { case ERL_VERSION_MAGIC: @@ -455,6 +462,12 @@ static void show_term(const char *termbuf, int *index, FILE *stream) fprintf(stream,"#Bin<%ld>",num); break; + case ERL_BIT_BINARY_EXT: { + size_t bits; + ei_decode_bitstring(termbuf, index, NULL, SIZE_MAX, &bits); + fprintf(stream, "#Bits<%lu>", (unsigned long)bits); + break; + } case ERL_LARGE_BIG_EXT: /* doesn't actually decode - just skip over it */ /* FIXME if GMP, what to do here?? */ diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index 158464b385..6f58c9833d 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -186,7 +186,6 @@ int main(void) ei_x_encode_empty_list(&eix); ei_get_type(charp, intp, intp, intp); - ei_get_type_internal(charp, intp, intp, intp); ei_decode_version(charp, intp, intp); ei_decode_long(charp, intp, longp); diff --git a/lib/erl_interface/src/registry/reg_dump.c b/lib/erl_interface/src/registry/reg_dump.c index 43c9824433..da0413e6e6 100644 --- a/lib/erl_interface/src/registry/reg_dump.c +++ b/lib/erl_interface/src/registry/reg_dump.c @@ -90,7 +90,7 @@ static int mn_start_dump(int fd, const erlang_pid *self, || (arity != 2) || ei_decode_atom(buf,&index,tmpbuf) || strcmp(tmpbuf,"rex") - || ei_get_type_internal(buf,&index,&type,&arity) + || ei_get_type(buf,&index,&type,&arity) || (type != ERL_PID_EXT)) return -1; /* bad response from other side */ diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.h b/lib/erl_interface/test/all_SUITE_data/ei_runner.h index 2608661303..7c874ac82e 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.h +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.h @@ -53,6 +53,7 @@ void free_packet(char*); #define fail(reason) do_fail(__FILE__, __LINE__, reason) #define fail1(reason, a1) do_fail(__FILE__, __LINE__, reason, a1) +#define fail2(reason, a1, a2) do_fail(__FILE__, __LINE__, reason, a1, a2) #define report(ok) do_report(__FILE__, __LINE__, ok) void do_report(char* file, int line, int ok); diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 9c9c3f86b6..f40c67375b 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -43,8 +43,12 @@ init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). ei_accept(Config) when is_list(Config) -> + ei_accept_do(Config, 0), % default + ei_accept_do(Config, 21). % ei_set_compat_rel + +ei_accept_do(Config, CompatRel) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, CompatRel), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -52,15 +56,18 @@ ei_accept(Config) when is_list(Config) -> io:format("EINode ~p ~n", [EINode]), %% We take this opportunity to also test export-funs and bit-strings - %% with (ugly) tuple fallbacks. + %% with (ugly) tuple fallbacks in OTP 21 and older. %% Test both toward pending connection and established connection. RealTerms = [<<1:1>>, fun lists:map/2], - Fallbacks = [{<<128>>,1}, {lists,map}], + EncTerms = case CompatRel of + 0 -> RealTerms; + 21 -> [{<<128>>,1}, {lists,map}] + end, Self = self(), Funny = fun() -> hello end, TermToSend = {call, Self, "Test", Funny, RealTerms}, - TermToGet = {call, Self, "Test", Funny, Fallbacks}, + TermToGet = {call, Self, "Test", Funny, EncTerms}, Port = 6543, {ok, ListenFd} = ei_publish(P, Port), {any, EINode} ! TermToSend, @@ -94,7 +101,7 @@ ei_threaded_accept(Config) when is_list(Config) -> %% Test erlang:monitor toward erl_interface "processes" monitor_ei_process(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, 0), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -167,8 +174,8 @@ start_einode(Einode, N, Host) -> %%% Interface functions for ei (erl_interface) functions. -ei_connect_init(P, Num, Cookie, Creation) -> - send_command(P, ei_connect_init, [Num,Cookie,Creation]), +ei_connect_init(P, Num, Cookie, Creation, Compat) -> + send_command(P, ei_connect_init, [Num,Cookie,Creation,Compat]), case get_term(P) of {term,Int} when is_integer(Int) -> Int end. diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index c209f506b1..09b0b5440b 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -58,7 +58,7 @@ static struct { int num_args; /* Number of arguments. */ void (*func)(char* buf, int len); } commands[] = { - "ei_connect_init", 3, cmd_ei_connect_init, + "ei_connect_init", 4, cmd_ei_connect_init, "ei_publish", 1, cmd_ei_publish, "ei_accept", 1, cmd_ei_accept, "ei_receive", 1, cmd_ei_receive, @@ -106,21 +106,25 @@ TESTCASE(interpret) static void cmd_ei_connect_init(char* buf, int len) { int index = 0, r = 0; - int type, size; - long l; - char b[100]; + long num, creation; + unsigned long compat; + char node_name[100]; char cookie[MAXATOMLEN], * cp = cookie; ei_x_buff res; - if (ei_decode_long(buf, &index, &l) < 0) + if (ei_decode_long(buf, &index, &num) < 0) fail("expected int"); - sprintf(b, "c%d", l); - /* FIXME don't use internal and maybe use skip?! */ - ei_get_type_internal(buf, &index, &type, &size); + sprintf(node_name, "c%d", num); if (ei_decode_atom(buf, &index, cookie) < 0) fail("expected atom (cookie)"); if (cookie[0] == '\0') cp = NULL; - r = ei_connect_init(&ec, b, cp, 0); + if (ei_decode_long(buf, &index, &creation) < 0) + fail("expected int"); + if (ei_decode_long(buf, &index, &compat) < 0) + fail("expected uint"); + if (compat) + ei_set_compat_rel(compat); + r = ei_connect_init(&ec, node_name, cp, creation); ei_x_new_with_version(&res); ei_x_encode_long(&res, r); send_bin_term(&res); diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 75b6bf18da..6184ce801b 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -79,9 +79,10 @@ ei_send_funs(Config) when is_list(Config) -> {ok,Fd} = ei_connect(P, node()), Fun1 = fun ei_send/1, - Fun2 = fun(X) -> P, X, Fd, Fun1 end, + Fun2 = fun(X) -> {P, X, Fd, Fun1} end, + Bits = <<1,2,3:5>>, - AMsg={Fun1,Fun2}, + AMsg={Fun1,Fun2,Bits}, %%AMsg={wait_with_funs, new_dist_format}, ok = ei_send_funs(P, Fd, self(), AMsg), EIMsg = receive M -> M end, diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c index 58c0c7f8d8..7c9e79f837 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c +++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c @@ -107,7 +107,6 @@ TESTCASE(interpret) static void cmd_ei_connect_init(char* buf, int len) { int index = 0, r = 0; - int type, size; long l; char b[100]; char cookie[MAXATOMLEN], * cp = cookie; @@ -115,8 +114,6 @@ static void cmd_ei_connect_init(char* buf, int len) if (ei_decode_long(buf, &index, &l) < 0) fail("expected int"); sprintf(b, "c%ld", l); - /* FIXME don't use internal and maybe use skip?! */ - ei_get_type_internal(buf, &index, &type, &size); if (ei_decode_atom(buf, &index, cookie) < 0) fail("expected atom (cookie)"); if (cookie[0] == '\0') @@ -212,6 +209,8 @@ static void cmd_ei_send_funs(char* buf, int len) erlang_pid pid; ei_x_buff x; erlang_fun fun1, fun2; + unsigned char bitstring[10]; + size_t bits; if (ei_decode_long(buf, &index, &fd) < 0) fail("expected long"); @@ -219,20 +218,24 @@ static void cmd_ei_send_funs(char* buf, int len) fail("expected pid (node)"); if (ei_decode_tuple_header(buf, &index, &n) < 0) fail("expected tuple"); - if (n != 2) + if (n != 3) fail("expected tuple"); if (ei_decode_fun(buf, &index, &fun1) < 0) fail("expected Fun1"); if (ei_decode_fun(buf, &index, &fun2) < 0) fail("expected Fun2"); + if (ei_decode_bitstring(buf, &index, bitstring, sizeof(bitstring), &bits) < 0) + fail("expected bitstring"); if (ei_x_new_with_version(&x) < 0) fail("ei_x_new_with_version"); - if (ei_x_encode_tuple_header(&x, 2) < 0) + if (ei_x_encode_tuple_header(&x, 3) < 0) fail("encode tuple header"); if (ei_x_encode_fun(&x, &fun1) < 0) fail("encode fun1"); if (ei_x_encode_fun(&x, &fun2) < 0) fail("encode fun2"); + if (ei_x_encode_bitstring(&x, bitstring, bits) < 0) + fail("encode bitstring"); free_fun(&fun1); free_fun(&fun2); send_errno_result(ei_send(fd, &pid, x.buff, x.index)); diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index 75560ea7c9..e005ec89c7 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -194,6 +194,9 @@ test_ei_decode_misc(Config) when is_list(Config) -> send_term_as_binary(P,<<>>), send_term_as_binary(P,<<"ÅÄÖåäö">>), + send_term_as_binary(P,<<1, 2, 3:5>>), + send_term_as_binary(P,<<1:1>>), + % send_term_as_binary(P,{}), % send_term_as_binary(P,[]), diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index e516f310b6..d39970a857 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -256,66 +256,129 @@ int ei_decode_my_string(const char *buf, int *index, char *to, //#define EI_DECODE_UTF8_STRING(FUNC,SIZE,VAL) -#define EI_DECODE_BIN(FUNC,SIZE,VAL,LEN) \ - { \ - char p[1024]; \ - char *buf; \ - long len; \ - int size1 = 0; \ - int size2 = 0; \ - int err; \ - message("ei_" #FUNC " should be " #VAL); \ - buf = read_packet(NULL); \ - err = ei_ ## FUNC(buf+1, &size1, NULL, &len); \ +static void decode_bin(int exp_size, const char* val, int exp_len) +{ + char p[1024]; + char *buf; + long len; + int size1 = 0; + int size2 = 0; + int err; + message("ei_decode_binary should be %s", val); + buf = read_packet(NULL); + err = ei_decode_binary(buf+1, &size1, NULL, &len); message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ - err,size1,len,SIZE,LEN); \ - if (err != 0) { \ - if (err != -1) { \ - fail("returned non zero but not -1 if NULL pointer"); \ - } else { \ - fail("returned non zero"); \ - } \ - return; \ - } \ -\ - if (len != LEN) { \ - fail("size is not correct"); \ - return; \ - } \ -\ - err = ei_ ## FUNC(buf+1, &size2, p, &len); \ + err,size1,len, exp_size, exp_len); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (len != exp_len) { + fail("size is not correct"); + return; + } + + err = ei_decode_binary(buf+1, &size2, p, &len); message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ - err,size2,len,SIZE,LEN); \ - if (err != 0) { \ - if (err != -1) { \ - fail("returned non zero but not -1 if NULL pointer"); \ - } else { \ - fail("returned non zero"); \ - } \ - return; \ - } \ -\ - if (len != LEN) { \ - fail("size is not correct"); \ - return; \ - } \ -\ - if (strncmp(p,VAL,LEN) != 0) { \ - fail("value is not correct"); \ - return; \ - } \ -\ - if (size1 != size2) { \ - fail("size with and without pointer differs"); \ - return; \ - } \ -\ - if (size1 != SIZE) { \ - fail("size of encoded data is incorrect"); \ - return; \ - } \ - free_packet(buf); \ - } \ + err,size2,len, exp_size, exp_len); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (len != exp_len) { + fail("size is not correct"); + return; + } + + if (strncmp(p,val,exp_len) != 0) { + fail("value is not correct"); + return; + } + + if (size1 != size2) { + fail("size with and without pointer differs"); + return; + } + + if (size1 != exp_size) { + fail("size of encoded data is incorrect"); + return; + } + free_packet(buf); +} + +static void decode_bits(int exp_size, const char* val, size_t exp_bits) +{ + char p[1024]; + char *buf; + size_t bits; + int size1 = 0; + int size2 = 0; + int err; + message("ei_decode_bitstring should be %d bits", (int)exp_bits); + buf = read_packet(NULL); + err = ei_decode_bitstring(buf+1, &size1, NULL, sizeof(p), &bits); + message("err = %d, size = %d, len = %d, expected size = %d, expected bits = %d\n",\ + err,size1, (int)bits, exp_size, (int)exp_bits); + + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (bits != exp_bits) { + fail("number of bits is not correct"); + return; + } + + err = ei_decode_bitstring(buf+1, &size2, p, sizeof(p), &bits); + message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ + err,size2, (int)bits, exp_size, (int)exp_bits); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (bits != exp_bits) { + fail("bits is not correct"); + return; + } + + if (memcmp(p, val, (exp_bits+7)/8) != 0) { + fail("value is not correct"); + return; + } + + if (size1 != size2) { + fail("size with and without pointer differs"); + return; + } + + if (size1 != exp_size) { + fail2("size of encoded data is incorrect %d != %d", size1, exp_size); + return; + } + free_packet(buf); +} + /* ******************************************************************** */ @@ -644,9 +707,17 @@ TESTCASE(test_ei_decode_misc) EI_DECODE_STRING(decode_my_string, 1, ""); EI_DECODE_STRING(decode_my_string, 9, "������"); - EI_DECODE_BIN(decode_binary, 8, "foo", 3); - EI_DECODE_BIN(decode_binary, 5, "", 0); - EI_DECODE_BIN(decode_binary, 11, "������", 6); + decode_bin(8, "foo", 3); + decode_bin(5, "", 0); + decode_bin(11, "������", 6); + +#define LAST_BYTE(V, BITS) ((V) << (8-(BITS))) + { + unsigned char bits1[] = {1, 2, LAST_BYTE(3,5) }; + unsigned char bits2[] = {LAST_BYTE(1,1) }; + decode_bits(9, bits1, 21); + decode_bits(7, bits2, 1); + } /* FIXME check \0 in strings and atoms? */ /* diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 0f23cdfbb9..d8b0bce3ae 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -120,6 +120,8 @@ test_ei_decode_encode(Config) when is_list(Config) -> send_rec(P, #{key => value}), send_rec(P, maps:put(Port, Ref, #{key => value, key2 => Pid})), + [send_rec(P, <<16#dec0deb175:B/little>>) || B <- lists:seq(0,48)], + runner:recv_eot(P), ok. diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 55d9ed1b1a..f9c05b2739 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -40,6 +40,12 @@ typedef struct erlang_char_encoding enc; }my_atom; +typedef struct +{ + char bytes[MAXATOMLEN_UTF8]; + size_t nbits; +}my_bitstring; + struct my_obj { union { erlang_fun fun; @@ -49,6 +55,7 @@ struct my_obj { erlang_trace trace; erlang_big big; my_atom atom; + my_bitstring bits; int arity; }u; @@ -119,6 +126,26 @@ struct Type my_atom_type = { (encodeFT*)ei_encode_my_atom, (x_encodeFT*)ei_x_encode_my_atom }; +int ei_decode_my_bits(const char *buf, int *index, my_bitstring* a) +{ + return ei_decode_bitstring(buf, index, (a ? a->bytes : NULL), + sizeof(a->bytes), + (a ? &a->nbits : NULL)); +} +int ei_encode_my_bits(char *buf, int *index, my_bitstring* a) +{ + return ei_encode_bitstring(buf, index, a->bytes, a->nbits); +} +int ei_x_encode_my_bits(ei_x_buff* x, my_bitstring* a) +{ + return ei_x_encode_bitstring(x, a->bytes, a->nbits); +} + +struct Type my_bitstring_type = { + "bits", "my_bitstring", (decodeFT*)ei_decode_my_bits, + (encodeFT*)ei_encode_my_bits, (x_encodeFT*)ei_x_encode_my_bits +}; + int my_decode_tuple_header(const char *buf, int *index, struct my_obj* obj) { @@ -537,6 +564,10 @@ TESTCASE(test_ei_decode_encode) decode_encode(map, 7); } + for (i=0; i <= 48; i++) { + decode_encode_one(&my_bitstring_type); + } + report(1); } diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index dae6052d55..5e63f75ab5 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.11.1 +EI_VSN = 3.11.2 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 91dd9cd6ed..2710ea2f2f 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,29 @@ <file>notes.xml</file> </header> - <section><title>Inets 7.0.6</title> + <section><title>Inets 7.0.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix the internal handling of the option + erl_script_timeout in httpd. If explicit + erl_script_timeout value was supplied in seconds it was + not correctly converted to millisecond units for internal + usage.</p> + <p> + This change fixes the handling of erl_script_timeout in + all possible configuration scenarios.</p> + <p> + Own Id: OTP-15769 Aux Id: ERIERL-345 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.6</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 37e4f97bc0..aaa7e428c2 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -24,7 +24,7 @@ -export([newformat/3, post_chunked/3, post_204/3]). %% These are used by the inets test-suite --export([delay/1, chunk_timeout/3]). +-export([delay/1, chunk_timeout/3, get_chunks/3]). print(String) -> @@ -196,3 +196,22 @@ chunk_timeout(SessionID, _, _StrInt) -> mod_esi:deliver(SessionID, top("Test chunk encoding timeout")), timer:sleep(20000), mod_esi:deliver(SessionID, footer()). + +get_chunks(Sid, _Env, In) -> + Tokens = string:tokens(In, [$&]), + PropList = lists:map(fun(E) -> + list_to_tuple(string:tokens(E,[$=])) end, + Tokens), + HeaderDelay = + list_to_integer(proplists:get_value("header_delay", PropList, "0")), + ChunkDelay = + list_to_integer(proplists:get_value("chunk_delay", PropList, "0")), + BadChunkDelay = + list_to_integer(proplists:get_value("bad_chunk_delay", PropList, "0")), + timer:sleep(HeaderDelay), + mod_esi:deliver(Sid, ["Content-Type: text/plain\r\n\r\n"]), + mod_esi:deliver(Sid, "Chunk 0 ms\r\n"), + timer:sleep(ChunkDelay), + mod_esi:deliver(Sid, io_lib:format("Chunk ~p ms\r\n", [ChunkDelay])), + timer:sleep(ChunkDelay + BadChunkDelay), + mod_esi:deliver(Sid, "BAD Chunk\r\n"). diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index f495f12f03..8cbd9798e6 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -119,7 +119,7 @@ load("EvalScriptAlias " ++ EvalScriptAlias, []) -> load("ErlScriptTimeout " ++ Timeout, [])-> case catch list_to_integer(string:strip(Timeout)) of TimeoutSec when is_integer(TimeoutSec) -> - {ok, [], {erl_script_timeout, TimeoutSec * 1000}}; + {ok, [], {erl_script_timeout, TimeoutSec}}; _ -> {error, ?NICE(string:strip(Timeout) ++ " is an invalid ErlScriptTimeout")} @@ -500,7 +500,7 @@ kill_esi_delivery_process(Pid) -> erl_script_timeout(Db) -> - httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT * 1000). + httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT) * 1000. script_elements(FuncAndInput, Input) -> case input_type(FuncAndInput) of diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index fcb9ad7905..fc5ca14dcd 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -79,7 +79,10 @@ all() -> {group, http_not_sup}, {group, https_not_sup}, mime_types_format, - erl_script_timeout_option + erl_script_timeout_default, + erl_script_timeout_option, + erl_script_timeout_proplist, + erl_script_timeout_apache ]. groups() -> @@ -384,6 +387,10 @@ init_per_testcase(disk_log_bad_file, Config0) -> ct:timetrap({seconds, 20}), dbg(disk_log_internal, Config1, init); +init_per_testcase(erl_script_timeout_default, Config) -> + ct:timetrap({seconds, 60}), + dbg(erl_script_timeout_default, Config, init); + init_per_testcase(Case, Config) -> ct:timetrap({seconds, 20}), dbg(Case, Config, init). @@ -1777,16 +1784,128 @@ mime_types_format(Config) when is_list(Config) -> {"cpt","application/mac-compactpro"}, {"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes). +erl_script_timeout_default(Config) when is_list(Config) -> + inets:start(), + {ok, Pid} = inets:start(httpd, + [{port, 0}, + {server_name,"localhost"}, + {server_root,"./"}, + {document_root,"./"}, + {bind_address, any}, + {mimetypes, [{"html", "text/html"}]}, + {modules,[mod_esi]}, + {erl_script_alias, {"/erl", [httpd_example]}} + ]), + Info = httpd:info(Pid), + + Port = proplists:get_value(port, Info), + + %% Default erl_script_timeout is 15. + %% Verify: 13 =< erl_script_timeout =< 17 + Url = http_get_url(Port, 500, 13000, 4000), + + {ok, {_, _, Body}} = httpc:request(get, {Url, []}, [{timeout, 45000}], []), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 13000), + inets:stop(). erl_script_timeout_option(Config) when is_list(Config) -> inets:start(), - {ok, Pid} = inets:start(httpd, [{erl_script_timeout, 215}, - {server_name, "test"}, - {port,0}, - {server_root, "."}, - {document_root, "."}]), + {ok, Pid} = inets:start(httpd, + [{port, 0}, + {server_name,"localhost"}, + {server_root,"./"}, + {document_root,"./"}, + {bind_address, any}, + {mimetypes, [{"html", "text/html"}]}, + {modules,[mod_esi]}, + {erl_script_timeout, 2}, + {erl_script_alias, {"/erl", [httpd_example]}} + ]), Info = httpd:info(Pid), - 215 = proplists:get_value(erl_script_timeout, Info), + verify_timeout(Info, 2), + + Port = proplists:get_value(port, Info), + + %% Verify: 1 =< erl_script_timeout =< 3 + Url = http_get_url(Port, 500, 1000, 2000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 1000), + inets:stop(). + +erl_script_timeout_proplist(Config) when is_list(Config) -> + HttpdConf = filename:join(get_tmp_dir(Config), + "httpd_erl_script_timeout_proplist.conf"), + ServerConfig = + "[{port, 0},\n" ++ + " {server_name,\"localhost\"},\n" ++ + " {server_root,\"./\"},\n" ++ + " {document_root,\"./\"},\n" ++ + " {bind_address, any},\n" ++ + " {mimetypes, [{\"html\", \"text/html\"}]},\n" ++ + " {modules,[mod_esi]},\n" ++ + " {erl_script_timeout, 5},\n" ++ + " {erl_script_alias, {\"/erl\", [httpd_example]}}\n" ++ + "].", + ok = file:write_file(HttpdConf, ServerConfig), + + inets:start(), + {ok, Pid} = inets:start(httpd, + [{proplist_file, HttpdConf}]), + Info = httpd:info(Pid), + verify_timeout(Info, 5), + + Port = proplists:get_value(port, Info), + + %% Verify: 3 =< erl_script_timeout =< 7 + Url = http_get_url(Port, 500, 3000, 4000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 3000), + inets:stop(). + +erl_script_timeout_apache(Config) when is_list(Config) -> + HttpdConf = filename:join(get_tmp_dir(Config), + "httpd_erl_script_timeout.conf"), + MimeTypes = filename:join(get_tmp_dir(Config), + "erl_script_timeout_mime_types.conf"), + + MimeTypesConf = + "html\n" ++ + "text/html\n", + + ok = file:write_file(MimeTypes, MimeTypesConf), + + ServerConfig = + "Port 0\n" ++ + "ServerName localhost\n" ++ + "ServerRoot ./\n" ++ + "DocumentRoot ./\n" ++ + "BindAddress 0.0.0.0\n" ++ + "MimeTypes " ++ MimeTypes ++ "\n" ++ + "Modules mod_esi\n" ++ + "ErlScriptTimeout 8\n" ++ + "ErlScriptAlias /erl httpd_example\n", + + ok = file:write_file(HttpdConf, ServerConfig), + + inets:start(), + {ok, Pid} = inets:start(httpd, + [{file, HttpdConf}]), + Info = httpd:info(Pid), + verify_timeout(Info, 8), + + Port = proplists:get_value(port, Info), + + %% Verify: 6 =< erl_script_timeout =< 10 + Url = http_get_url(Port, 500, 6000, 4000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 6000), inets:stop(). @@ -1798,6 +1917,38 @@ url(http, End, Config) -> {ok,Host} = inet:gethostname(), ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End. +http_get_url(Port0, HeaderDelay, ChunkDelay, BadChunkDelay) -> + {ok, Host} = inet:gethostname(), + Port = integer_to_list(Port0), + HD = integer_to_list(HeaderDelay), + CD = integer_to_list(ChunkDelay), + BD = integer_to_list(BadChunkDelay), + "http://" ++ Host ++ ":" ++ Port ++ + "/erl/httpd_example/get_chunks?header_delay=" ++ HD ++ + "&chunk_delay=" ++ CD ++ + "&bad_chunk_delay=" ++ BD. + +verify_body(Body, Timeout0) -> + Timeout = integer_to_list(Timeout0), + Res = string:find(Body, Timeout), + ct:log("Result: ~p~n", [Res]), + %% Fail if BAD chunk is found. + case Res =:= Timeout ++ " ms\r\n" of + true -> + ok; + false -> + ct:fail("Unexpected chunk received!") + end. + +verify_timeout(Info, Expected) -> + Timeout = proplists:get_value(erl_script_timeout, Info), + case Timeout =:= Expected of + true -> + ok; + false -> + ct:fail("Bad Timeout - Expected: ~p Got: ~p", [Expected, Timeout]) + end. + do_max_clients(Config) -> Version = proplists:get_value(http_version, Config), Host = proplists:get_value(host, Config), diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index b7ddf39ebd..fd248e793a 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0.6 +INETS_VSN = 7.0.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index 222330654a..c3f71a84f0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -89,7 +89,7 @@ public class AbstractNode implements OtpTransportFactory { static final int dFlagHiddenAtomCache = 0x40; // NOT SUPPORTED static final int dflagNewFunTags = 0x80; static final int dFlagExtendedPidsPorts = 0x100; - static final int dFlagExportPtrTag = 0x200; // NOT SUPPORTED + static final int dFlagExportPtrTag = 0x200; static final int dFlagBitBinaries = 0x400; static final int dFlagNewFloats = 0x800; static final int dFlagUnicodeIo = 0x1000; @@ -105,6 +105,7 @@ public class AbstractNode implements OtpTransportFactory { int flags = dFlagExtendedReferences | dFlagExtendedPidsPorts | dFlagBitBinaries | dFlagNewFloats | dFlagFunTags | dflagNewFunTags | dFlagUtf8Atoms | dFlagMapTag + | dFlagExportPtrTag | dFlagBigCreation; /* initialize hostname and default cookie */ diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 4f225a396e..7833d070b7 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -142,7 +142,8 @@ fun_roundtrip(Config) when is_list(Config)-> do_echo([fun(A, B) -> A + B end, fun(A) -> lists:reverse(A) end, fun() -> ok end, - fun fun_roundtrip/1], + fun fun_roundtrip/1, + fun ?MODULE:fun_roundtrip/1], Config). port_roundtrip(doc) -> []; diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index c4d276f9e8..e6a30d0b92 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -33,6 +33,7 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, flat_size/1, get_internal_state/1, instructions/0, + interpreter_size/0, map_info/1, same/2, set_internal_state/2, size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3, lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0, @@ -118,6 +119,11 @@ get_internal_state(_) -> instructions() -> erlang:nif_error(undef). +-spec interpreter_size() -> pos_integer(). + +interpreter_size() -> + erlang:nif_error(undef). + -spec ic(F) -> Result when F :: function(), Result :: term(). diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index ba2d89313e..d28f229b3e 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -68,7 +68,7 @@ -type util_cpus() :: 'all' | integer() | [integer()]. -type util_state() :: 'user' | 'nice_user' | 'kernel' | 'wait' | 'idle'. --type util_value() :: [{util_state(), float()}] | float(). +-type util_value() :: [{util_state(), number()}] | number(). -type util_desc() :: {util_cpus(), util_value(), util_value(), []}. %%---------------------------------------------------------------------- @@ -122,7 +122,7 @@ util(Args) when is_list (Args) -> util(_) -> erlang:error(badarg). --spec util() -> float() | {'error', any()}. +-spec util() -> number() | {'error', any()}. util() -> case util([]) of diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 423d90fef6..a6c3d57148 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -73,6 +73,23 @@ </section> + <section><title>SNMP 5.2.11.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + [snmp|agent] Add a get-mechanism callback module (and a + corresponding behaviour). The agent calls this module to + handle each get (get, get-next and get-bulk) request.</p> + <p> + Own Id: OTP-15691 Aux Id: ERIERL-324 </p> + </item> + </list> + </section> + +</section> + <section><title>SNMP 5.2.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index a521b3773b..f280260f47 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -1794,9 +1794,8 @@ worker_loop(Master) -> GbMaxVBs, Extra) end catch - T:E -> - exit({worker_crash, Req, T, E, - erlang:get_stacktrace()}) + C:E:S -> + exit({worker_crash, Req, C, E, S}) end, Master ! worker_available, HandlePduRes; % For debugging... @@ -1822,9 +1821,8 @@ worker_loop(Master) -> get(net_if)) end catch - T:E -> - exit({worker_crash, Req, T, E, - erlang:get_stacktrace()}) + C:E:S -> + exit({worker_crash, Req, C, E, S}) end, Master ! worker_available, SendTrapRes; % For debugging... @@ -2543,22 +2541,31 @@ process_msg( process_pdu(#pdu{type='get-request', request_id = ReqId, varbinds=Vbs}, _PduMS, Vsn, MibView, _GbMaxVBs) -> ?vtrace("get ~p",[ReqId]), - Res = get_err(do_get(MibView, Vbs, false)), - ?vtrace("get result: " - "~n ~p",[Res]), + OrigRes = do_get(MibView, Vbs, false), + Res = get_err(OrigRes), {ErrStatus, ErrIndex, ResVarbinds} = if Vsn =:= 'version-1' -> validate_get_v1(Res); true -> Res end, - ?vtrace("get final result: " - "~n Error status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p", - [ErrStatus,ErrIndex,ResVarbinds]), + if + (ErrStatus =/= noError) -> + ?vlog("get final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", + [ErrStatus, ErrIndex, ResVarbinds]) + end, ResponseVarbinds = lists:keysort(#varbind.org_index, ResVarbinds), ?vtrace("response varbinds: " - "~n ~p",[ResponseVarbinds]), + "~n ~p", [ResponseVarbinds]), make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'get-next-request', request_id = ReqId, varbinds = Vbs}, @@ -2566,22 +2573,31 @@ process_pdu(#pdu{type = 'get-next-request', request_id = ReqId, varbinds = Vbs}, ?vtrace("process get-next-request -> entry with" "~n ReqId: ~p" "~n Vbs: ~p" - "~n MibView: ~p",[ReqId, Vbs, MibView]), - Res = get_err(do_get_next(MibView, Vbs)), - ?vtrace("get-next result: " - "~n ~p",[Res]), + "~n MibView: ~p", [ReqId, Vbs, MibView]), + OrigRes = do_get_next(MibView, Vbs), + Res = get_err(OrigRes), {ErrStatus, ErrIndex, ResVarbinds} = if Vsn =:= 'version-1' -> validate_next_v1(Res, MibView); true -> Res end, - ?vtrace("get-next final result -> validation result:" - "~n Error status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p",[ErrStatus,ErrIndex,ResVarbinds]), + if + (ErrStatus =/= noError) -> + ?vlog("get-next final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get-next final result:" + "~n Error status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", [ErrStatus, ErrIndex, ResVarbinds]) + end, ResponseVarbinds = lists:keysort(#varbind.org_index, ResVarbinds), ?vtrace("get-next final result -> response varbinds: " - "~n ~p",[ResponseVarbinds]), + "~n ~p", [ResponseVarbinds]), make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'get-bulk-request', @@ -2590,31 +2606,50 @@ process_pdu(#pdu{type = 'get-bulk-request', error_status = NonRepeaters, error_index = MaxRepetitions}, PduMS, _Vsn, MibView, GbMaxVBs) -> - {ErrStatus, ErrIndex, ResponseVarbinds} = - get_err(do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Vbs, - GbMaxVBs)), - ?vtrace("get-bulk final result: " - "~n Error status: ~p" - "~n Error index: ~p" - "~n Respons varbinds: ~p", - [ErrStatus,ErrIndex,ResponseVarbinds]), + OrigRes = do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Vbs, + GbMaxVBs), + {ErrStatus, ErrIndex, ResponseVarbinds} = get_err(OrigRes), + if + (ErrStatus =/= noError) -> + ?vlog("get-bulk final result: " + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get-bulk final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n Response Varbinds: ~p", + [ErrStatus, ErrIndex, ResponseVarbinds]) + end, make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'set-request', request_id = ReqId, varbinds = Vbs}, - _PduMS, Vsn, MibView, _GbMaxVbs)-> - Res = do_set(MibView, Vbs), - ?vtrace("set result: " - "~n ~p",[Res]), + _PduMS, Vsn, MibView, _GbMaxVbs) -> + OrigRes = do_set(MibView, Vbs), {ErrStatus, ErrIndex} = if - Vsn =:= 'version-1' -> validate_err(v2_to_v1, Res); - true -> Res + Vsn =:= 'version-1' -> validate_err(v2_to_v1, OrigRes); + true -> OrigRes end, - ?vtrace("set final result: " - "~n Error status: ~p" - "~n Error index: ~p",[ErrStatus,ErrIndex]), + if + (ErrStatus =/= noError) -> + ?vlog("set final result: " + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("set final result: " + "~n Error Status: ~p" + "~n Error Index: ~p", [ErrStatus, ErrIndex]) + end, make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, Vbs). + %%----------------------------------------------------------------- %% Transform a value == noSuchInstance | noSuchObject or a %% Counter64 type to a noSuchName error for the whole pdu. diff --git a/lib/snmp/src/agent/snmpa_local_db.erl b/lib/snmp/src/agent/snmpa_local_db.erl index eb67b9cd6f..f481641242 100644 --- a/lib/snmp/src/agent/snmpa_local_db.erl +++ b/lib/snmp/src/agent/snmpa_local_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -147,12 +147,13 @@ init([Prio, DbDir, DbInitError, Opts]) -> do_init(Prio, DbDir, DbInitError, Opts) -> process_flag(priority, Prio), process_flag(trap_exit, true), - put(sname,ldb), - put(verbosity,get_opt(verbosity, Opts, ?default_verbosity)), + put(sname, get_opt(sname, Opts, ldb)), + put(verbosity, get_opt(verbosity, Opts, ?default_verbosity)), ?vlog("starting",[]), Dets = dets_open(DbDir, DbInitError, Opts), Ets = ets:new(?ETS_TAB, [set, protected]), ?vdebug("started",[]), + put(started, snmp_misc:formated_timestamp()), {ok, #state{dets = Dets, ets = Ets}}. dets_open(DbDir, DbInitError, Opts) -> @@ -625,7 +626,7 @@ handle_info(Info, State) -> terminate(Reason, State) -> - ?vlog("terminate: ~p",[Reason]), + ?vlog("terminate: ~p", [Reason]), close(State). diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index 1f847b7a29..39254503ac 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -64,8 +64,18 @@ strip_extension_from_filename/2, str_xor/2, time/3, - - verify_behaviour/2 + + verify_behaviour/2, + + %% These are used both for debugging (verbosity printouts) + %% and other such "utility" operations. + format_timestamp/1, format_timestamp/2, + format_short_timestamp/1, format_short_timestamp/2, + format_long_timestamp/1, format_long_timestamp/2, + formated_timestamp/0, + formated_short_timestamp/0, + formated_long_timestamp/0 + ]). @@ -112,6 +122,102 @@ now(sec) -> erlang:monotonic_time(seconds). + +%% --------------------------------------------------------------------------- +%% # formated_timstamp/0, formated_timstamp/1 +%% # format_short_timstamp/0, format_short_timstamp/1 +%% # format_long_timstamp/0, format_long_timstamp/1 +%% +%% Create a formatted timestamp. Short means that it will not include +%% the date in the formatted timestamp. Also it will only include millis. +%% --------------------------------------------------------------------------- + +formated_timestamp() -> + formated_long_timestamp(). + +formated_short_timestamp() -> + format_short_timestamp(os:timestamp()). + +formated_long_timestamp() -> + format_long_timestamp(os:timestamp()). + + +%% --------------------------------------------------------------------------- +%% # format_timstamp/1, format_timstamp/2 +%% # format_short_timstamp/1, format_short_timstamp/2 +%% # format_long_timstamp/1, format_long_timstamp/2 +%% +%% Formats the provided timestamp. Short means that it will not include +%% the date in the formatted timestamp. +%% --------------------------------------------------------------------------- + +-spec format_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_timestamp(Now) -> + format_long_timestamp(Now). + +-spec format_short_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_short_timestamp(Now) -> + N2T = fun(N) -> calendar:now_to_local_time(N) end, + format_timestamp(short, Now, N2T). + +-spec format_long_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_long_timestamp(Now) -> + N2T = fun(N) -> calendar:now_to_local_time(N) end, + format_timestamp(long, Now, N2T). + +-spec format_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_long_timestamp(Now, N2T). + +-spec format_short_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_short_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_timestamp(short, Now, N2T). + +-spec format_long_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_long_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_timestamp(long, Now, N2T). + +format_timestamp(Format, {_N1, _N2, N3} = Now, N2T) -> + {Date, Time} = N2T(Now), + do_format_timestamp(Format, Date, Time, N3). + +do_format_timestamp(short, _Date, Time, N3) -> + do_format_short_timestamp(Time, N3); +do_format_timestamp(long, Date, Time, N3) -> + do_format_long_timestamp(Date, Time, N3). + +do_format_long_timestamp(Date, Time, N3) -> + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~.3.0w", + [YYYY, MM, DD, Hour, Min, Sec, N3 div 1000]), + lists:flatten(FormatDate). + +do_format_short_timestamp(Time, N3) -> + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.3.0w", + [Hour, Min, Sec, N3 div 1000]), + lists:flatten(FormatDate). + + + is_crypto_supported(Alg) -> %% The 'try catch' handles the case when 'crypto' is %% not present in the system (or not started). diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index edfb52a474..9b2676d048 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2019. 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. @@ -70,16 +70,7 @@ print2(_Verbosity,Format,Arguments) -> timestamp() -> - format_timestamp(os:timestamp()). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). + snmp_misc:formated_timestamp(). process_args([], Acc) -> lists:reverse(Acc); @@ -155,7 +146,8 @@ image_of_sname(mgr) -> "MGR"; image_of_sname(mgr_misc) -> "MGR_MISC"; image_of_sname(undefined) -> ""; -image_of_sname(V) -> lists:flatten(io_lib:format("~p",[V])). +image_of_sname(N) when is_list(N) -> N; % Used in testing +image_of_sname(N) -> lists:flatten(io_lib:format("~p", [N])). validate(info) -> info; diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index f9c18af6ea..71e3fa3b9a 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2018. All Rights Reserved. +%% Copyright Ericsson AB 2003-2019. 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. @@ -1116,15 +1116,15 @@ init_ms(Config, Opts) when is_list(Config) -> Opts1 = [MasterAgentVerbosity, MibsVerbosity, SymStoreVerbosity | Opts], [{vsn, v1} | start_v1_agent(Config, Opts1)]. -init_size_check_mse(Config) when is_list(Config) -> - MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, - init_size_check_ms(Config, [MibStorage]). +%% init_size_check_mse(Config) when is_list(Config) -> +%% MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, +%% init_size_check_ms(Config, [MibStorage]). -init_size_check_msd(Config) when is_list(Config) -> - AgentDbDir = ?GCONF(agent_db_dir, Config), - MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, - {options, [{dir, AgentDbDir}]}]}, - init_size_check_ms(Config, [MibStorage]). +%% init_size_check_msd(Config) when is_list(Config) -> +%% AgentDbDir = ?GCONF(agent_db_dir, Config), +%% MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, +%% {options, [{dir, AgentDbDir}]}]}, +%% init_size_check_ms(Config, [MibStorage]). init_size_check_msm(Config) when is_list(Config) -> ?line AgentNode = ?GCONF(snmp_master, Config), @@ -5146,12 +5146,21 @@ snmp_framework_mib_3(Config) when is_list(Config) -> %% Req. SNMP-FRAMEWORK-MIB snmp_framework_mib_test() -> ?line ["agentEngine"] = get_req(1, [[snmpEngineID,0]]), + T1 = snmp_misc:now(ms), ?line [EngineTime] = get_req(2, [[snmpEngineTime,0]]), + T2 = snmp_misc:now(ms), ?SLEEP(5000), + T3 = snmp_misc:now(ms), ?line [EngineTime2] = get_req(3, [[snmpEngineTime,0]]), - ?DBG("snmp_framework_mib -> time(s): " - "~n EngineTime 1 = ~p" - "~n EngineTime 2 = ~p", [EngineTime, EngineTime2]), + T4 = snmp_misc:now(ms), + ?PRINT2("snmp_framework_mib -> time(s): " + "~n EngineTime 1: ~p" + "~n Time to acquire: ~w ms" + "~n EngineTime 2: ~p" + "~n Time to acquire: ~w ms" + "~n => (5 sec sleep between get(snmpEngineTime))" + "~n Total time to acquire: ~w ms", + [EngineTime, T2-T1, EngineTime2, T4-T3, T4-T1]), if (EngineTime+7) < EngineTime2 -> ?line ?FAIL({too_large_diff, EngineTime, EngineTime2}); @@ -5160,11 +5169,18 @@ snmp_framework_mib_test() -> true -> ok end, + T5 = snmp_misc:now(ms), ?line case get_req(4, [[snmpEngineBoots,0]]) of [Boots] when is_integer(Boots) -> + T6 = snmp_misc:now(ms), + ?PRINT2("snmp_framework_mib -> " + "~n boots: ~p" + "~n Time to acquire: ~w ms", [Boots, T6-T5]), ok; Else -> - ?FAIL(Else) + ?PRINT2("snmp_framework_mib -> failed get proper boots:" + "~n ~p", [Else]), + ?FAIL({invalid_boots, Else}) end, ok. diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index c19c88528f..6defdadb5a 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2019. 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. @@ -358,22 +358,22 @@ run(Mod, Func, Args, Opts) -> "~n StdM: ~p", [M,Vsn,Dir,User,SecLevel,EngineID,CtxEngineID,Community,StdM]), case snmp_test_mgr:start([%% {agent, snmp_test_lib:hostname()}, - {packet_server_debug,true}, - {debug,true}, - {agent, get(master_host)}, - {ipfamily, get(ipfamily)}, - {agent_udp, 4000}, - {trap_udp, 5000}, - {recbuf,65535}, + {packet_server_debug, true}, + {debug, true}, + {agent, get(master_host)}, + {ipfamily, get(ipfamily)}, + {agent_udp, 4000}, + {trap_udp, 5000}, + {recbuf, 65535}, quiet, Vsn, - {community, Community}, - {user, User}, - {sec_level, SecLevel}, - {engine_id, EngineID}, - {context_engine_id, CtxEngineID}, - {dir, Dir}, - {mibs, mibs(StdM, M)}]) of + {community, Community}, + {user, User}, + {sec_level, SecLevel}, + {engine_id, EngineID}, + {context_engine_id, CtxEngineID}, + {dir, Dir}, + {mibs, mibs(StdM, M)}]) of {ok, _Pid} -> case (catch apply(Mod, Func, Args)) of {'EXIT', Reason} -> @@ -383,10 +383,18 @@ run(Mod, Func, Args, Opts) -> catch snmp_test_mgr:stop(), Res end; + + {error, Reason} -> + ?EPRINT2("Failed starting (test) manager: " + "~n ~p", [Reason]), + catch snmp_test_mgr:stop(), + ?line ?FAIL({mgr_start_error, Reason}); + Err -> - io:format("Error starting manager: ~p\n", [Err]), + ?EPRINT2("Failed starting (test) manager: " + "~n ~p", [Err]), catch snmp_test_mgr:stop(), - ?line ?FAIL({mgr_start, Err}) + ?line ?FAIL({mgr_start_failure, Err}) end. @@ -464,20 +472,24 @@ start_agent(Config, Vsns, Opts) -> process_flag(trap_exit,true), + ?PRINT2("start_agent -> try start snmp app supervisor", []), {ok, AppSup} = snmp_app_sup:start_link(), unlink(AppSup), ?DBG("start_agent -> snmp app supervisor: ~p", [AppSup]), - ?DBG("start_agent -> start master agent",[]), + ?PRINT2("start_agent -> try start master agent",[]), ?line Sup = start_sup(Env), - - ?DBG("start_agent -> unlink from supervisor", []), ?line unlink(Sup), + ?DBG("start_agent -> snmp supervisor: ~p", [Sup]), + + ?PRINT2("start_agent -> try (rpc) start sub agent on ~p", [SaNode]), ?line SaDir = ?config(sa_dir, Config), - ?DBG("start_agent -> (rpc) start sub on ~p", [SaNode]), ?line {ok, Sub} = start_sub_sup(SaNode, SaDir), - ?DBG("start_agent -> done",[]), - ?line [{snmp_sup, {Sup, self()}}, {snmp_sub, Sub} | Config]. + ?DBG("start_agent -> done", []), + + ?line [{snmp_app_sup, AppSup}, + {snmp_sup, {Sup, self()}}, + {snmp_sub, Sub} | Config]. app_agent_env_init(Env0, Opts) -> @@ -670,35 +682,52 @@ merge_agent_options([{Key, _Value} = Opt|Opts], Options) -> stop_agent(Config) when is_list(Config) -> - ?LOG("stop_agent -> entry with" - "~n Config: ~p",[Config]), - - {Sup, Par} = ?config(snmp_sup, Config), - ?DBG("stop_agent -> attempt to stop (sup) ~p" - "~n Sup: ~p" - "~n Par: ~p", - [Sup, - (catch process_info(Sup)), - (catch process_info(Par))]), - - _Info = agent_info(Sup), - ?DBG("stop_agent -> Agent info: " - "~n ~p", [_Info]), - - stop_sup(Sup, Par), - - {Sup2, Par2} = ?config(snmp_sub, Config), - ?DBG("stop_agent -> attempt to stop (sub) ~p" - "~n Sup2: ~p" - "~n Par2: ~p", - [Sup2, - (catch process_info(Sup2)), - (catch process_info(Par2))]), - stop_sup(Sup2, Par2), - - ?DBG("stop_agent -> done - now cleanup config", []), - C1 = lists:keydelete(snmp_sup, 1, Config), - lists:keydelete(snmp_sub, 1, C1). + ?PRINT2("stop_agent -> entry with" + "~n Config: ~p",[Config]), + + + %% Stop the sub-agent (the agent supervisor) + {SubSup, SubPar} = ?config(snmp_sub, Config), + ?PRINT2("stop_agent -> attempt to stop sub agent (~p)" + "~n Sub Sup info: " + "~n ~p" + "~n Sub Par info: " + "~n ~p", + [SubSup, + (catch process_info(SubSup)), + (catch process_info(SubPar))]), + stop_sup(SubSup, SubPar), + Config2 = lists:keydelete(snmp_sub, 1, Config), + + + %% Stop the master-agent (the top agent supervisor) + {MasterSup, MasterPar} = ?config(snmp_sup, Config), + ?PRINT2("stop_agent -> attempt to stop master agent (~p)" + "~n Master Sup: " + "~n ~p" + "~n Master Par: " + "~n ~p" + "~n Agent Info: " + "~n ~p", + [MasterSup, + (catch process_info(MasterSup)), + (catch process_info(MasterPar)), + agent_info(MasterSup)]), + stop_sup(MasterSup, MasterPar), + Config3 = lists:keydelete(snmp_sup, 1, Config2), + + + %% Stop the top supervisor (of the snmp app) + AppSup = ?config(snmp_app_sup, Config), + ?PRINT2("stop_agent -> attempt to app sup ~p" + "~n App Sup: ~p", + [AppSup, + (catch process_info(AppSup))]), + Config4 = lists:keydelete(snmp_app_sup, 1, Config3), + + + ?PRINT2("stop_agent -> done", []), + Config4. start_sup(Env) -> @@ -728,7 +757,6 @@ stop_sup(Pid, _) -> ?LOG("stop_sup -> attempt to stop ~p", [Pid]), Ref = erlang:monitor(process, Pid), ?LOG("stop_sup -> Ref: ~p", [Ref]), - %% Pid ! {'EXIT', Parent, shutdown}, % usch exit(Pid, kill), await_stopped(Pid, Ref). @@ -864,13 +892,15 @@ expect(Mod, Line, Type, Enterp, Generic, Specific, ExpVBs) -> expect2(Mod, Line, Fun). expect2(Mod, Line, F) -> - io:format("EXPECT for ~w:~w~n", [Mod, Line]), + io_format_expect("for ~w:~w", [Mod, Line]), case F() of {error, Reason} -> - io:format("EXPECT failed at ~w:~w => ~n~p~n", [Mod, Line, Reason]), + io_format_expect("failed at ~w:~w => " + "~n ~p", [Mod, Line, Reason]), throw({error, {expect, Mod, Line, Reason}}); Else -> - io:format("EXPECT result for ~w:~w => ~n~p~n", [Mod, Line, Else]), + io_format_expect("result for ~w:~w => " + "~n ~p", [Mod, Line, Else]), Else end. @@ -899,20 +929,27 @@ receive_trap(To) -> end. +io_format_expect(F) -> + io_format_expect(F, []). + +io_format_expect(F, A) -> + ?PRINT2("EXPECT " ++ F, A). + + do_expect(Expect) when is_atom(Expect) -> do_expect({Expect, get_timeout()}); do_expect({any_pdu, To}) when is_integer(To) orelse (To =:= infinity) -> - io:format("EXPECT any PDU~n", []), + io_format_expect("any PDU"), receive_pdu(To); do_expect({any_trap, To}) -> - io:format("EXPECT any TRAP within ~w~n", [To]), + io_format_expect("any TRAP within ~w", [To]), receive_trap(To); do_expect({timeout, To}) -> - io:format("EXPECT nothing within ~w~n", [To]), + io_format_expect("nothing within ~w", [To]), receive X -> {error, {unexpected, X}} @@ -924,16 +961,16 @@ do_expect({timeout, To}) -> do_expect({Err, To}) when (is_atom(Err) andalso ((is_integer(To) andalso To > 0) orelse (To =:= infinity))) -> - io:format("EXPECT error ~w within ~w~n", [Err, To]), + io_format_expect("error ~w within ~w", [Err, To]), do_expect({{error, Err}, To}); do_expect({error, Err}) when is_atom(Err) -> Check = fun(_, R) -> R end, - io:format("EXPECT error ~w~n", [Err]), + io_format_expect("error ~w", [Err]), do_expect2(Check, any, Err, any, any, get_timeout()); do_expect({{error, Err}, To}) -> Check = fun(_, R) -> R end, - io:format("EXPECT error ~w within ~w~n", [Err, To]), + io_format_expect("error ~w within ~w", [Err, To]), do_expect2(Check, any, Err, any, any, To); %% exp_varbinds() -> [exp_varbind()] @@ -943,25 +980,23 @@ do_expect({{error, Err}, To}) -> %% ExpVBs -> exp_varbinds() | {VbsCondition, exp_varbinds()} do_expect(ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'get-response'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'get-response'" + "~n with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'get-response', noError, 0, ExpVBs, get_timeout()). do_expect(v2trap, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'snmpv2-trap'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'snmpv2-trap' with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'snmpv2-trap', noError, 0, ExpVBs, get_timeout()); do_expect(report, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'report'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'report' with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'report', noError, 0, ExpVBs, get_timeout()); @@ -970,9 +1005,8 @@ do_expect(inform, ExpVBs) -> do_expect({inform, false}, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'inform-request' (false)" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'inform-request' (false) with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()); do_expect({inform, true}, ExpVBs) -> @@ -986,9 +1020,8 @@ do_expect({inform, true}, ExpVBs) -> (_, Err) -> Err end, - io:format("EXPECT 'inform-request' (true)" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'inform-request' (true) with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()); do_expect({inform, {error, EStat, EIdx}}, ExpVBs) @@ -1003,11 +1036,10 @@ do_expect({inform, {error, EStat, EIdx}}, ExpVBs) (_, Err) -> Err end, - io:format("EXPECT 'inform-request' (error)" - "~n with" - "~n Error Status: ~p" - "~n Error Index: ~p" - "~n Varbinds: ~p~n", [EStat, EIdx, ExpVBs]), + io_format_expect("'inform-request' (error) with" + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n Varbinds: ~p", [EStat, EIdx, ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()). @@ -1018,26 +1050,23 @@ do_expect(Err, Idx, ExpVBs, To) when is_atom(Err) andalso (is_integer(Idx) orelse is_list(Idx) orelse (Idx == any)) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'get-response'" - "~n with" - "~n Error: ~p" - "~n Index: ~p" - "~n Varbinds: ~p" - "~n within ~w~n", [Err, Idx, ExpVBs, To]), + io_format_expect("'get-response' withing ~w ms with" + "~n Error: ~p" + "~n Index: ~p" + "~n Varbinds: ~p", [To, Err, Idx, ExpVBs]), do_expect2(Check, 'get-response', Err, Idx, ExpVBs, To). do_expect(Type, Enterp, Generic, Specific, ExpVBs) -> - do_expect(Type, Enterp, Generic, Specific, ExpVBs, 3500). + do_expect(Type, Enterp, Generic, Specific, ExpVBs, get_timeout()). do_expect(trap, Enterp, Generic, Specific, ExpVBs, To) -> - io:format("EXPECT trap" - "~n with" - "~n Enterp: ~w" - "~n Generic: ~w" - "~n Specific: ~w" - "~n Varbinds: ~w" - "~n within ~w~n", [Enterp, Generic, Specific, ExpVBs, To]), + io_format_expect("trap within ~w ms with" + "~n Enterp: ~w" + "~n Generic: ~w" + "~n Specific: ~w" + "~n Varbinds: ~w", + [To, Enterp, Generic, Specific, ExpVBs]), PureE = purify_oid(Enterp), case receive_trap(To) of #trappdu{enterprise = PureE, @@ -1072,46 +1101,46 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) #pdu{type = Type, error_status = Err, error_index = Idx} when ExpVBs =:= any -> - io:format("EXPECT received expected pdu (1)~n", []), + io_format_expect("received expected pdu (1)"), ok; #pdu{type = Type, request_id = ReqId, error_status = Err2, error_index = Idx} when ExpVBs =:= any -> - io:format("EXPECT received expected pdu with " - "unexpected error status (2): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (2): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{error_status = Err} when (Type =:= any) andalso (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu (3)~n", []), + io_format_expect("received expected pdu (3)"), ok; #pdu{request_id = ReqId, error_status = Err2} when (Type =:= any) andalso (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu with " - "unexpected error status (4): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (4): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{type = Type, error_status = Err} when (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu (5)~n", []), + io_format_expect("received expected pdu (5)", []), ok; #pdu{type = Type, request_id = ReqId, error_status = Err2} when (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu with " - "unexpected error status (6): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (6): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{type = Type, @@ -1120,13 +1149,13 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_index = EI} when is_list(Idx) andalso (ExpVBs =:= any) -> case lists:member(EI, Idx) of true -> - io:format("EXPECT received expected pdu with " - "expected error index (7)~n", []), + io_format_expect("received expected pdu with " + "expected error index (7)"), ok; false -> - io:format("EXPECT received expected pdu with " - "unexpected error index (8): " - "~n Error Index: ~p~n", [EI]), + io_format_expect("received expected pdu with " + "unexpected error index (8): " + "~n Error Index: ~p", [EI]), {error, {unexpected_error_index, EI, Idx, ReqId}} end; @@ -1136,15 +1165,15 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_index = EI} when is_list(Idx) andalso (ExpVBs =:= any) -> case lists:member(EI, Idx) of true -> - io:format("EXPECT received expected pdu with " - "unexpected error status (9): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (9): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; false -> - io:format("EXPECT received expected pdu with " - "unexpected error (10): " - "~n Error Status: ~p" - "~n Error index: ~p~n", [Err2, EI]), + io_format_expect("received expected pdu with " + "unexpected error (10): " + "~n Error Status: ~p" + "~n Error index: ~p", [Err2, EI]), {error, {unexpected_error, {Err, Idx}, {Err2, EI}, ReqId}} end; @@ -1152,12 +1181,12 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) request_id = ReqId, error_status = Err2, error_index = Idx2} when ExpVBs =:= any -> - io:format("EXPECT received unexpected pdu with (11) " - "~n Type: ~p" - "~n ReqId: ~p" - "~n Errot status: ~p" - "~n Error index: ~p" - "~n", [Type2, ReqId, Err2, Idx2]), + io_format_expect("received unexpected pdu with (11) " + "~n Type: ~p" + "~n ReqId: ~p" + "~n Errot status: ~p" + "~n Error index: ~p", + [Type2, ReqId, Err2, Idx2]), {error, {unexpected_pdu, {Type, Err, Idx}, {Type2, Err2, Idx2}, ReqId}}; @@ -1166,26 +1195,26 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err, error_index = Idx, varbinds = VBs} = PDU -> - io:format("EXPECT received pdu (12): " - "~n [exp] Type: ~p" - "~n [exp] Error Status: ~p" - "~n [exp] Error Index: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, Err, Idx, VBs, ExpVBs]), + io_format_expect("received pdu (12): " + "~n [exp] Type: ~p" + "~n [exp] Error Status: ~p" + "~n [exp] Error Index: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, Err, Idx, VBs, ExpVBs]), Check(PDU, check_vbs(purify_oids(ExpVBs), VBs)); #pdu{type = Type, error_status = Err, varbinds = VBs} = PDU when Idx =:= any -> - io:format("EXPECT received pdu (13): " - "~n [exp] Type: ~p" - "~n [exp] Error Status: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, Err, VBs, ExpVBs]), + io_format_expect("received pdu (13): " + "~n [exp] Type: ~p" + "~n [exp] Error Status: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, Err, VBs, ExpVBs]), Check(PDU, check_vbs(purify_oids(ExpVBs), VBs)); #pdu{type = Type, @@ -1193,15 +1222,15 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err, error_index = EI, varbinds = VBs} = PDU when is_list(Idx) -> - io:format("EXPECT received pdu (14): " - "~n [exp] Type: ~p" - "~n ReqId: ~p" - "~n [exp] Error Status: ~p" - "~n [exp] Error Index: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, ReqId, Err, EI, VBs, ExpVBs]), + io_format_expect("received pdu (14): " + "~n [exp] Type: ~p" + "~n ReqId: ~p" + "~n [exp] Error Status: ~p" + "~n [exp] Error Index: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, ReqId, Err, EI, VBs, ExpVBs]), PureVBs = purify_oids(ExpVBs), case lists:member(EI, Idx) of true -> @@ -1215,13 +1244,13 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err2, error_index = Idx2, varbinds = VBs2} -> - io:format("EXPECT received unexpected pdu with (15) " - "~n Type: ~p" - "~n ReqId: ~p" - "~n Errot status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p" - "~n", [Type2, ReqId, Err2, Idx2, VBs2]), + io_format_expect("received unexpected pdu with (15) " + "~n Type: ~p" + "~n ReqId: ~p" + "~n Errot status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", + [Type2, ReqId, Err2, Idx2, VBs2]), {error, {unexpected_pdu, {Type, Err, Idx, purify_oids(ExpVBs)}, @@ -1229,9 +1258,8 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) ReqId}}; Error -> - io:format("EXPECT received error (16): " - "~n Error: ~p" - "~n", [Error]), + io_format_expect("received error (16): " + "~n Error: ~p", [Error]), Error end. diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index bb9b05b89f..5b0ebf8647 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -204,10 +204,15 @@ init_per_testcase(Case, Config) when is_list(Config) -> Result = case lists:member(Case, DeprecatedApiCases) of true -> - %% ?SKIP(api_no_longer_supported); {skip, api_no_longer_supported}; false -> - init_per_testcase2(Case, Config) + try init_per_testcase2(Case, Config) + catch + C:{skip, _} = E:_ when ((C =:= throw) orelse (C =:= exit)) -> + E; + C:E:_ when ((C =:= throw) orelse (C =:= exit)) -> + {skip, {catched, C, E}} + end end, p(Case, "init_per_testcase end when" "~n Nodes: ~p" @@ -326,9 +331,25 @@ init_per_testcase3(Case, Config) -> true -> Config end, + %% We don't need to try catch this (init_agent) + %% since we have a try catch "higher up"... Conf2 = init_agent(Conf1), - Conf3 = init_manager(AutoInform, Conf2), - Conf4 = init_mgr_user(Conf3), + Conf3 = try init_manager(AutoInform, Conf2) + catch AC:AE:_ -> + %% Ouch we need to clean up: + %% The init_agent starts an agent node! + init_per_testcase_fail_agent_cleanup(Conf2), + throw({skip, {manager_init_failed, AC, AE}}) + end, + Conf4 = try init_mgr_user(Conf3) + catch MC:ME:_ -> + %% Ouch we need to clean up: + %% The init_agent starts an agent node! + %% The init_magager starts an manager node! + init_per_testcase_fail_manager_cleanup(Conf3), + init_per_testcase_fail_agent_cleanup(Conf3), + throw({skip, {manager_user_init_failed, MC, ME}}) + end, case lists:member(Case, ApiCases02 ++ ApiCases03) of true -> init_mgr_user_data2(Conf4); @@ -339,6 +360,12 @@ init_per_testcase3(Case, Config) -> Config end. +init_per_testcase_fail_manager_cleanup(Conf) -> + (catch fin_manager(Conf)). + +init_per_testcase_fail_agent_cleanup(Conf) -> + (catch fin_agent(Conf)). + end_per_testcase(Case, Config) when is_list(Config) -> p(Case, "end_per_testcase begin when" "~n Nodes: ~p~n~n", [erlang:nodes()]), @@ -993,18 +1020,40 @@ notify_started02(Config) when is_list(Config) -> {config, [{verbosity, log}, {dir, ConfDir}, {db_dir, DbDir}]}], p("start snmpm client process"), - Pid1 = ns02_loop1_start(), + NumIterations = 5, + Pid1 = ns02_client_start(NumIterations), + + p("start snmpm ctrl (starter) process"), + Pid2 = ns02_ctrl_start(Opts, NumIterations), + + %% On a reasonably fast machine, one iteration takes approx 4 seconds. + %% We measure the first iteration, and then we wait for the remaining + %% ones (4 in this case). + ApproxStartTime = + case ns02_client_await_approx_runtime(Pid1) of + {ok, T} -> + T; + {error, Reason} -> + %% Attempt cleanup just in case + exit(Pid1, kill), + exit(Pid2, kill), + ?FAIL(Reason); + {skip, Reason} -> + %% Attempt cleanup just in case + exit(Pid1, kill), + exit(Pid2, kill), + ?SKIP(Reason) + end, - p("start snmpm starter process"), - Pid2 = ns02_loop2_start(Opts), - - p("await snmpm client process exit"), + p("await snmpm client process exit (max ~p+10000 msec)", [ApproxStartTime]), receive {'EXIT', Pid1, normal} -> ok; {'EXIT', Pid1, Reason1} -> - ?FAIL(Reason1) - after 25000 -> + ?FAIL({client, Reason1}) + after ApproxStartTime + 10000 -> + exit(Pid1, kill), + exit(Pid2, kill), ?FAIL(timeout) end, @@ -1013,8 +1062,9 @@ notify_started02(Config) when is_list(Config) -> {'EXIT', Pid2, normal} -> ok; {'EXIT', Pid2, Reason2} -> - ?FAIL(Reason2) + ?FAIL({ctrl, Reason2}) after 5000 -> + exit(Pid2, kill), ?FAIL(timeout) end, @@ -1022,26 +1072,63 @@ notify_started02(Config) when is_list(Config) -> ok. -ns02_loop1_start() -> - spawn_link(fun() -> ns02_loop1() end). +ns02_client_start(N) -> + Self = self(), + spawn_link(fun() -> ns02_client(Self, N) end). + +ns02_client_await_approx_runtime(Pid) -> + receive + {?MODULE, client_time, Time} -> + {ok, Time}; + {'EXIT', Pid, Reason} -> + p("client (~p) failed: " + "~n ~p", [Pid, Reason]), + {error, Reason} + + after 15000 -> + %% Either something is *really* wrong or this machine + %% is dog slow. Either way, this is a skip-reason... + {skip, approx_runtime_timeout} + end. + -ns02_loop1() -> - put(tname,ns02_loop1), +ns02_client(Parent, N) when is_pid(Parent) -> + put(tname, ns02_client), p("starting"), - ns02_loop1(dummy, snmpm:notify_started(?NS_TIMEOUT), 5). + ns02_client_loop(Parent, + dummy, snmpm:notify_started(?NS_TIMEOUT), + snmp_misc:now(ms), undefined, + N). -ns02_loop1(_Ref, _Pid, 0) -> - p("done"), +ns02_client_loop(_Parent, _Ref, _Pid, _Begin, _End, 0) -> + %% p("loop -> done"), exit(normal); -ns02_loop1(Ref, Pid, N) -> - p("entry when" - "~n Ref: ~p" - "~n Pid: ~p" - "~n N: ~p", [Ref, Pid, N]), +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) + when is_pid(Parent) andalso is_integer(Begin) andalso is_integer(End) -> + %% p("loop -> [~w] inform parent: ~w, ~w => ~w", [N, Begin, End, End-Begin]), + Parent ! {?MODULE, client_time, N*(End-Begin)}, + ns02_client_loop(undefined, Ref, Pid, snmp_misc:now(ms), undefined, N); +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) + when is_integer(Begin) andalso is_integer(End) -> + %% p("loop -> [~w] entry when" + %% "~n Ref: ~p" + %% "~n Pid: ~p" + %% "~n Begin: ~p" + %% "~n End: ~p", [N, Ref, Pid, Begin, End]), + ns02_client_loop(Parent, Ref, Pid, snmp_misc:now(ms), undefined, N); +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) -> + %% p("loop(await message) -> [~w] entry when" + %% "~n Ref: ~p" + %% "~n Pid: ~p" + %% "~n Begin: ~p" + %% "~n End: ~p", [N, Ref, Pid, Begin, End]), receive {snmpm_started, Pid} -> p("received expected started message (~w)", [N]), - ns02_loop1(snmpm:monitor(), dummy, N); + ns02_client_loop(Parent, + snmpm:monitor(), dummy, + Begin, End, + N); {snmpm_start_timeout, Pid} -> p("unexpected timout"), ?FAIL({unexpected_start_timeout, Pid}); @@ -1049,24 +1136,24 @@ ns02_loop1(Ref, Pid, N) -> p("received expected DOWN message (~w) with" "~n Obj: ~p" "~n Reason: ~p", [N, Obj, Reason]), - ns02_loop1(dummy, snmpm:notify_started(?NS_TIMEOUT), N-1) - after 10000 -> - ?FAIL(timeout) + ns02_client_loop(Parent, + dummy, snmpm:notify_started(?NS_TIMEOUT), + Begin, snmp_misc:now(ms), + N-1) end. - -ns02_loop2_start(Opts) -> - spawn_link(fun() -> ns02_loop2(Opts) end). +ns02_ctrl_start(Opts, N) -> + spawn_link(fun() -> ns02_ctrl(Opts, N) end). -ns02_loop2(Opts) -> - put(tname,ns02_loop2), +ns02_ctrl(Opts, N) -> + put(tname, ns02_ctrl), p("starting"), - ns02_loop2(Opts, 5). + ns02_ctrl_loop(Opts, N). -ns02_loop2(_Opts, 0) -> +ns02_ctrl_loop(_Opts, 0) -> p("done"), exit(normal); -ns02_loop2(Opts, N) -> +ns02_ctrl_loop(Opts, N) -> p("entry when N: ~p", [N]), ?SLEEP(2000), p("start manager"), @@ -1074,7 +1161,7 @@ ns02_loop2(Opts, N) -> ?SLEEP(2000), p("stop manager"), snmpm:stop(), - ns02_loop2(Opts, N-1). + ns02_ctrl_loop(Opts, N-1). %%====================================================================== @@ -5416,15 +5503,14 @@ init_manager(AutoInform, Config) -> start_manager(Node, Vsns, Conf) end catch - T:E -> - StackTrace = ?STACK(), + C:E:S -> p("Failure during manager start: " - "~n Error Type: ~p" - "~n Error: ~p" - "~n StackTrace: ~p", [T, E, StackTrace]), + "~n Error Class: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [C, E, S]), %% And now, *try* to cleanup (catch stop_node(Node)), - ?FAIL({failed_starting_manager, T, E, StackTrace}) + ?FAIL({failed_starting_manager, C, E, S}) end. fin_manager(Config) -> @@ -5432,7 +5518,7 @@ fin_manager(Config) -> StopMgrRes = stop_manager(Node), StopCryptoRes = fin_crypto(Node), StopNode = stop_node(Node), - p("fin_agent -> stop apps and (mgr node ~p) node results: " + p("fin_manager -> stop apps and (mgr node ~p) node results: " "~n SNMP Mgr: ~p" "~n Crypto: ~p" "~n Node: ~p", @@ -5498,15 +5584,14 @@ init_agent(Config) -> start_agent(Node, Vsns, Conf) end catch - T:E -> - StackTrace = ?STACK(), + C:E:S -> p("Failure during agent start: " - "~n Error Type: ~p" - "~n Error: ~p" - "~n StackTrace: ~p", [T, E, StackTrace]), + "~n Error Class: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [C, E, S]), %% And now, *try* to cleanup (catch stop_node(Node)), - ?FAIL({failed_starting_agent, T, E, StackTrace}) + ?FAIL({failed_starting_agent, C, E, S}) end. diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index 290f1bc31a..a483690653 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,7 +41,7 @@ -export([watchdog/3, watchdog_start/1, watchdog_start/2, watchdog_stop/1]). -export([del_dir/1]). -export([cover/1]). --export([p/2, print/5, formated_timestamp/0]). +-export([p/2, print1/2, print2/2, print/5, formated_timestamp/0]). %% ---------------------------------------------------------------------- @@ -58,12 +58,67 @@ from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_H, []) -> []. +%% localhost() -> +%% {ok, Ip} = snmp_misc:ip(net_adm:localhost()), +%% Ip. +%% localhost(Family) -> +%% {ok, Ip} = snmp_misc:ip(net_adm:localhost(), Family), +%% Ip. + localhost() -> - {ok, Ip} = snmp_misc:ip(net_adm:localhost()), - Ip. + localhost(inet). + localhost(Family) -> - {ok, Ip} = snmp_misc:ip(net_adm:localhost(), Family), - Ip. + case inet:getaddr(net_adm:localhost(), Family) of + {ok, {127, _, _, _}} when (Family =:= inet) -> + %% Ouch, we need to use something else + case inet:getifaddrs() of + {ok, IfList} -> + which_addr(Family, IfList); + {error, Reason1} -> + fail({getifaddrs, Reason1}, ?MODULE, ?LINE) + end; + {ok, {0, _, _, _, _, _, _, _}} when (Family =:= inet6) -> + %% Ouch, we need to use something else + case inet:getifaddrs() of + {ok, IfList} -> + which_addr(Family, IfList); + {error, Reason1} -> + fail({getifaddrs, Reason1}, ?MODULE, ?LINE) + end; + {ok, Addr} -> + Addr; + {error, Reason2} -> + fail({getaddr, Reason2}, ?MODULE, ?LINE) + end. + +which_addr(_Family, []) -> + fail(no_valid_addr, ?MODULE, ?LINE); +which_addr(Family, [{"lo", _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{"docker" ++ _, _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{"br-" ++ _, _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{_Name, IfOpts} | IfList]) -> + case which_addr2(Family, IfOpts) of + {ok, Addr} -> + Addr; + {error, _} -> + which_addr(Family, IfList) + end. + +which_addr2(_Family, []) -> + {error, not_found}; +which_addr2(Family, [{addr, Addr}|_]) + when (Family =:= inet) andalso (size(Addr) =:= 4) -> + {ok, Addr}; +which_addr2(Family, [{addr, Addr}|_]) + when (Family =:= inet6) andalso (size(Addr) =:= 8) -> + {ok, Addr}; +which_addr2(Family, [_|IfOpts]) -> + which_addr2(Family, IfOpts). + sz(L) when is_list(L) -> length(L); @@ -605,19 +660,30 @@ p(Mod, Case) when is_atom(Mod) andalso is_atom(Case) -> p(F, A) when is_list(F) andalso is_list(A) -> io:format(user, F ++ "~n", A). +%% This is just a bog standard printout, with a (formatted) timestamp +%% prefix and a newline after. +%% print1 - prints to both standard_io and user. +%% print2 - prints to just standard_io. + +print_format(F, A) -> + FTS = snmp_test_lib:formated_timestamp(), + io_lib:format("[~s] " ++ F ++ "~n", [FTS | A]). + +print1(F, A) -> + S = print_format(F, A), + io:format("~s", [S]), + io:format(user, "~s", [S]). + +print2(F, A) -> + S = print_format(F, A), + io:format("~s", [S]). + + print(Prefix, Module, Line, Format, Args) -> io:format("*** [~s] ~s ~p ~p ~p:~p *** " ++ Format ++ "~n", [formated_timestamp(), Prefix, node(), self(), Module, Line|Args]). formated_timestamp() -> - format_timestamp(os:timestamp()). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). + snmp_misc:formated_timestamp(). + diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 7acebee1f1..335f3fff3c 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-2019. 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. @@ -127,24 +127,31 @@ -endif. -ifdef(snmp_debug). --define(DBG(F,A),?PRINT("DBG",F,A)). +-define(DBG(F,A), ?PRINT("DBG", F, A)). -else. --define(DBG(F,A),ok). +-define(DBG(F,A), ok). -endif. -ifdef(snmp_log). --define(LOG(F,A),?PRINT("LOG",F,A)). +-define(LOG(F,A), ?PRINT("LOG", F, A)). -else. --define(LOG(F,A),ok). +-define(LOG(F,A), ok). -endif. -ifdef(snmp_error). --define(ERR(F,A),?PRINT("ERR",F,A)). +-define(ERR(F,A), ?PRINT("ERR", F, A)). -else. --define(ERR(F,A),ok). +-define(ERR(F,A), ok). -endif. --define(INF(F,A),?PRINT("INF",F,A)). +-define(INF(F,A), ?PRINT("INF", F, A)). -define(PRINT(P,F,A), - snmp_test_lib:print(P,?MODULE,?LINE,F,A)). + snmp_test_lib:print(P, ?MODULE, ?LINE, F, A)). + +-define(PRINT1(F, A), snmp_test_lib:print1(F, A)). +-define(EPRINT1(F, A), ?PRINT1("<ERROR> " ++ F, A)). + +-define(PRINT2(F, A), snmp_test_lib:print2(F, A)). +-define(EPRINT2(F, A), ?PRINT2("<ERROR> " ++ F, A)). + diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 36637d5cf4..73a4d56084 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -20,8 +20,10 @@ -module(snmp_test_mgr). + %%---------------------------------------------------------------------- -%% This module implements a simple SNMP manager for Erlang. +%% This module implements a simple SNMP manager for Erlang. Its used +%% during by the agent test suite. %%---------------------------------------------------------------------- %% c(snmp_test_mgr). @@ -49,16 +51,17 @@ -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/include/STANDARD-MIB.hrl"). - --record(state,{dbg = true, - quiet, - parent, - timeout = 3500, - print_traps = true, - mini_mib, - packet_server, - last_sent_pdu, - last_received_pdu}). +-include("snmp_test_lib.hrl"). + +-record(state, {dbg = true, + quiet, + parent, + timeout = 3500, + print_traps = true, + mini_mib, + packet_server, + last_sent_pdu, + last_received_pdu}). -define(SERVER, ?MODULE). -define(PACK_SERV, snmp_test_mgr_misc). @@ -197,27 +200,28 @@ init({Options, CallerPid}) -> put(debug, get_value(debug, Options, false)), d("init -> (~p) extract options",[self()]), PacksDbg = get_value(packet_server_debug, Options, false), - io:format("[~w] ~p -> PacksDbg: ~p~n", [?MODULE, self(), PacksDbg]), + print("[~w] ~p -> PacksDbg: ~p~n", [?MODULE, self(), PacksDbg]), RecBufSz = get_value(recbuf, Options, 1024), - io:format("[~w] ~p -> RecBufSz: ~p~n", [?MODULE, self(), RecBufSz]), + print("[~w] ~p -> RecBufSz: ~p~n", [?MODULE, self(), RecBufSz]), Mibs = get_value(mibs, Options, []), - io:format("[~w] ~p -> Mibs: ~p~n", [?MODULE, self(), Mibs]), + print("[~w] ~p -> Mibs: ~p~n", [?MODULE, self(), Mibs]), Udp = get_value(agent_udp, Options, 4000), - io:format("[~w] ~p -> Udp: ~p~n", [?MODULE, self(), Udp]), + print("[~w] ~p -> Udp: ~p~n", [?MODULE, self(), Udp]), User = get_value(user, Options, "initial"), - io:format("[~w] ~p -> User: ~p~n", [?MODULE, self(), User]), + print("[~w] ~p -> User: ~p~n", [?MODULE, self(), User]), EngineId = get_value(engine_id, Options, "agentEngine"), - io:format("[~w] ~p -> EngineId: ~p~n", [?MODULE, self(), EngineId]), + print("[~w] ~p -> EngineId: ~p~n", [?MODULE, self(), EngineId]), CtxEngineId = get_value(context_engine_id, Options, EngineId), - io:format("[~w] ~p -> CtxEngineId: ~p~n", [?MODULE, self(), CtxEngineId]), + print("[~w] ~p -> CtxEngineId: ~p~n", [?MODULE, self(), CtxEngineId]), TrapUdp = get_value(trap_udp, Options, 5000), - io:format("[~w] ~p -> TrapUdp: ~p~n", [?MODULE, self(), TrapUdp]), + print("[~w] ~p -> TrapUdp: ~p~n", [?MODULE, self(), TrapUdp]), Dir = get_value(dir, Options, "."), - io:format("[~w] ~p -> Dir: ~p~n", [?MODULE, self(), Dir]), + print("[~w] ~p -> Dir: ~p~n", [?MODULE, self(), Dir]), SecLevel = get_value(sec_level, Options, noAuthNoPriv), - io:format("[~w] ~p -> SecLevel: ~p~n", [?MODULE, self(), SecLevel]), + print("[~w] ~p -> SecLevel: ~p~n", [?MODULE, self(), SecLevel]), MiniMIB = snmp_mini_mib:create(Mibs), - io:format("[~w] ~p -> MiniMIB: ~p~n", [?MODULE, self(), MiniMIB]), + d("[~w] ~p -> MiniMIB: " + "~n ~p", [?MODULE, self(), MiniMIB]), Version = case lists:member(v2, Options) of true -> 'version-2'; false -> @@ -226,19 +230,19 @@ init({Options, CallerPid}) -> false -> 'version-1' end end, - io:format("[~w] ~p -> Version: ~p~n", [?MODULE, self(), Version]), + print("[~w] ~p -> Version: ~p~n", [?MODULE, self(), Version]), Com = case Version of 'version-3' -> get_value(context, Options, ""); _ -> get_value(community, Options, "public") end, - io:format("[~w] ~p -> Com: ~p~n", [?MODULE, self(), Com]), + print("[~w] ~p -> Com: ~p~n", [?MODULE, self(), Com]), VsnHdrD = {Com, User, EngineId, CtxEngineId, mk_seclevel(SecLevel)}, - io:format("[~w] ~p -> VsnHdrD: ~p~n", [?MODULE, self(), VsnHdrD]), + print("[~w] ~p -> VsnHdrD: ~p~n", [?MODULE, self(), VsnHdrD]), IpFamily = get_value(ipfamily, Options, inet), - io:format("[~w] ~p -> IpFamily: ~p~n", [?MODULE, self(), IpFamily]), + print("[~w] ~p -> IpFamily: ~p~n", [?MODULE, self(), IpFamily]), AgIp = case snmp_misc:assq(agent, Options) of {value, Tuple4} when is_tuple(Tuple4) andalso (size(Tuple4) =:= 4) -> @@ -247,9 +251,9 @@ init({Options, CallerPid}) -> {ok, Ip} = snmp_misc:ip(Host, IpFamily), Ip end, - io:format("[~w] ~p -> AgIp: ~p~n", [?MODULE, self(), AgIp]), + print("[~w] ~p -> AgIp: ~p~n", [?MODULE, self(), AgIp]), Quiet = lists:member(quiet, Options), - io:format("[~w] ~p -> Quiet: ~p~n", [?MODULE, self(), Quiet]), + print("[~w] ~p -> Quiet: ~p~n", [?MODULE, self(), Quiet]), PackServ = start_packet_server( Quiet, Options, CallerPid, AgIp, Udp, TrapUdp, @@ -443,7 +447,8 @@ handle_cast({bulk, Args}, State) -> {noreply, execute_request(bulk, Args, State)}; handle_cast({response, RespPdu}, State) -> - d("handle_cast -> response request with ~p", [RespPdu]), + d("handle_cast -> response request with " + "~n ~p", [RespPdu]), ?PACK_SERV:send_pdu(RespPdu, State#state.packet_server), {noreply, State}; @@ -1126,14 +1131,15 @@ sizeOf(L) when is_list(L) -> sizeOf(B) when is_binary(B) -> size(B). -d(F,A) -> d(get(debug),F,A). +d(F, A) -> d(get(debug), F, A). -d(true,F,A) -> - io:format("*** [~s] MGR_DBG *** " ++ F ++ "~n", - [formated_timestamp()|A]); +d(true, F, A) -> + print(F, A); d(_,_F,_A) -> ok. +print(F, A) -> + ?PRINT2("MGR " ++ F, A). formated_timestamp() -> snmp_test_lib:formated_timestamp(). diff --git a/lib/snmp/test/snmp_test_mgr_misc.erl b/lib/snmp/test/snmp_test_mgr_misc.erl index 274fb5be26..315e3ebd9e 100644 --- a/lib/snmp/test/snmp_test_mgr_misc.erl +++ b/lib/snmp/test/snmp_test_mgr_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -38,11 +38,14 @@ -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). +-include_lib("snmp/src/misc/snmp_verbosity.hrl"). +-include("snmp_test_lib.hrl"). %%---------------------------------------------------------------------- %% The InHandler process will receive messages on the form {snmp_pdu, Pdu}. %%---------------------------------------------------------------------- + start_link_packet( InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz) -> start_link_packet( @@ -101,11 +104,11 @@ init_packet( DbgOptions, IpFamily) -> put(sname, mgr_misc), init_debug(DbgOptions), - {ok, UdpId} = - gen_udp:open(TrapUdp, [{recbuf,BufSz}, {reuseaddr, true}, IpFamily]), + UdpOpts = [{recbuf,BufSz}, {reuseaddr, true}, IpFamily], + {ok, UdpId} = gen_udp:open(TrapUdp, UdpOpts), put(msg_id, 1), - proc_lib:init_ack(Parent, self()), init_usm(Version, Dir), + proc_lib:init_ack(Parent, self()), packet_loop(SnmpMgr, UdpId, AgentIp, UdpPort, VsnHdr, Version, []). init_debug(Dbg) when is_atom(Dbg) -> @@ -200,86 +203,24 @@ packet_loop(SnmpMgr, UdpId, AgentIp, UdpPort, VsnHdr, Version, MsgData) -> handle_udp_packet(_V, undefined, UdpId, Ip, UdpPort, Bytes, SnmpMgr, AgentIp) -> - M = (catch snmp_pdus:dec_message_only(Bytes)), - MsgData3 = - case M of - Message when Message#message.version =:= 'version-3' -> - d("handle_udp_packet -> version 3"), - case catch handle_v3_msg(Bytes, Message) of - {ok, NewData, MsgData2} -> - Msg = Message#message{data = NewData}, - case SnmpMgr of - {pdu, Pid} -> - Pdu = get_pdu(Msg), - d("packet_loop -> " - "send pdu to manager (~w): ~p", [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("packet_loop -> " - "send msg to manager (~w): ~p", [Pid, Msg]), - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end, - MsgData2; - {error, Reason, B} -> - udp_send(UdpId, AgentIp, UdpPort, B), - error("Decoding error. Auto-sending Report.\n" - "Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Reason, UdpPort, Ip]), - []; - {error, Reason} -> - error("Decoding error. " - "Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]), - [] - end; - Message when is_record(Message, message) -> - %% v1 or v2c - d("handle_udp_packet -> version v1 or v2c"), - case catch snmp_pdus:dec_pdu(Message#message.data) of - Pdu when is_record(Pdu, pdu) -> - case SnmpMgr of - {pdu, Pid} -> - d("handle_udp_packet -> " - "send pdu to manager (~w): ~p", - [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("handle_udp_packet -> " - "send pdu-msg to manager (~w): ~p", - [Pid, Pdu]), - Msg = Message#message{data = Pdu}, - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end; - Pdu when is_record(Pdu, trappdu) -> - case SnmpMgr of - {pdu, Pid} -> - d("handle_udp_packet -> " - "send trap to manager (~w): ~p", - [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("handle_udp_packet -> " - "send trap-msg to manager (~w): ~p", - [Pid, Pdu]), - Msg = Message#message{data = Pdu}, - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end; - Reason -> - error("Decoding error. " - "Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]) - end, - []; - Reason -> - error("Decoding error. Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]), - [] - end, - MsgData3; + try snmp_pdus:dec_message_only(Bytes) of + Message when Message#message.version =:= 'version-3' -> + d("handle_udp_packet -> version 3"), + handle_v3_message(SnmpMgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message); + + Message when is_record(Message, message) -> + d("handle_udp_packet -> version 1 or 2"), + handle_v1_or_v2_message(SnmpMgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message) + + catch + Class:Error:_ -> + error("Decoding error (~w). Bytes: ~w ~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]), + [] + end; handle_udp_packet(V, {DiscoReqMsg, From}, _UdpId, _Ip, _UdpPort, Bytes, _, _AgentIp) -> DiscoRspMsg = (catch snmp_pdus:dec_message(Bytes)), @@ -297,6 +238,88 @@ handle_udp_packet(V, {DiscoReqMsg, From}, _UdpId, _Ip, _UdpPort, [] end. +handle_v3_message(Mgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message) -> + try handle_v3_msg(Bytes, Message) of + {ok, NewData, MsgData} -> + Msg = Message#message{data = NewData}, + case Mgr of + {pdu, Pid} -> + Pdu = get_pdu(Msg), + d("handle_v3_message -> send pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v3_message -> send msg to manager (~p): " + "~n ~p", [Pid, Msg]), + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end, + MsgData + + catch + throw:{error, Reason, B}:_ -> + udp_send(UdpId, AgentIp, UdpPort, B), + error("Decoding (v3) error. Auto-sending Report.\n" + "~n Reason: ~w " + "(UDPport: ~w, Ip: ~w)", + [Reason, UdpPort, Ip]), + []; + + throw:{error, Reason}:_ -> + error("Decoding (v3) error. " + "~n Bytes: ~w" + "~n Reason: ~w " + "(UDPport: ~w, Ip: ~w)", + [Bytes, Reason, UdpPort, Ip]), + []; + + Class:Error:_ -> + error("Decoding (v3) error (~w). " + "~n Bytes: ~w" + "~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]), + [] + + end. + +handle_v1_or_v2_message(Mgr, _UdpId, Ip, UdpPort, _AgentIp, + Bytes, Message) -> + try snmp_pdus:dec_pdu(Message#message.data) of + Pdu when is_record(Pdu, pdu) -> + case Mgr of + {pdu, Pid} -> + d("handle_v1_or_v2_message -> send pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v1_or_v2_message -> send msg to manager (~p): " + "~n ~p", [Pid, Pdu]), + Msg = Message#message{data = Pdu}, + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end; + Pdu when is_record(Pdu, trappdu) -> + case Mgr of + {pdu, Pid} -> + d("handle_v1_or_v2_message -> send trap-pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v1_or_v2_message -> send trap-msg to manager (~p): " + "~n ~p", [Pid, Pdu]), + Msg = Message#message{data = Pdu}, + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end + + catch + Class:Error:_ -> + error("Decoding (v1 or v2) error (~w): " + "~n Bytes: ~w" + "~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]) + end. + %% This function assumes that the agent and the manager (thats us) %% has the same version. @@ -578,18 +601,100 @@ set_pdu(Msg, RePdu) -> init_usm('version-3', Dir) -> + ?vlog("init_usm -> create (and init) fake \"agent\" table", []), ets:new(snmp_agent_table, [set, public, named_table]), ets:insert(snmp_agent_table, {agent_mib_storage, persistent}), - snmpa_local_db:start_link(normal, Dir, [{verbosity,trace}]), + %% The local-db process may *still* be running (from a previous + %% test case), on the way down, but not yet dead. + %% Either way, before we start it, make sure its dead and *gone*! + %% How do we do that without getting hung up? Calling the stop + %% function, will not do since it uses Timeout=infinity. + ?vlog("init_usm -> ensure (old) fake local-db is dead", []), + ensure_local_db_dead(), + ?vlog("init_usm -> try start fake local-db", []), + case snmpa_local_db:start_link(normal, Dir, + [{sname, "MGR-LOCAL-DB"}, + {verbosity, trace}]) of + {ok, Pid} -> + ?vlog("started: ~p" + "~n ~p", [Pid, process_info(Pid)]); + {error, {already_started, Pid}} -> + LDBInfo = process_info(Pid), + ?vlog("already started: ~p" + "~n ~p", [Pid, LDBInfo]), + ?FAIL({still_running, snmpa_local_db, LDBInfo}); + {error, Reason} -> + ?FAIL({failed_starting, snmpa_local_db, Reason}) + end, NameDb = snmpa_agent:db(snmpEngineID), + ?vlog("init_usm -> try set manager engine-id", []), R = snmp_generic:variable_set(NameDb, "mgrEngine"), - io:format("~w:init_usm -> engine-id set result: ~p~n", [?MODULE,R]), + snmp_verbosity:print(info, info, "init_usm -> engine-id set result: ~p", [R]), + ?vlog("init_usm -> try set engine boots (framework-mib)", []), snmp_framework_mib:set_engine_boots(1), + ?vlog("init_usm -> try set engine time (framework-mib)", []), snmp_framework_mib:set_engine_time(1), - snmp_user_based_sm_mib:reconfigure(Dir); + ?vlog("init_usm -> try usm (mib) reconfigure", []), + snmp_user_based_sm_mib:reconfigure(Dir), + ?vlog("init_usm -> done", []), + ok; init_usm(_Vsn, _Dir) -> ok. +ensure_local_db_dead() -> + ensure_dead(whereis(snmpa_local_db), 2000). + +ensure_dead(Pid, Timeout) when is_pid(Pid) -> + MRef = erlang:monitor(process, Pid), + try + begin + ensure_dead_wait(Pid, MRef, Timeout), + ensure_dead_stop(Pid, MRef, Timeout), + ensure_dead_kill(Pid, MRef, Timeout), + exit(failed_stop_local_db) + end + catch + throw:ok -> + ok + end; +ensure_dead(_, _) -> + ?vlog("ensure_dead -> already dead", []), + ok. + +ensure_dead_wait(Pid, MRef, Timeout) -> + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead_wait -> died peacefully", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_wait -> giving up", []), + ok + end. + +ensure_dead_stop(Pid, MRef, Timeout) -> + StopPid = spawn(fun() -> snmpa_local_db:stop() end), + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead -> dead (stopped)", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_stop -> giving up", []), + exit(StopPid, kill), + ok + end. + +ensure_dead_kill(Pid, MRef, Timeout) -> + exit(Pid, kill), + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead -> dead (killed)", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_kill -> giving up", []), + ok + end. + + display_incomming_message(M) -> display_message("Incomming",M). @@ -782,13 +887,13 @@ sz(O) -> {unknown_size, O}. d(F) -> d(F, []). -d(F,A) -> d(get(debug),F,A). +d(F,A) -> d(get(debug), F, A). -d(true,F,A) -> - io:format("*** [~s] MGR_PS_DBG *** " ++ F ++ "~n", - [formated_timestamp()|A]); +d(true, F, A) -> + print(F, A); d(_,_F,_A) -> ok. -formated_timestamp() -> - snmp_test_lib:formated_timestamp(). +print(F, A) -> + ?PRINT2("MGR_PS " ++ F, A). + diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 17f14bdea2..bad5815f40 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,31 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.7.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The callback <c>ssh_channel:init/1</c> was missing in + OTP-21</p> + <p> + Own Id: OTP-15762</p> + </item> + <item> + <p> + If a client was connected to an server on an already open + socket, the callback <c>fun(PeerName,FingerPrint)</c> in + the <c>accept_callback</c> option passed the local name + in the argument PeerName instead of the remote name.</p> + <p> + Own Id: OTP-15763</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.7.4</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -325,6 +350,24 @@ </section> </section> +<section><title>Ssh 4.6.9.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a client was connected to an server on an already open + socket, the callback <c>fun(PeerName,FingerPrint)</c> in + the <c>accept_callback</c> option passed the local name + in the argument PeerName instead of the remote name.</p> + <p> + Own Id: OTP-15763</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.9.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 9281bf84a7..ff5aee14d7 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -127,7 +127,7 @@ connect(Socket, UserOptions, NegotiationTimeout) when is_port(Socket), Options -> case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> - {ok, {Host,_Port}} = inet:sockname(Socket), + {ok, {Host,_Port}} = inet:peername(Socket), Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout); {error,SockError} -> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 923e9309f4..04453e6ef0 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -396,11 +396,13 @@ recv_mac_size = 0, encrypt = none, %% encrypt algorithm + encrypt_cipher, %% cipher. could be different from the algorithm encrypt_keys, %% encrypt keys encrypt_block_size = 8, encrypt_ctx, decrypt = none, %% decrypt algorithm + decrypt_cipher, %% cipher. could be different from the algorithm decrypt_keys, %% decrypt keys decrypt_block_size = 8, decrypt_ctx, %% Decryption context diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index 443bd05086..1d977e3bc9 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -58,6 +58,7 @@ State::term()}. %%% API -export([start/4, start/5, start_link/4, start_link/5, call/2, call/3, + init/1, cast/2, reply/2, enter_loop/1]). %%==================================================================== @@ -76,6 +77,9 @@ cast(ChannelPid, Msg) -> reply(From, Msg) -> ssh_client_channel:reply(From, Msg). +init(Args) -> + ssh_client_channel:init(Args). + start(ConnectionManager, ChannelId, CallBack, CbInitArgs) -> ssh_client_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs). diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index aa9ba0f9bb..5ec12e2d04 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -508,7 +508,7 @@ close_our_file({_,Fd}, FileMod, FS0) -> FS1. %%% stat: do the stat -stat(Vsn, ReqId, Data, State, F) -> +stat(_Vsn, ReqId, Data, State, F) -> <<?UINT32(BLen), BPath:BLen/binary, _/binary>> = Data, stat(ReqId, unicode:characters_to_list(BPath), State, F). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 2299346a30..eaab13433a 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -1328,13 +1328,15 @@ verify(PlainText, HashAlg, Sig, Key, _) -> %%% Start of a more parameterized crypto handling. cipher('AEAD_AES_128_GCM') -> - #cipher{key_bytes = 16, + #cipher{impl = aes_128_gcm, + key_bytes = 16, iv_bytes = 12, block_bytes = 16, pkt_type = aead}; cipher('AEAD_AES_256_GCM') -> - #cipher{key_bytes = 32, + #cipher{impl = aes_256_gcm, + key_bytes = 32, iv_bytes = 12, block_bytes = 16, pkt_type = aead}; @@ -1346,7 +1348,7 @@ cipher('3des-cbc') -> block_bytes = 8}; cipher('aes128-cbc') -> - #cipher{impl = aes_cbc, + #cipher{impl = aes_128_cbc, key_bytes = 16, iv_bytes = 16, block_bytes = 16}; @@ -1370,7 +1372,8 @@ cipher('aes256-ctr') -> block_bytes = 16}; cipher('[email protected]') -> % FIXME: Verify!! - #cipher{key_bytes = 32, + #cipher{impl = chacha20_poly1305, + key_bytes = 32, iv_bytes = 12, block_bytes = 8, pkt_type = aead}; @@ -1407,12 +1410,14 @@ encrypt_init(#ssh{encrypt = '[email protected]', role = Role} = Ssh) encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; SshCipher == 'AEAD_AES_256_GCM' -> {IvMagic, KeyMagic} = encrypt_magic(Role), - #cipher{key_bytes = KeyBytes, + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, iv_bytes = IvBytes, block_bytes = BlockBytes} = cipher(SshCipher), IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), - {ok, Ssh#ssh{encrypt_keys = K, + {ok, Ssh#ssh{encrypt_cipher = CryptoCipher, + encrypt_keys = K, encrypt_block_size = BlockBytes, encrypt_ctx = IV}}; @@ -1425,11 +1430,12 @@ encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) -> IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, true), - {ok, Ssh#ssh{encrypt_block_size = BlockBytes, + {ok, Ssh#ssh{encrypt_cipher = CryptoCipher, + encrypt_block_size = BlockBytes, encrypt_ctx = Ctx0}}. encrypt_final(Ssh) -> - {ok, Ssh#ssh{encrypt = none, + {ok, Ssh#ssh{encrypt = none, encrypt_keys = undefined, encrypt_block_size = 8, encrypt_ctx = undefined @@ -1457,18 +1463,19 @@ encrypt(#ssh{encrypt = '[email protected]', {Ssh, {EncBytes,Ctag}}; encrypt(#ssh{encrypt = SshCipher, + encrypt_cipher = CryptoCipher, encrypt_keys = K, encrypt_ctx = IV0} = Ssh, <<LenData:4/binary, PayloadData/binary>>) when SshCipher == 'AEAD_AES_128_GCM' ; SshCipher == 'AEAD_AES_256_GCM' -> - {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), + {Ctext,Ctag} = crypto:crypto_one_time_aead(CryptoCipher, K, IV0, PayloadData, LenData, true), IV = next_gcm_iv(IV0), {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; encrypt(#ssh{encrypt_ctx = Ctx0} = Ssh, Data) -> Enc = crypto:crypto_update(Ctx0, Data), {Ssh, Enc}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Decryption %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1485,12 +1492,14 @@ decrypt_init(#ssh{decrypt = '[email protected]', role = Role} = Ssh) decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; SshCipher == 'AEAD_AES_256_GCM' -> {IvMagic, KeyMagic} = decrypt_magic(Role), - #cipher{key_bytes = KeyBytes, + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, iv_bytes = IvBytes, block_bytes = BlockBytes} = cipher(SshCipher), IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), - {ok, Ssh#ssh{decrypt_keys = K, + {ok, Ssh#ssh{decrypt_cipher = CryptoCipher, + decrypt_keys = K, decrypt_block_size = BlockBytes, decrypt_ctx = IV}}; @@ -1503,9 +1512,11 @@ decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) -> IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, false), - {ok, Ssh#ssh{decrypt_block_size = BlockBytes, + {ok, Ssh#ssh{decrypt_cipher = CryptoCipher, + decrypt_block_size = BlockBytes, decrypt_ctx = Ctx0}}. + decrypt_final(Ssh) -> {ok, Ssh#ssh {decrypt = none, decrypt_keys = undefined, @@ -1517,35 +1528,37 @@ decrypt(Ssh, <<>>) -> {Ssh, <<>>}; decrypt(#ssh{decrypt = '[email protected]', - decrypt_keys = {K1,_K2}, - recv_sequence = Seq} = Ssh, {length,EncryptedLen}) -> - PacketLenBin = crypto:crypto_one_time(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), - {Ssh, PacketLenBin}; - -decrypt(#ssh{decrypt = '[email protected]', - decrypt_keys = {_K1,K2}, - recv_sequence = Seq} = Ssh, {AAD,Ctext,Ctag}) -> - %% The length is already decoded and used to divide the input - %% Check the mac (important that it is timing-safe): - PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), - case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of - true -> - %% MAC is ok, decode - IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - PlainText = crypto:crypto_one_time(chacha20, K2, IV2, Ctext, false), - {Ssh, PlainText}; - false -> - {Ssh,error} + decrypt_keys = {K1,K2}, + recv_sequence = Seq} = Ssh, Data) -> + case Data of + {length,EncryptedLen} -> + %% The length is decrypted separately in a first step + PacketLenBin = crypto:crypto_one_time(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), + {Ssh, PacketLenBin}; + {AAD,Ctext,Ctag} -> + %% The length is already decrypted and used to divide the input + %% Check the mac (important that it is timing-safe): + PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), + case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of + true -> + %% MAC is ok, decode + IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, + PlainText = crypto:crypto_one_time(chacha20, K2, IV2, Ctext, false), + {Ssh, PlainText}; + false -> + {Ssh,error} + end end; decrypt(#ssh{decrypt = none} = Ssh, Data) -> {Ssh, Data}; decrypt(#ssh{decrypt = SshCipher, + decrypt_cipher = CryptoCipher, decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; - SshCipher == 'AEAD_AES_256_GCM' -> - Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error + decrypt_ctx = IV0} = Ssh, {AAD,Ctext,Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> + Dec = crypto:crypto_one_time_aead(CryptoCipher, K, IV0, Ctext, AAD, Ctag, false), IV = next_gcm_iv(IV0), {Ssh#ssh{decrypt_ctx = IV}, Dec}; diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 5de6d52092..9b987dea5a 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -1399,7 +1399,7 @@ rekey_chk(Config, RLdaemon, RLclient) -> Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), %% Make both sides send something: - {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + {ok, _SftpPid} = ssh_sftp:start_channel(ConnectionRef), %% Check rekeying timer:sleep(?REKEY_DATA_TMO), diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index 2ac4e5636a..880c519a5e 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -178,7 +178,7 @@ gen_data(DataSz) -> connect_measure(Port, Cipher, Mac, Data, Options) -> - AES_GCM = {cipher, + _AES_GCM = {cipher, []}, %% ['[email protected]', %% '[email protected]']}, @@ -187,22 +187,22 @@ connect_measure(Port, Cipher, Mac, Data, Options) -> {none,none} -> [{modify_algorithms,[{prepend, [{cipher,[Cipher]}, {mac,[Mac]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}]; {none,_} -> [{modify_algorithms,[{prepend, [{cipher,[Cipher]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}, {preferred_algorithms, [{mac,[Mac]}]}]; {_,none} -> [{modify_algorithms,[{prepend, [{mac,[Mac]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}, {preferred_algorithms, [{cipher,[Cipher]}]}]; _ -> [{preferred_algorithms, [{cipher,[Cipher]}, {mac,[Mac]}]} -%%% ,{modify_algorithms, [{rm,[AES_GCM]}]} +%%% ,{modify_algorithms, [{rm,[_AES_GCM]}]} ] end, Times = diff --git a/lib/ssh/test/ssh_chan_behaviours_SUITE.erl b/lib/ssh/test/ssh_chan_behaviours_SUITE.erl index 16ed152bcd..103d7253fd 100644 --- a/lib/ssh/test/ssh_chan_behaviours_SUITE.erl +++ b/lib/ssh/test/ssh_chan_behaviours_SUITE.erl @@ -128,8 +128,8 @@ subsystem_client(Config) -> C = proplists:get_value(connref, Config), {ok,ChRef} = ssh_chan_behaviours_client:start_link(C), - IDclt = ?EXPECT({{C,Ch1clt}, {ssh_channel_up,Ch1clt,C}}, {C,Ch1clt}), - IDsrv = ?EXPECT({{_Csrv,Ch1srv}, {ssh_channel_up,Ch1srv,_Csrv}}, {_Csrv,Ch1srv}), + IDclt = ?EXPECT({{C,_Ch1clt}, {ssh_channel_up,_Ch1clt,C}}, {C,_Ch1clt}), + IDsrv = ?EXPECT({{_Csrv,_Ch1srv}, {ssh_channel_up,_Ch1srv,_Csrv}}, {_Csrv,_Ch1srv}), ok = ssh_chan_behaviours_client:stop(ChRef), ?EXPECT({IDclt, {terminate,normal}}, []), % From the proper channel handler diff --git a/lib/ssh/test/ssh_chan_behaviours_client.erl b/lib/ssh/test/ssh_chan_behaviours_client.erl index 15f17733d6..8dd18973ad 100644 --- a/lib/ssh/test/ssh_chan_behaviours_client.erl +++ b/lib/ssh/test/ssh_chan_behaviours_client.erl @@ -94,7 +94,7 @@ handle_ssh_msg({ssh_cm, C, {eof, Ch}}=M, #state{ch=Ch,cm=C} = State) -> ?DBG(State, "eof",[]), {ok, State}; -handle_ssh_msg({ssh_cm, C, {signal, _Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> +handle_ssh_msg({ssh_cm, C, {signal, Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> %% Ignore signals according to RFC 4254 section 6.9. tell_parent(M, State), ?DBG(State, "~p",[Sig]), diff --git a/lib/ssh/test/ssh_chan_behaviours_server.erl b/lib/ssh/test/ssh_chan_behaviours_server.erl index 1408675a6e..1d504b1bc6 100644 --- a/lib/ssh/test/ssh_chan_behaviours_server.erl +++ b/lib/ssh/test/ssh_chan_behaviours_server.erl @@ -65,7 +65,7 @@ handle_ssh_msg({ssh_cm, C, {eof, Ch}}=M, #state{ch=Ch,cm=C} = State) -> ?DBG(State, "eof",[]), {ok, State}; -handle_ssh_msg({ssh_cm, C, {signal, _Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> +handle_ssh_msg({ssh_cm, C, {signal, Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> %% Ignore signals according to RFC 4254 section 6.9. tell_parent(M, State), ?DBG(State, "~p",[Sig]), diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index 8e82527c6e..06ed9082cf 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -150,8 +150,7 @@ init_per_group(G, Config0) -> stop_docker(ID), {fail, "Can't contact docker sshd"} catch - Class:Exc -> - ST = erlang:get_stacktrace(), + Class:Exc:ST -> ct:log("common_algs: ~p:~p~n~p",[Class,Exc,ST]), stop_docker(ID), {fail, "Failed during setup"} @@ -160,8 +159,7 @@ init_per_group(G, Config0) -> cant_start_docker -> {skip, "Can't start docker"}; - C:E -> - ST = erlang:get_stacktrace(), + C:E:ST -> ct:log("No ~p~n~p:~p~n~p",[G,C,E,ST]), {skip, "Can't start docker"} end; @@ -1026,8 +1024,7 @@ receive_hello(S) -> Result -> Result catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {Class,Error,ST}} end. @@ -1104,8 +1101,7 @@ sftp_tests_erl_server(Config, ServerIP, ServerPort, ServerRootDir, UserDir) -> call_sftp_in_docker(Config, ServerIP, ServerPort, Cmnds, UserDir), check_local_directory(ServerRootDir) catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {Class,Error,ST}} end. @@ -1133,7 +1129,7 @@ check_local_directory(ServerRootDir) -> check_local_directory(ServerRootDir, SleepTime, N) -> case do_check_local_directory(ServerRootDir) of - {error,Error} when N>0 -> + {error,_Error} when N>0 -> %% Could be that the erlang side is faster and the docker's operations %% are not yet finalized. %% Sleep for a while and retry a few times: @@ -1347,8 +1343,7 @@ one_test_erl_client(SFTP, Id, C) when SFTP==sftp ; SFTP==sftp_async -> catch ssh_sftp:stop_channel(Ch), R catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {SFTP,Id,Class,Error,ST}} end. diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 60d0da2a39..bf90f74324 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -214,7 +214,7 @@ init_per_testcase(_TestCase, Config) -> file:make_dir(UserDir), [{user_dir,UserDir}|Config]. -end_per_testcase(_TestCase, Config) -> +end_per_testcase(_TestCase, _Config) -> ssh:stop(), ok. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index a1a7eebcde..1129303414 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -409,7 +409,7 @@ ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file setup_ecdsa_auth_keys(Size, DataDir, UserDir). setup_eddsa(Alg, DataDir, UserDir) -> - {IdPriv, IdPub, HostPriv, HostPub} = + {IdPriv, _IdPub, HostPriv, HostPub} = case Alg of ed25519 -> {"id_ed25519", "id_ed25519.pub", "ssh_host_ed25519_key", "ssh_host_ed25519_key.pub"}; ed448 -> {"id_ed448", "id_ed448.pub", "ssh_host_ed448_key", "ssh_host_ed448_key.pub"} @@ -970,7 +970,7 @@ expected_state(_) -> false. %%%---------------------------------------------------------------- %%% Return a string with N random characters %%% -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. +random_chars(N) -> [($a-1)+rand:uniform($z-$a) || _<-lists:duplicate(N,x)]. create_random_dir(Config) -> diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index f2c9892f95..3f4df2c986 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -570,75 +570,6 @@ receive_binary_msg(S0=#s{}) -> -old_receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize, - recv_mac_size = MacSize - } - }) -> - case size(S0#s.encrypted_data_buffer) >= max(8,BlockSize) of - false -> - %% Need more bytes to decode the packet_length field - Remaining = max(8,BlockSize) - size(S0#s.encrypted_data_buffer), - receive_binary_msg( receive_wait(Remaining, S0) ); - true -> - %% Has enough bytes to decode the packet_length field - {_, <<?UINT32(PacketLen), _/binary>>, _} = - ssh_transport:decrypt_blocks(S0#s.encrypted_data_buffer, BlockSize, C0), % FIXME: BlockSize should be at least 4 - - %% FIXME: Check that ((4+PacketLen) rem BlockSize) == 0 ? - - S1 = if - PacketLen > ?SSH_MAX_PACKET_SIZE -> - fail({too_large_message,PacketLen},S0); % FIXME: disconnect - - ((4+PacketLen) rem BlockSize) =/= 0 -> - fail(bad_packet_length_modulo, S0); % FIXME: disconnect - - size(S0#s.encrypted_data_buffer) >= (4 + PacketLen + MacSize) -> - %% has the whole packet - S0; - - true -> - %% need more bytes to get have the whole packet - Remaining = (4 + PacketLen + MacSize) - size(S0#s.encrypted_data_buffer), - receive_wait(Remaining, S0) - end, - - %% Decrypt all, including the packet_length part (re-use the initial #ssh{}) - {C1, SshPacket = <<?UINT32(_),?BYTE(PadLen),Tail/binary>>, EncRest} = - ssh_transport:decrypt_blocks(S1#s.encrypted_data_buffer, PacketLen+4, C0), - - PayloadLen = PacketLen - 1 - PadLen, - <<CompressedPayload:PayloadLen/binary, _Padding:PadLen/binary>> = Tail, - - {C2, Payload} = ssh_transport:decompress(C1, CompressedPayload), - - <<Mac:MacSize/binary, Rest/binary>> = EncRest, - - case {ssh_transport:is_valid_mac(Mac, SshPacket, C2), - catch ssh_message:decode(set_prefix_if_trouble(Payload,S1))} - of - {false, _} -> fail(bad_mac,S1); - {_, {'EXIT',_}} -> fail(decode_failed,S1); - - {true, Msg} -> - C3 = case Msg of - #ssh_msg_kexinit{} -> - ssh_transport:key_init(opposite_role(C2), C2, Payload); - _ -> - C2 - end, - S2 = opt(print_messages, S1, - fun(X) when X==true;X==detail -> {"Recv~n~s~n",[format_msg(Msg)]} end), - S3 = opt(print_messages, S2, - fun(detail) -> {"decrypted bytes ~p~n",[SshPacket]} end), - S3#s{ssh = inc_recv_seq_num(C3), - encrypted_data_buffer = Rest, - return_value = Msg - } - end - end. - - set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #s{alg=#alg{kex=Kex}}) when Op == 30; Op == 31 diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 0f9eee887c..2947f82556 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.7.4 +SSH_VSN = 4.7.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index a511cb4db3..f0231da2ad 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,23 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + With the default BEAST Mitigation strategy for TLS 1.0 an + empty TLS fragment could be sent after a one-byte + fragment. This glitch has been fixed.</p> + <p> + Own Id: OTP-15054 Aux Id: ERIERL-346 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 0a0c6f0c2e..d8c0e30973 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -193,7 +193,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), case ssl_handshake:select_hashsign({ClientHashSigns, undefined}, Cert, KeyExAlg, SupportedHashSigns, TLSVersion) of #alert{} = Alert -> diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index b365961a6a..fc9dce02ce 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -31,18 +31,18 @@ suites(Minor) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, tls_v1:suites(corresponding_minor_tls_version(Minor))). all_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, ssl_cipher:all_suites(corresponding_tls_version(Version))). anonymous_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, ssl_cipher:anonymous_suites(corresponding_tls_version(Version))). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index ef2cd4f557..a3138e8c30 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -987,14 +987,14 @@ cipher_suites() -> %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> - [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(default)]; + [ssl_cipher_format:suite_legacy(Suite) || Suite <- available_suites(default)]; cipher_suites(openssl) -> - [ssl_cipher_format:openssl_suite_name(Suite) || + [ssl_cipher_format:suite_map_to_openssl_str(ssl_cipher_format:suite_bin_to_map(Suite)) || Suite <- available_suites(default)]; cipher_suites(all) -> - [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(all)]. + [ssl_cipher_format:suite_legacy(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- -spec cipher_suites(Supported, Version) -> ciphers() when @@ -1013,7 +1013,7 @@ cipher_suites(Base, Version) when Version == 'dtlsv1.2'; Version == 'dtlsv1'-> cipher_suites(Base, dtls_record:protocol_version(Version)); cipher_suites(Base, Version) -> - [ssl_cipher_format:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. + [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- supported_suites(Base, Version)]. %%-------------------------------------------------------------------- -spec filter_cipher_suites(Suites, Filters) -> Ciphers when @@ -1385,7 +1385,6 @@ tls_version({3, _} = Version) -> tls_version({254, _} = Version) -> dtls_v1:corresponding_tls_version(Version). - %%-------------------------------------------------------------------- -spec suite_to_str(CipherSuite) -> string() when CipherSuite :: erl_cipher_suite(). @@ -1393,8 +1392,7 @@ tls_version({254, _} = Version) -> %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- suite_to_str(Cipher) -> - ssl_cipher_format:suite_to_str(Cipher). - + ssl_cipher_format:suite_map_to_str(Cipher). %%%-------------------------------------------------------------- %%% Internal functions @@ -2034,10 +2032,10 @@ binary_cipher_suites(Version, []) -> %% not require explicit configuration default_binary_suites(Version); binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) -> - Ciphers = [ssl_cipher_format:suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_map_to_bin(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> - Ciphers = [ssl_cipher_format:suite(tuple_to_map(C)) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_map_to_bin(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:all_suites(Version) ++ @@ -2052,11 +2050,11 @@ binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) end; binary_cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> %% Format: ["RC4-SHA","RC4-MD5"] - Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_openssl_str_to_map(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, Ciphers0) -> %% Format: "RC4-SHA:RC4-MD5" - Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], + Ciphers = [ssl_cipher_format:suite_openssl_str_to_map(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). default_binary_suites(Version) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 2238b5290d..21db887bb5 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -76,7 +76,7 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> %%------------------------------------------------------------------- security_parameters(Version, CipherSuite, SecParams) -> #{cipher := Cipher, mac := Hash, - prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), + prf := PrfHashAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -91,7 +91,7 @@ security_parameters(Version, CipherSuite, SecParams) -> security_parameters_1_3(SecParams, CipherSuite) -> #{cipher := Cipher, prf := PrfHashAlg} = - ssl_cipher_format:suite_definition(CipherSuite), + ssl_cipher_format:suite_bin_to_map(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -549,7 +549,7 @@ filter_suite(#{key_exchange := KeyExchange, all_filters(Hash, HashFilters) andalso all_filters(Prf, PrfFilters); filter_suite(Suite, Filters) -> - filter_suite(ssl_cipher_format:suite_definition(Suite), Filters). + filter_suite(ssl_cipher_format:suite_bin_to_map(Suite), Filters). %%-------------------------------------------------------------------- -spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) -> diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index e0df3662ef..887eb6c653 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -48,48 +48,134 @@ -type openssl_cipher_suite() :: string(). --export([suite_to_str/1, suite_definition/1, suite/1, erl_suite_definition/1, - openssl_suite/1, openssl_suite_name/1]). +-export([suite_map_to_bin/1, %% Binary format + suite_bin_to_map/1, %% Erlang API format + suite_map_to_str/1, %% RFC string + suite_str_to_map/1, + suite_map_to_openssl_str/1, %% OpenSSL name + suite_openssl_str_to_map/1, + suite_legacy/1 %% Erlang legacy format + ]). %%-------------------------------------------------------------------- --spec suite_to_str(internal_erl_cipher_suite()) -> string(). +-spec suite_map_to_str(internal_erl_cipher_suite()) -> string(). %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- -suite_to_str(#{key_exchange := null, +suite_map_to_str(#{key_exchange := null, cipher := null, mac := null, prf := null}) -> "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"; -suite_to_str(#{key_exchange := any, +suite_map_to_str(#{key_exchange := any, cipher := Cipher, mac := aead, prf := PRF}) -> "TLS_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(PRF)); -suite_to_str(#{key_exchange := Kex, +suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := aead, prf := PRF}) -> "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(PRF)); -suite_to_str(#{key_exchange := Kex, +suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := Mac}) -> "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(Mac)). +suite_str_to_map("TLS_EMPTY_RENEGOTIATION_INFO_SCSV") -> + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; +suite_str_to_map(SuiteStr)-> + Str0 = string:trim(SuiteStr, leading, "TLS_"), + case string:split(Str0, "_WITH_") of + [Rest] -> + tls_1_3_suite_str_to_map(Rest); + [Kex| Rest] -> + pre_tls_1_3_suite_str_to_map(Kex, Rest) + end. + +suite_map_to_openssl_str(#{key_exchange := any, + mac := aead} = Suite) -> + %% TLS 1.3 OpenSSL finally use RFC names + suite_map_to_str(Suite); +suite_map_to_openssl_str(#{key_exchange := null} = Suite) -> + %% TLS_EMPTY_RENEGOTIATION_INFO_SCSV + suite_map_to_str(Suite); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := chacha20_poly1305 = Cipher, + mac := aead}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := Cipher, + mac := aead, + prf := PRF}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(PRF)); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := Cipher, + mac := Mac}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(Mac)). + + +suite_openssl_str_to_map("TLS_" ++ _ = SuiteStr) -> + suite_str_to_map(SuiteStr); +suite_openssl_str_to_map("DHE-RSA-" ++ Rest) -> + suite_openssl_str_to_map("DHE-RSA", Rest); +suite_openssl_str_to_map("DHE-DSS-" ++ Rest) -> + suite_openssl_str_to_map("DHE-DSS", Rest); +suite_openssl_str_to_map("EDH-RSA-" ++ Rest) -> + suite_openssl_str_to_map("DHE-RSA", Rest); +suite_openssl_str_to_map("EDH-DSS-" ++ Rest) -> + suite_openssl_str_to_map("DHE-DSS", Rest); +suite_openssl_str_to_map("DES" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("AES" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("RC4" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("ECDH-RSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDH-RSA", Rest); +suite_openssl_str_to_map("ECDH-ECDSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDH-ECDSA", Rest); +suite_openssl_str_to_map("ECDHE-RSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-RSA", Rest); +suite_openssl_str_to_map("ECDHE-ECDSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-ECDSA", Rest); +suite_openssl_str_to_map("RSA-PSK-" ++ Rest) -> + suite_openssl_str_to_map("RSA-PSK", Rest); +suite_openssl_str_to_map("RSA-" ++ Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("DHE-PSK-" ++ Rest) -> + suite_openssl_str_to_map("DHE-PSK", Rest); +suite_openssl_str_to_map("ECDHE-PSK-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-PSK", Rest); +suite_openssl_str_to_map("PSK-" ++ Rest) -> + suite_openssl_str_to_map("PSK", Rest); +suite_openssl_str_to_map("SRP-RSA-" ++ Rest) -> + suite_openssl_str_to_map("SRP-RSA", Rest); +suite_openssl_str_to_map("SRP-" ++ Rest) -> + suite_openssl_str_to_map("SRP", Rest). + %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> internal_erl_cipher_suite(). +-spec suite_bin_to_map(cipher_suite()) -> internal_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %% Note: Currently not supported suites are commented away. %% They should be supported or removed in the future. %%------------------------------------------------------------------- %% TLS v1.1 suites -suite_definition(?TLS_NULL_WITH_NULL_NULL) -> +suite_bin_to_map(?TLS_NULL_WITH_NULL_NULL) -> #{key_exchange => null, cipher => null, mac => null, @@ -97,111 +183,111 @@ suite_definition(?TLS_NULL_WITH_NULL_NULL) -> %% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension %% to avoid handshake failure from old servers that do not ignore %% hello extension data as they should. -suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> +suite_bin_to_map(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> #{key_exchange => null, cipher => null, mac => null, prf => null}; -suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> +suite_bin_to_map(?TLS_RSA_WITH_RC4_128_MD5) -> #{key_exchange => rsa, cipher => rc4_128, mac => md5, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_RC4_128_SHA) -> #{key_exchange => rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_DES_CBC_SHA) -> #{key_exchange => rsa, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; %%% TSL V1.1 AES suites -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% TLS v1.2 suites -%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> +%% suite_bin_to_map(?TLS_RSA_WITH_NULL_SHA) -> %% {rsa, null, sha, default_prf}; -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => rsa, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> #{key_exchange => rsa, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_256_cbc, mac => sha256, @@ -213,683 +299,683 @@ suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> %% TLS_DH_RSA_WITH_AES_256_CBC_SHA256 DH_RSA AES_256_CBC SHA256 %%% DH-ANON deprecated by TLS spec and not available %%% by default, but good for testing purposes. -suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> +suite_bin_to_map(?TLS_DH_anon_WITH_RC4_128_MD5) -> #{key_exchange => dh_anon, cipher => rc4_128, mac => md5, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_DES_CBC_SHA) -> #{key_exchange => dh_anon, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dh_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> #{key_exchange => dh_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> #{key_exchange => dh_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; %%% PSK Cipher Suites RFC 4279 -suite_definition(?TLS_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_RC4_128_SHA) -> #{key_exchange => psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> #{key_exchange => dhe_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> #{key_exchange => rsa_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %%% PSK NULL Cipher Suites RFC 4785 -suite_definition(?TLS_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA) -> #{key_exchange => psk, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA) -> #{key_exchange => dhe_psk, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA) -> #{key_exchange => rsa_psk, cipher => null, mac => sha, prf => default_prf}; %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA256) -> #{key_exchange => psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA384) -> #{key_exchange => psk, cipher => null, mac => sha384, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => dhe_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => dhe_psk, cipher => null, mac => sha384, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA256) -> #{key_exchange => rsa_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA384) -> #{key_exchange => rsa_psk, cipher => null, mac => sha384, prf => default_prf}; %%% ECDHE PSK Cipher Suites RFC 5489 -suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha384, prf => default_prf}; %%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_gcm, mac => null, prf => sha256}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_gcm, mac => null, prf => sha384}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_ccm, mac => null, prf =>sha256}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_ccm_8, mac => null, prf =>sha256}; %%% SRP Cipher Suites RFC 5054 -suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_dss, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_dss, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_dss, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% RFC 4492 EC TLS suites -suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_NULL_SHA) -> #{key_exchange => ecdh_rsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> #{key_exchange => ecdhe_rsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_NULL_SHA) -> #{key_exchange => ecdh_anon, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_anon, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% RFC 5289 EC TLS suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; %% RFC 5288 AES-GCM Cipher Suites -suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_dss, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_dss, cipher => aes_128_gcm, mac => null, prf => sha256}; -suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_dss, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_anon, cipher => aes_256_gcm, mac => aead, prf => sha384}; %% RFC 5289 ECC AES-GCM Cipher Suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_PSK_WITH_AES_128_CCM) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM) -> #{key_exchange => psk, cipher => aes_128_ccm, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_256_CCM) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM) -> #{key_exchange => psk, cipher => aes_256_ccm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CCM) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CCM) -> #{key_exchange => dhe_psk, cipher => aes_128_ccm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CCM) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CCM) -> #{key_exchange => dhe_psk, cipher => aes_256_ccm, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_128_CCM_8) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM_8) -> #{key_exchange => psk, cipher => aes_128_ccm_8, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_256_CCM_8) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM_8) -> #{key_exchange => psk, cipher => aes_256_ccm_8, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_DHE_WITH_AES_128_CCM_8) -> +suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_128_CCM_8) -> #{key_exchange => dhe_psk, cipher => aes_128_ccm_8, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_DHE_WITH_AES_256_CCM_8) -> +suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_256_CCM_8) -> #{key_exchange => dhe_psk, cipher => aes_256_ccm_8, mac => aead, prf => sha256}; -suite_definition(#{key_exchange := psk_dhe, +suite_bin_to_map(#{key_exchange := psk_dhe, cipher := aes_256_ccm_8, mac := aead, prf := sha256}) -> ?TLS_PSK_DHE_WITH_AES_256_CCM_8; % draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => dhe_rsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; %% TLS 1.3 Cipher Suites RFC8446 -suite_definition(?TLS_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_AES_128_GCM_SHA256) -> #{key_exchange => any, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_AES_256_GCM_SHA384) -> #{key_exchange => any, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_CHACHA20_POLY1305_SHA256) -> #{key_exchange => any, cipher => chacha20_poly1305, mac => aead, prf => sha256}. -%% suite_definition(?TLS_AES_128_CCM_SHA256) -> +%% suite_bin_to_map(?TLS_AES_128_CCM_SHA256) -> %% #{key_exchange => any, %% cipher => aes_128_ccm, -%% mac => aead, +%% mac => aead %% prf => sha256}; -%% suite_definition(?TLS_AES_128_CCM_8_SHA256) -> +%% suite_bin_to_map(?TLS_AES_128_CCM_8_SHA256) -> %% #{key_exchange => any, %% cipher => aes_128_ccm_8, %% mac => aead, %% prf => sha256}. %%-------------------------------------------------------------------- --spec erl_suite_definition(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite(). +-spec suite_legacy(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. Filters last value %% for now (compatibility reasons). %%-------------------------------------------------------------------- -erl_suite_definition(Bin) when is_binary(Bin) -> - erl_suite_definition(suite_definition(Bin)); -erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, +suite_legacy(Bin) when is_binary(Bin) -> + suite_legacy(suite_bin_to_map(Bin)); +suite_legacy(#{key_exchange := KeyExchange, cipher := Cipher, mac := Hash, prf := Prf}) -> case Prf of default_prf -> @@ -899,1093 +985,896 @@ erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, end. %%-------------------------------------------------------------------- --spec suite(internal_erl_cipher_suite()) -> cipher_suite(). +-spec suite_map_to_bin(internal_erl_cipher_suite()) -> cipher_suite(). %% %% Description: Return TLS cipher suite definition. %%-------------------------------------------------------------------- %% TLS v1.1 suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := rc4_128, mac := md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := rc4_128, mac := sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := des_cbc, mac := sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher :='3des_ede_cbc', mac := sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher:= des_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher:= des_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= rc4_128, mac := md5}) -> ?TLS_DH_anon_WITH_RC4_128_MD5; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= des_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; %%% TSL V1.1 AES suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA; %% TLS v1.2 suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA256; %%% PSK Cipher Suites RFC 4279 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := rc4_128, mac := sha}) -> ?TLS_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := rc4_128, mac := sha}) -> ?TLS_DHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := rc4_128, mac := sha}) -> ?TLS_RSA_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; %%% PSK NULL Cipher Suites RFC 4785 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha}) -> ?TLS_PSK_WITH_NULL_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha}) -> ?TLS_DHE_PSK_WITH_NULL_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha}) -> ?TLS_RSA_PSK_WITH_NULL_SHA; %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha256}) -> ?TLS_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha384}) -> ?TLS_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha256}) -> ?TLS_DHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha384}) -> ?TLS_DHE_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha256}) -> ?TLS_RSA_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha384}) -> ?TLS_RSA_PSK_WITH_NULL_SHA384; %%% ECDHE PSK Cipher Suites RFC 5489 -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher :='3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := null, mac := sha256}) -> ?TLS_ECDHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := null, mac := sha384}) -> ?TLS_ECDHE_PSK_WITH_NULL_SHA384; %%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_gcm, mac := null, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_gcm, mac := null, prf := sha384}) -> ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_ccm_8, mac := null, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_ccm, mac := null, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; %%% SRP Cipher Suites RFC 5054 -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; %%% RFC 4492 EC TLS suites -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := null, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := null, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := null, mac := sha}) -> ?TLS_ECDH_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := null, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := null, mac := sha}) -> ?TLS_ECDH_anon_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_anon_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; %%% RFC 5289 EC TLS suites -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_cbc, mac:= sha256, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; %% RFC 5288 AES-GCM Cipher Suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_rsa, +suite_map_to_bin(#{key_exchange := dh_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_rsa, +suite_map_to_bin(#{key_exchange := dh_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_dss, +suite_map_to_bin(#{key_exchange := dh_dss, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_dss, +suite_map_to_bin(#{key_exchange := dh_dss, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256; %% RFC 6655 - TLS-1.2 cipher suites -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_ccm, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_CCM; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_ccm, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_256_CCM; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_ccm, mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_CCM; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_ccm, mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_256_CCM; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_ccm, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_CCM; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_ccm, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_256_CCM; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_ccm, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_CCM; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_ccm, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_256_CCM; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_ccm_8, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_CCM_8; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_ccm_8, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_256_CCM_8; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_ccm_8, mac := aead, prf := sha256}) -> ?TLS_PSK_DHE_WITH_AES_128_CCM_8; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_ccm_8, mac := aead, prf := sha256}) -> ?TLS_PSK_DHE_WITH_AES_256_CCM_8; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_ccm_8, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_CCM_8; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_ccm_8, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_256_CCM_8; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_ccm_8, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_CCM_8; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_ccm_8, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_256_CCM_8; %% TLS 1.3 Cipher Suites RFC8446 -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_AES_128_GCM_SHA256; -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_AES_256_GCM_SHA384; -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_CHACHA20_POLY1305_SHA256. -%% suite(#{key_exchange := any, +%% suite_map_to_bin(#{key_exchange := any, %% cipher := aes_128_ccm, %% mac := aead, %% prf := sha256}) -> %% ?TLS_AES_128_CCM_SHA256; -%% suite(#{key_exchange := any, +%% suite_map_to_bin(#{key_exchange := any, %% cipher := aes_128_ccm_8, %% mac := aead, %% prf := sha256}) -> %% ?TLS_AES_128_CCM_8_SHA256. -%%-------------------------------------------------------------------- --spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). -%% -%% Description: Return TLS cipher suite definition. -%%-------------------------------------------------------------------- -%% translate constants <-> openssl-strings -openssl_suite("DHE-RSA-AES256-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-DSS-AES256-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -openssl_suite("AES256-SHA256") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-RSA-AES128-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-DSS-AES128-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -openssl_suite("AES128-SHA256") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-RSA-AES256-SHA") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("DHE-DSS-AES256-SHA") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("AES256-SHA") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("EDH-RSA-DES-CBC3-SHA") -> - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("EDH-DSS-DES-CBC3-SHA") -> - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DES-CBC3-SHA") -> - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DHE-RSA-AES128-SHA") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("DHE-DSS-AES128-SHA") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("AES128-SHA") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("RC4-SHA") -> - ?TLS_RSA_WITH_RC4_128_SHA; -openssl_suite("RC4-MD5") -> - ?TLS_RSA_WITH_RC4_128_MD5; -openssl_suite("EDH-RSA-DES-CBC-SHA") -> - ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -openssl_suite("DES-CBC-SHA") -> - ?TLS_RSA_WITH_DES_CBC_SHA; -%%% SRP Cipher Suites RFC 5054 - -openssl_suite("SRP-DSS-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-RSA-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-DSS-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-RSA-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-DSS-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("SRP-RSA-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; - -%% RFC 4492 EC TLS suites -openssl_suite("ECDH-ECDSA-RC4-SHA") -> - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES128-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES256-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; -openssl_suite("ECDHE-ECDSA-RC4-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES128-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES256-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDHE-RSA-RC4-SHA") -> - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-RSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-RSA-AES128-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-RSA-AES256-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDH-RSA-RC4-SHA") -> - ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-RSA-DES-CBC3-SHA") -> - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-RSA-AES128-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-RSA-AES256-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; - -%% RFC 5289 EC TLS suites -openssl_suite("ECDHE-ECDSA-AES128-SHA256") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-ECDSA-AES256-SHA384") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-ECDSA-AES128-SHA256") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-ECDSA-AES256-SHA384") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDHE-RSA-AES128-SHA256") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-RSA-AES256-SHA384") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-RSA-AES128-SHA256") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-RSA-AES256-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; +tls_1_3_suite_str_to_map(CipherStr) -> + {Cipher, Mac, Prf} = cipher_str_to_algs(CipherStr, ""), + #{key_exchange => any, + mac => Mac, + cipher => Cipher, + prf => Prf + }. -%% RFC 5288 AES-GCM Cipher Suites -openssl_suite("AES128-GCM-SHA256") -> - ?TLS_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("AES256-GCM-SHA384") -> - ?TLS_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DHE-RSA-AES128-GCM-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("DHE-RSA-AES256-GCM-SHA384") -> - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DH-RSA-AES128-GCM-SHA256") -> - ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("DH-RSA-AES256-GCM-SHA384") -> - ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("DHE-DSS-AES128-GCM-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -openssl_suite("DHE-DSS-AES256-GCM-SHA384") -> - ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -openssl_suite("DH-DSS-AES128-GCM-SHA256") -> - ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -openssl_suite("DH-DSS-AES256-GCM-SHA384") -> - ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; +pre_tls_1_3_suite_str_to_map(KexStr, Rest) -> + Kex = algo_str_to_atom(KexStr), + [CipherStr, AlgStr] = string:split(Rest, "_", trailing), + {Cipher, Mac, Prf} = cipher_str_to_algs(CipherStr, AlgStr), + #{key_exchange => Kex, + mac => Mac, + cipher => Cipher, + prf => Prf + }. + +cipher_str_to_algs(CipherStr, "CCM"= End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr, "8" = End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr, "CHACHA20_POLY1305" = End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr0, "") -> %% TLS 1.3 + [CipherStr, AlgStr] = string:split(CipherStr0, "_", trailing), + Hash = algo_str_to_atom(AlgStr), + Cipher = algo_str_to_atom(CipherStr), + {Cipher, aead, Hash}; +cipher_str_to_algs(CipherStr, HashStr) -> %% PRE TLS 1.3 + Hash = algo_str_to_atom(HashStr), + Cipher = algo_str_to_atom(CipherStr), + case is_aead_cipher(CipherStr) of + true -> + {Cipher, aead, Hash}; + false -> + {Cipher, Hash, default_prf} + end. -%% RFC 5289 ECC AES-GCM Cipher Suites -openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") -> - ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") -> - ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -openssl_suite("ECDH-RSA-AES128-GCM-SHA256") -> - ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; +%% PRE TLS 1.3 +is_aead_cipher("CHACHA20_POLY1305") -> + true; +is_aead_cipher(CipherStr) -> + [_, Rest] = string:split(CipherStr, "_", trailing), + (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "8"). -%% TLS 1.3 Cipher Suites RFC8446 -openssl_suite("TLS_AES_128_GCM_SHA256") -> - ?TLS_AES_128_GCM_SHA256; -openssl_suite("TLS_AES_256_GCM_SHA384") -> - ?TLS_AES_256_GCM_SHA384; -openssl_suite("TLS_CHACHA20_POLY1305_SHA256") -> - ?TLS_CHACHA20_POLY1305_SHA256. -%% openssl_suite("TLS_AES_128_CCM_SHA256") -> -%% ?TLS_AES_128_CCM_SHA256; -%% openssl_suite("TLS_AES_128_CCM_8_SHA256") -> -%% ?TLS_AES_128_CCM_8_SHA256. +openssl_is_aead_cipher("CHACHA20-POLY1305") -> + true; +openssl_is_aead_cipher(CipherStr) -> + case string:split(CipherStr, "-", trailing) of + [_, Rest] -> + (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "8"); + [_] -> + false + end. +algo_str_to_atom(AlgoStr) -> + erlang:list_to_existing_atom(string:to_lower(AlgoStr)). -%%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | internal_erl_cipher_suite(). -%% -%% Description: Return openssl cipher suite name if possible -%%------------------------------------------------------------------- -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - "DHE-RSA-AES256-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - "DHE-DSS-AES256-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - "AES256-SHA"; -openssl_suite_name(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "EDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - "EDH-DSS-DES-CBC3-SHA"; -openssl_suite_name(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - "DES-CBC3-SHA"; -openssl_suite_name( ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - "DHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - "DHE-DSS-AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - "AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_SHA) -> - "RC4-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_MD5) -> - "RC4-MD5"; -openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - "EDH-RSA-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> - "DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_NULL_SHA256) -> - "NULL-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> - "AES128-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> - "AES256-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_CBC_SHA256) -> - "DH-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_CBC_SHA256) -> - "DH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> - "DHE-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> - "DHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_CBC_SHA256) -> - "DH-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_CBC_SHA256) -> - "DH-RSA-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> - "DHE-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> - "DHE-RSA-AES256-SHA256"; -%%% PSK Cipher Suites RFC 4279 +openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == rsa; + Kex == dhe_rsa; + Kex == ecdhe_rsa; + Kex == ecdhe_ecdsa -> + openssl_name_concat(CipherStr); +openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == rsa; + Kex == dhe_rsa; + Kex == ecdhe_rsa; + Kex == ecdhe_ecdsa -> + openssl_name_concat(CipherStr); +openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == srp; + Kex == srp_rsa -> + lists:append(string:replace(CipherStr, "_", "-", all)); +openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == srp; + Kex == srp_rsa -> + lists:append(string:replace(CipherStr, "_", "-", all)); +openssl_cipher_name(_, "AES_128_CBC" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CBC"; +openssl_cipher_name(_, "AES_256_CBC" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CBC"; +openssl_cipher_name(_, "AES_128_GCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-GCM"; +openssl_cipher_name(_, "AES_256_GCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-GCM"; +openssl_cipher_name(_, "RC4" ++ _) -> + "RC4"; +openssl_cipher_name(_, CipherStr) -> + lists:append(string:replace(CipherStr, "_", "-", all)). -openssl_suite_name(?TLS_PSK_WITH_AES_256_CBC_SHA) -> - "PSK-AES256-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> - "PSK-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_AES_128_CBC_SHA) -> - "PSK-AES128-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_RC4_128_SHA) -> - "PSK-RC4-SHA"; -%%% SRP Cipher Suites RFC 5054 +openssl_suite_start(Kex) -> + case openssl_kex_name(Kex) of + "" -> + ""; + Name -> + Name ++ "-" + end. -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> - "SRP-RSA-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> - "SRP-DSS-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> - "SRP-RSA-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> - "SRP-DSS-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> - "SRP-RSA-AES-256-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - "SRP-DSS-AES-256-CBC-SHA"; +openssl_kex_name("RSA") -> + ""; +openssl_kex_name(Kex) -> + lists:append(string:replace(Kex, "_", "-", all)). -%% RFC 4492 EC TLS suites -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> - "ECDH-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDH-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDH-ECDSA-AES256-SHA"; +kex_name_from_openssl(Kex) -> + lists:append(string:replace(Kex, "-", "_", all)). -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> - "ECDHE-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-ECDSA-AES256-SHA"; +cipher_name_from_openssl("AES128") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES256") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES128-CBC") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES256-CBC") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES-128-CBC") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES-256-CBC") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES128-GCM") -> + "AES_128_GCM"; +cipher_name_from_openssl("AES256-GCM") -> + "AES_256_GCM"; +cipher_name_from_openssl("RC4") -> + "RC4_128"; +cipher_name_from_openssl(Str) -> + Str. -openssl_suite_name(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> - "ECDH-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> - "ECDH-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> - "ECDH-RSA-AES256-SHA"; +openssl_name_concat(Str0) -> + [Str, _] = string:split(Str0, "_", trailing), + [Part1, Part2] = string:split(Str, "_", trailing), + Part1 ++ Part2. -openssl_suite_name(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> - "ECDHE-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-RSA-AES256-SHA"; -%% RFC 5289 EC TLS suites -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-RSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-RSA-AES256-SHA384"; +suite_openssl_str_to_map(Kex0, Rest) -> + Kex = algo_str_to_atom(kex_name_from_openssl(Kex0)), + [CipherStr, AlgStr] = string:split(Rest, "-", trailing), + {Cipher, Mac, Prf} = openssl_cipher_str_to_algs(CipherStr, AlgStr), + #{key_exchange => Kex, + mac => Mac, + cipher => Cipher, + prf => Prf + }. -%% RFC 5288 AES-GCM Cipher Suites -openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> - "AES128-GCM-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> - "AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> - "DHE-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> - "DHE-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> - "DH-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> - "DH-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> - "DHE-DSS-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> - "DHE-DSS-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> - "DH-DSS-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> - "DH-DSS-AES256-GCM-SHA384"; +%% Does only need own implementation PRE TLS 1.3 +openssl_cipher_str_to_algs(CipherStr, "CCM"= End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, "8" = End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, "POLY1305" = End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, HashStr) -> + Hash = algo_str_to_atom(HashStr), + Cipher = algo_str_to_atom(cipher_name_from_openssl(CipherStr)), + case openssl_is_aead_cipher(CipherStr) of + true -> + {Cipher, aead, Hash}; + false -> + {Cipher, Hash, openssl_prf(Hash)} + end. -%% RFC 5289 ECC AES-GCM Cipher Suites -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> - "ECDHE-ECDSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> - "ECDHE-ECDSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> - "ECDH-ECDSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> - "ECDH-ECDSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> - "ECDHE-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> - "ECDHE-RSA-AES256-GCM-SHA384"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> - "ECDH-RSA-AES128-GCM-SHA256"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> - "ECDH-RSA-AES256-GCM-SHA384"; +openssl_prf(sha256)-> + sha256; +openssl_prf(sha384) -> + sha384; +openssl_prf(_) -> + default_prf. -%% ChaCha20-Poly1305 Cipher Suites for Transport Layer Security (TLS) RFC7905 -openssl_suite_name(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_PSK_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_PSK_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256"; -openssl_suite_name(?TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256) -> - "TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256"; -%% TLS 1.3 Cipher Suites RFC8446 -openssl_suite_name(?TLS_AES_128_GCM_SHA256) -> - "TLS_AES_128_GCM_SHA256"; -openssl_suite_name(?TLS_AES_256_GCM_SHA384) -> - "TLS_AES_256_GCM_SHA384"; -openssl_suite_name(?TLS_CHACHA20_POLY1305_SHA256) -> - "TLS_CHACHA20_POLY1305_SHA256"; -%% openssl_suite(?TLS_AES_128_CCM_SHA256) -> -%% "TLS_AES_128_CCM_SHA256"; -%% openssl_suite(?TLS_AES_128_CCM_8_SHA256) -> -%% "TLS_AES_128_CCM_8_SHA256"; -%% No oppenssl name -openssl_suite_name(Cipher) -> - suite_definition(Cipher). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 059d270ff1..a5f754d2e3 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -703,7 +703,7 @@ handle_session(#server_hello{cipher_suite = CipherSuite, handshake_env = #handshake_env{negotiated_protocol = CurrentProtocol} = HsEnv, connection_env = #connection_env{negotiated_version = ReqVersion} = CEnv} = State0) -> #{key_exchange := KeyAlgorithm} = - ssl_cipher_format:suite_definition(CipherSuite), + ssl_cipher_format:suite_bin_to_map(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -1573,7 +1573,7 @@ connection_info(#state{static_env = #static_env{protocol_cb = Connection}, connection_env = #connection_env{negotiated_version = {_,_} = Version}, ssl_options = Opts}) -> RecordCB = record_cb(Connection), - CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_definition(CipherSuite), + CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), IsNamedCurveSuite = lists:member(KexAlg, [ecdh_ecdsa, ecdhe_ecdsa, ecdh_rsa, ecdhe_rsa, ecdh_anon]), CurveInfo = case ECCCurve of @@ -1584,7 +1584,7 @@ connection_info(#state{static_env = #static_env{protocol_cb = Connection}, end, [{protocol, RecordCB:protocol_version(Version)}, {session_id, SessionId}, - {cipher_suite, ssl_cipher_format:erl_suite_definition(CipherSuiteDef)}, + {cipher_suite, ssl_cipher_format:suite_legacy(CipherSuiteDef)}, {selected_cipher_suite, CipherSuiteDef}, {sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts). @@ -1711,7 +1711,7 @@ resumed_server_hello(#state{session = Session, server_hello(ServerHello, State0, Connection) -> CipherSuite = ServerHello#server_hello.cipher_suite, - #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_bin_to_map(CipherSuite), #state{handshake_env = HsEnv} = State = Connection:queue_handshake(ServerHello, State0), State#state{handshake_env = HsEnv#handshake_env{kex_algorithm = KeyAlgorithm}}. @@ -1726,7 +1726,7 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State1 = State0#state{handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo}, session = Session#session{peer_certificate = PeerCert}}, - #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_bin_to_map(CipherSuite), State = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlgorithm, State1), Connection:next_event(certify, no_record, State). @@ -2728,7 +2728,7 @@ ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) -> ssl_options_list(Keys, Values, [{Key, lists:map( fun(Suite) -> - ssl_cipher_format:suite_definition(Suite) + ssl_cipher_format:suite_bin_to_map(Suite) end, Value)} | Acc]); ssl_options_list([Key | Keys], [Value | Values], Acc) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index bd87355f58..7b34991f4f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -182,7 +182,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> - Types = certificate_types(ssl_cipher_format:suite_definition(CipherSuite), Version), + Types = certificate_types(ssl_cipher_format:suite_bin_to_map(CipherSuite), Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, @@ -883,7 +883,7 @@ available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> filter_unavailable_ecc_suites(Curve, Suites); available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), - filter_hashsigns(Suites, [ssl_cipher_format:suite_definition(Suite) || Suite <- Suites], HashSigns, + filter_hashsigns(Suites, [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- Suites], HashSigns, Version, []). available_signature_algs(undefined, _) -> @@ -1085,7 +1085,7 @@ add_common_extensions(Version, {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers( - lists:map(fun ssl_cipher_format:suite_definition/1, + lists:map(fun ssl_cipher_format:suite_bin_to_map/1, CipherSuites)) of true -> client_ecc_extensions(SupportedECCs); @@ -2990,7 +2990,7 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> cert_curve(_, _, no_suite) -> {no_curve, no_suite}; cert_curve(Cert, ECCCurve0, CipherSuite) -> - case ssl_cipher_format:suite_definition(CipherSuite) of + case ssl_cipher_format:suite_bin_to_map(CipherSuite) of #{key_exchange := Kex} when Kex == ecdh_ecdsa; Kex == ecdh_rsa -> OtpCert = public_key:pkix_decode_cert(Cert, otp), diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index f497315235..987693b96b 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -206,10 +206,14 @@ parse_handshake(Direction, #encrypted_extensions{} = EncryptedExtensions) -> parse_cipher_suites([_|_] = Ciphers) -> [format_cipher(C) || C <- Ciphers]. -format_cipher(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> - 'TLS_EMPTY_RENEGOTIATION_INFO_SCSV'; format_cipher(C0) -> - list_to_atom(ssl_cipher_format:openssl_suite_name(C0)). + try ssl_cipher_format:suite_bin_to_map(C0) of + Map -> + ssl_cipher_format:suite_map_to_str(Map) + catch + error:function_clause -> + format_uknown_cipher_suite(C0) + end. get_client_version(Version, Extensions) -> CHVersions = maps:get(client_hello_versions, Extensions, undefined), @@ -436,3 +440,7 @@ number_to_hex(N) -> H -> lists:reverse(H) end. + +format_uknown_cipher_suite(<<?BYTE(X), ?BYTE(Y)>>) -> + "0x" ++ number_to_hex(X) ++ "0x" ++ number_to_hex(Y). + diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 94b932de36..2480e05097 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -294,7 +294,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), case ssl_handshake:select_hashsign({ClientHashSigns, ClientSignatureSchemes}, Cert, KeyExAlg, SupportedHashSigns, diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 20d28c33de..8a4ad922e1 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -887,7 +887,7 @@ calculate_handshake_secrets(ClientKey, SelectedGroup, KeyShare, tls_v1:server_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), %% Calculate traffic keys - #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + #{cipher := Cipher} = ssl_cipher_format:suite_bin_to_map(CipherSuite), {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret), {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret), @@ -922,7 +922,7 @@ calculate_traffic_secrets(#state{connection_states = ConnectionStates, tls_v1:server_application_traffic_secret_0(HKDFAlgo, MasterSecret, lists:reverse(Messages)), %% Calculate traffic keys - #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + #{cipher := Cipher} = ssl_cipher_format:suite_bin_to_map(CipherSuite), {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientAppTrafficSecret0), {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerAppTrafficSecret0), diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 9f0c588cb6..a5c550a429 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -602,16 +602,18 @@ encode_fragments(_Type, _Version, _Data, CS, _CompS, _CipherS, _Seq, _CipherFrag %% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are %% not vulnerable to this attack. -split_iovec([<<FirstByte:8, Rest/binary>>|Data], Version, BCA, one_n_minus_one) +split_iovec(Data, Version, BCA, one_n_minus_one) when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse {3, 0} == Version) -> - [[FirstByte]|split_iovec([Rest|Data])]; + {Part, RestData} = split_iovec(Data, 1, []), + [Part|split_iovec(RestData)]; %% 0/n splitting countermeasure for clients that are incompatible with 1/n-1 %% splitting. split_iovec(Data, Version, BCA, zero_n) when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse {3, 0} == Version) -> - [<<>>|split_iovec(Data)]; + {Part, RestData} = split_iovec(Data, 0, []), + [Part|split_iovec(RestData)]; split_iovec(Data, _Version, _BCA, _BeatMitigation) -> split_iovec(Data). @@ -621,16 +623,16 @@ split_iovec(Data) -> {Part,Rest} = split_iovec(Data, ?MAX_PLAIN_TEXT_LENGTH, []), [Part|split_iovec(Rest)]. %% -split_iovec([Bin|Data], SplitSize, Acc) -> +split_iovec([Bin|Data] = Bin_Data, SplitSize, Acc) -> BinSize = byte_size(Bin), if + BinSize =< SplitSize -> + split_iovec(Data, SplitSize - BinSize, [Bin|Acc]); + SplitSize == 0 -> + {lists:reverse(Acc), Bin_Data}; SplitSize < BinSize -> {Last, Rest} = erlang:split_binary(Bin, SplitSize), - {lists:reverse(Acc, [Last]), [Rest|Data]}; - BinSize < SplitSize -> - split_iovec(Data, SplitSize - BinSize, [Bin|Acc]); - true -> % Perfect match - {lists:reverse(Acc, [Bin]), Data} + {lists:reverse(Acc, [Last]), [Rest|Data]} end; split_iovec([], _SplitSize, Acc) -> {lists:reverse(Acc),[]}. diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl index bf1bc0e752..8805df7b52 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -749,7 +749,7 @@ cipher_suite_test(CipherSuite, Version, Config) -> ssl_test_lib:close(Client). erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite)); + ssl_cipher_format:suite_definition(ssl_cipher_format:suite_openssl_str_to_map(Suite)); erlang_cipher_suite(Suite) -> Suite. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 70ed2c1854..65b8998cc3 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1341,13 +1341,13 @@ common_ciphers(crypto) -> common_ciphers(openssl) -> OpenSslSuites = string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), - [ssl_cipher_format:suite_definition(S) + [ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), - lists:member(ssl_cipher_format:openssl_suite_name(S), OpenSslSuites) + lists:member(ssl_cipher_format:suite_map_to_openssl_str(ssl_cipher_format:suite_bin_to_map(S)), OpenSslSuites) ]. available_suites(Version) -> - [ssl_cipher_format:suite_definition(Suite) || + [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]. @@ -1420,7 +1420,7 @@ string_regex_filter(_Str, _Search) -> false. ecdh_dh_anonymous_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:anonymous_suites(Version)], [{key_exchange, fun(dh_anon) -> true; @@ -1430,7 +1430,7 @@ ecdh_dh_anonymous_suites(Version) -> false end}]). psk_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []); + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:psk_suites(Version)], []); psk_suites(Version) -> ssl:filter_cipher_suites(psk_suites(dtls_v1:corresponding_tls_version(Version)), [{cipher, @@ -1441,7 +1441,7 @@ psk_suites(Version) -> end}]). psk_anon_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:psk_suites_anon(Version)], [{key_exchange, fun(psk) -> true; @@ -1464,7 +1464,7 @@ psk_anon_suites(Version) -> srp_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_rsa) -> true; @@ -1472,10 +1472,10 @@ srp_suites() -> false end}]). srp_anon_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites_anon()], []). srp_dss_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_dss) -> true; @@ -1483,14 +1483,14 @@ srp_dss_suites() -> false end}]). chacha_suites(Version) -> - [ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + [ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. rc4_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <-ssl_cipher:rc4_suites(Version)], []). des_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <-ssl_cipher:des_suites(Version)], []). tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, @@ -1941,10 +1941,10 @@ version_flag('dtlsv1') -> "-dtls1". filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)-> - filter_suites([ssl_cipher_format:openssl_suite(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:suite_openssl_str_to_map(S) || S <- Ciphers], AtomVersion); filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)-> - filter_suites([ssl_cipher_format:suite_definition(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- Ciphers], AtomVersion); filter_suites(Ciphers0, AtomVersion) -> Version = tls_version(AtomVersion), @@ -1956,7 +1956,7 @@ filter_suites(Ciphers0, AtomVersion) -> ++ ssl_cipher:srp_suites_anon() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), - Supported2 = [ssl_cipher_format:suite_definition(S) || S <- Supported1], + Supported2 = [ssl_cipher_format:suite_bin_to_map(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. -define(OPENSSL_QUIT, "Q\n"). diff --git a/lib/ssl/test/x509_test.erl b/lib/ssl/test/x509_test.erl index fea01efdaf..faf223ae35 100644 --- a/lib/ssl/test/x509_test.erl +++ b/lib/ssl/test/x509_test.erl @@ -22,7 +22,7 @@ -module(x509_test). - -include_lib("public_key/include/public_key.hrl"). +-include_lib("public_key/include/public_key.hrl"). -export([extensions/1, gen_pem_config_files/3]). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index c4bcc1560c..98070f794c 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2.1 +SSL_VSN = 9.2.2 diff --git a/lib/stdlib/doc/src/erl_pp.xml b/lib/stdlib/doc/src/erl_pp.xml index f1c3aa5a41..0a46139db6 100644 --- a/lib/stdlib/doc/src/erl_pp.xml +++ b/lib/stdlib/doc/src/erl_pp.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1996</year> - <year>2016</year> + <year>2019</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -65,6 +65,10 @@ </datatype> <datatype> <name name="option"/> + <desc> + <p>The option <c>quote_singleton_atom_types</c> + is used to add quotes to all singleton atom types.</p> + </desc> </datatype> <datatype> <name name="options"/> diff --git a/lib/stdlib/doc/src/qlc.xml b/lib/stdlib/doc/src/qlc.xml index fe60c2e9bb..34f7c5bab9 100644 --- a/lib/stdlib/doc/src/qlc.xml +++ b/lib/stdlib/doc/src/qlc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2016</year> + <year>2004</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -581,11 +581,13 @@ gb_iter(I0, N, EFun) -> <input>{K} <- ets:table(E1),</input> <input>K == 2.71 orelse K == a]),</input> <input>io:format("~s~n", [qlc:info(Q1)]).</input> -ets:match_spec_run(lists:flatmap(fun(V) -> - ets:lookup(20493, V) - end, - [a,2.71]), - ets:match_spec_compile([{{'$1'},[],['$1']}]))</pre> +ets:match_spec_run( + lists:flatmap(fun(V) -> + ets:lookup(#Ref<0.3098908599.2283929601.256025>, + V) + end, + [a, 2.71]), + ets:match_spec_compile([{{'$1'}, [], ['$1']}]))</pre> <p>In the example, operator <c>==/2</c> has been handled exactly as <c>=:=/2</c> would have been handled. However, @@ -607,9 +609,10 @@ ets:match_spec_run(lists:flatmap(fun(V) -> <input>end,</input> <input>Q2 = F2({2,2}),</input> <input>io:format("~s~n", [qlc:info(Q2)]).</input> -ets:table(53264, +ets:table(#Ref<0.3098908599.2283929601.256125>, [{traverse, - {select,[{{'$1','$2'},[{'==','$1',{const,{2,2}}}],['$2']}]}}]) + {select, + [{{'$1', '$2'}, [{'==', '$1', {const, {2, 2}}}], ['$2']}]}}]) 3> <input>lists:sort(qlc:e(Q2)).</input> [a,b,c]</pre> @@ -629,8 +632,9 @@ ets:table(53264, <input>end,</input> <input>Q3 = F3({2,2}),</input> <input>io:format("~s~n", [qlc:info(Q3)]).</input> -ets:match_spec_run(ets:lookup(86033, {2,2}), - ets:match_spec_compile([{{'$1','$2'},[],['$2']}])) +ets:match_spec_run(ets:lookup(#Ref<0.3098908599.2283929601.256211>, + {2, 2}), + ets:match_spec_compile([{{'$1', '$2'}, [], ['$2']}])) 5> <input>qlc:e(Q3).</input> [b]</pre> @@ -892,21 +896,21 @@ begin V1 = qlc:q([ SQV || - SQV <- [x,y] + SQV <- [x, y] ], - [{unique,true}]), + [{unique, true}]), V2 = qlc:q([ SQV || - SQV <- [a,b] + SQV <- [a, b] ], - [{unique,true}]), + [{unique, true}]), qlc:q([ {X,Y} || X <- V1, Y <- V2 ], - [{unique,true}]) + [{unique, true}]) end</pre> <p>In the following example QLC <c>V2</c> has been inserted to show the joined generators and the join @@ -927,19 +931,21 @@ begin V1 = qlc:q([ P0 || - P0 = {W,Y} <- ets:table(17) + P0 = {W, Y} <- + ets:table(#Ref<0.3098908599.2283929601.256549>) ]), V2 = qlc:q([ - [G1|G2] || + [G1 | G2] || G2 <- V1, - G1 <- ets:table(16), + G1 <- + ets:table(#Ref<0.3098908599.2283929601.256548>), element(2, G1) =:= element(1, G2) ], - [{join,lookup}]), + [{join, lookup}]), qlc:q([ - {X,Z,W} || - [{X,Z}|{W,Y}] <- V2 + {X, Z, W} || + [{X, Z} | {W, Y}] <- V2 ]) end</pre> </desc> @@ -1080,27 +1086,27 @@ begin V1 = qlc:q([ P0 || - P0 = {X,Z} <- - qlc:keysort(1, [{a,1},{b,4},{c,6}], []) + P0 = {X, Z} <- + qlc:keysort(1, [{a, 1}, {b, 4}, {c, 6}], []) ]), V2 = qlc:q([ P0 || - P0 = {W,Y} <- - qlc:keysort(2, [{2,a},{3,b},{4,c}], []) + P0 = {W, Y} <- + qlc:keysort(2, [{2, a}, {3, b}, {4, c}], []) ]), V3 = qlc:q([ - [G1|G2] || + [G1 | G2] || G1 <- V1, G2 <- V2, element(1, G1) == element(2, G2) ], - [{join,merge},{cache,list}]), + [{join, merge}, {cache, list}]), qlc:q([ - {A,X,Z,W} || - A <- [a,b,c], - [{X,Z}|{W,Y}] <- V3, + {A, X, Z, W} || + A <- [a, b, c], + [{X, Z} | {W, Y}] <- V3, X =:= Y ]) end</pre> @@ -1141,14 +1147,21 @@ ets:match_spec_run( gb_trees:lookup(K, gb_trees:from_orddict([])) of - {value,V} -> - [{K,V}]; + {value, V} -> + [{K, V}]; none -> [] end end, - [{1,a},{1,b},{1,c},{2,a},{2,b},{2,c}]), - ets:match_spec_compile([{{{'$1','$2'},'_'},[],['$1']}]))</pre> + [{1, a}, + {1, b}, + {1, c}, + {2, a}, + {2, b}, + {2, c}]), + ets:match_spec_compile([{{{'$1', '$2'}, '_'}, + [], + ['$1']}]))</pre> <p>Options:</p> <list type="bulleted"> <item> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 3e68c1b225..255c0ae81f 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -26,7 +26,7 @@ attribute/1,attribute/2,function/1,function/2, guard/1,guard/2,exprs/1,exprs/2,exprs/3,expr/1,expr/2,expr/3,expr/4]). --import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]). +-import(lists, [append/1,foldr/3,map/2,mapfoldl/3,reverse/1,reverse/2]). -import(io_lib, [write/1,format/2]). -import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0, type_inop_prec/1, type_preop_prec/1]). @@ -41,10 +41,11 @@ io_lib:chars())). -type(option() :: {hook, hook_function()} - | {encoding, latin1 | unicode | utf8}). + | {encoding, latin1 | unicode | utf8} + | {quote_singleton_atom_types, boolean()}). -type(options() :: hook_function() | [option()]). --record(pp, {value_fun, string_fun, char_fun}). +-record(pp, {value_fun, singleton_atom_type_fun, string_fun, char_fun}). -record(options, {hook, encoding, opts}). @@ -206,22 +207,43 @@ options(Hook) -> #options{hook = Hook, encoding = encoding([]), opts = Hook}. state(Options) when is_list(Options) -> + Quote = proplists:get_bool(quote_singleton_atom_types, Options), case encoding(Options) of - latin1 -> state(); - unicode -> unicode_state() + latin1 -> latin1_state(Quote); + unicode -> unicode_state(Quote) end; state(_Hook) -> - state(). + latin1_state(false). -state() -> +latin1_state(Quote) -> Options = [{encoding,latin1}], - #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end, + SingletonFun = + case Quote of + true -> + fun(A) -> + io_lib:write_string_as_latin1(atom_to_list(A), $') + end; %' + false -> + ValueFun + end, + #pp{value_fun = ValueFun, + singleton_atom_type_fun = SingletonFun, string_fun = fun io_lib:write_string_as_latin1/1, char_fun = fun io_lib:write_char_as_latin1/1}. -unicode_state() -> +unicode_state(Quote) -> Options = [{encoding,unicode}], - #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end, + SingletonFun = + case Quote of + true -> + fun(A) -> io_lib:write_string(atom_to_list(A), $') end; %' + false -> + ValueFun + end, + #pp{value_fun = ValueFun, + singleton_atom_type_fun = SingletonFun, string_fun = fun io_lib:write_string/1, char_fun = fun io_lib:write_char/1}. @@ -350,7 +372,7 @@ ltype({user_type,Line,T,Ts}, _) -> ltype({remote_type,Line,[M,F,Ts]}, _) -> simple_type({remote,Line,M,F}, Ts); ltype({atom,_,T}, _) -> - {atom,T}; + {singleton_atom_type,T}; ltype(E, P) -> lexpr(E, P, options(none)). @@ -360,7 +382,12 @@ binary_type(I1, I2) -> P = max_prec(), E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B], E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U], - {seq,'<<','>>',[$,],E1++E2}. + case E1++E2 of + [] -> + leaf("<<>>"); + Es -> + {seq,'<<','>>',[$,],Es} + end. map_type(Fs) -> {first,[$#],map_pair_types(Fs)}. @@ -386,6 +413,8 @@ typed(B, Type) -> {_L,_P,R} = type_inop_prec('::'), {list,[{cstep,[B,' ::'],ltype(Type, R)}]}. +tuple_type([], _) -> + leaf("{}"); tuple_type(Ts, F) -> {seq,${,$},[$,],ltypes(Ts, F, 0)}. @@ -454,7 +483,7 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - [leaf("[]")]; + ['[]']; falist(Falist) -> L = [begin {Name,Arity} = Fa, @@ -562,22 +591,22 @@ lexpr({map, _, Map, Fs}, Prec, Opts) -> El = {first,[Rl,$#],map_fields(Fs, Opts)}, maybe_paren(P, Prec, El); lexpr({block,_,Es}, _, Opts) -> - {list,[{step,'begin',body(Es, Opts)},'end']}; + {list,[{step,'begin',body(Es, Opts)},{reserved,'end'}]}; lexpr({'if',_,Cs}, _, Opts) -> - {list,[{step,'if',if_clauses(Cs, Opts)},'end']}; + {list,[{step,'if',if_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'case',_,Expr,Cs}, _, Opts) -> - {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},'of']}, + {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},{reserved,'of'}]}, cr_clauses(Cs, Opts)}, - 'end']}; + {reserved,'end'}]}; lexpr({'cond',_,Cs}, _, Opts) -> - {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},'end']}; + {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'receive',_,Cs}, _, Opts) -> - {list,[{step,'receive',cr_clauses(Cs, Opts)},'end']}; + {list,[{step,'receive',cr_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) -> Al = {list,[{step,[lexpr(To, Opts),' ->'],body(ToOpt, Opts)}]}, {list,[{step,'receive',cr_clauses(Cs, Opts)}, {step,'after',Al}, - 'end']}; + {reserved,'end'}]}; lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) -> [leaf("fun "),{atom,F},leaf(format("/~w", [A]))]; lexpr({'fun',L,{function,_,_}=Func,Extra}, Prec, Opts) -> @@ -596,15 +625,17 @@ lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) -> ArityItem = lexpr(A, Opts), ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Opts) -> - {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]}; lexpr({named_fun,_,Name,Cs}, _Prec, Opts) -> - {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}; + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})}, + {reserved,'end'}]}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]}}; lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})}, + {reserved,'end'}]}}; lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> @@ -619,7 +650,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) -> Scs =:= [] -> {step,'try',body(Es, Opts)}; true -> - {step,{list,[{step,'try',body(Es, Opts)},'of']}, + {step,{list,[{step,'try',body(Es, Opts)},{reserved,'of'}]}, cr_clauses(Scs, Opts)} end, if @@ -634,7 +665,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) -> true -> {step,'after',body(As, Opts)} end, - 'end']}; + {reserved,'end'}]}; lexpr({'catch',_,Expr}, Prec, Opts) -> {P,R} = preop_prec('catch'), El = {list,[{step,'catch',lexpr(Expr, R, Opts)}]}, @@ -647,7 +678,7 @@ lexpr({match,_,Lhs,Rhs}, Prec, Opts) -> maybe_paren(P, Prec, El); lexpr({op,_,Op,Arg}, Prec, Opts) -> {P,R} = preop_prec(Op), - Ol = leaf(format("~s ", [Op])), + Ol = {reserved, leaf(format("~s ", [Op]))}, El = [Ol,lexpr(Arg, R, Opts)], maybe_paren(P, Prec, El); lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse'; @@ -655,14 +686,14 @@ lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse'; %% Breaks lines since R12B. {L,P,R} = inop_prec(Op), Ll = lexpr(Larg, L, Opts), - Ol = leaf(format("~s", [Op])), + Ol = {reserved, leaf(format("~s", [Op]))}, Lr = lexpr(Rarg, R, Opts), El = {prefer_nl,[[]],[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) -> {L,P,R} = inop_prec(Op), Ll = lexpr(Larg, L, Opts), - Ol = leaf(format("~s", [Op])), + Ol = {reserved, leaf(format("~s", [Op]))}, Lr = lexpr(Rarg, R, Opts), El = {list,[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); @@ -808,6 +839,12 @@ cr_clause({clause,_,[T],G,B}, Opts) -> try_clauses(Cs, Opts) -> clauses(fun try_clause/2, Opts, Cs). +try_clause({clause,_,[{tuple,_,[{atom,_,throw},V,S]}],G,B}, Opts) -> + El = lexpr(V, 0, Opts), + Sl = stack_backtrace(S, [El], Opts), + Gl = guard_when(Sl, G, Opts), + Bl = body(B, Opts), + {step,Gl,Bl}; try_clause({clause,_,[{tuple,_,[C,V,S]}],G,B}, Opts) -> Cs = lexpr(C, 0, Opts), El = lexpr(V, 0, Opts), @@ -876,16 +913,18 @@ lc_qual(Q, Opts) -> lexpr(Q, 0, Opts). proper_list(Es, Opts) -> - {seq,$[,$],$,,lexprs(Es, Opts)}. + {seq,$[,$],[$,],lexprs(Es, Opts)}. improper_list(Es, Opts) -> - {seq,$[,$],{$,,$|},lexprs(Es, Opts)}. + {seq,$[,$],[{$,,' |'}],lexprs(Es, Opts)}. tuple(L, Opts) -> tuple(L, fun lexpr/2, Opts). +tuple([], _F, _Opts) -> + leaf("{}"); tuple(Es, F, Opts) -> - {seq,${,$},$,,lexprs(Es, F, Opts)}. + {seq,${,$},[$,],lexprs(Es, F, Opts)}. args(As, Opts) -> {seq,$(,$),[$,],lexprs(As, Opts)}. @@ -933,6 +972,7 @@ frmt(Item, I, PP) -> %%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative %%% indentation. %%% - {atom,A}: an atom +%%% - {singleton_atom_type,A}: an singleton atom type %%% - {char,C}: a character %%% - {string,S}: a string. %%% - {value,T}: a term. @@ -977,8 +1017,10 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> end, {BCharsL++Chars,Size}; no -> - {BCharsL++insert_newlines(CharsSizeL, I, ST), - nsz(lists:last(Sizes), I0)} + CharsList = handle_step(CharsSizeL, I, ST), + {LChars, LSize} = + maybe_newlines(CharsList, LItems, I, NSepChars, ST), + {[BCharsL,LChars],nsz(LSize, I0)} end; f({force_nl,_ExtraInfoItem,Item}, I, ST, WT, PP) when I < 0 -> %% Extra info is a comment; cannot have that on the same line @@ -994,23 +1036,28 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) -> Sizes =:= [] -> {[], 0}; true -> - {insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)} + {insert_newlines(CharsSize2L, I0, ST), + nsz(lists:last(Sizes), I0)} end; f({value,V}, I, ST, WT, PP) -> f(write_a_value(V, PP), I, ST, WT, PP); f({atom,A}, I, ST, WT, PP) -> f(write_an_atom(A, PP), I, ST, WT, PP); +f({singleton_atom_type,A}, I, ST, WT, PP) -> + f(write_a_singleton_atom_type(A, PP), I, ST, WT, PP); f({char,C}, I, ST, WT, PP) -> f(write_a_char(C, PP), I, ST, WT, PP); f({string,S}, I, ST, WT, PP) -> f(write_a_string(S, I, PP), I, ST, WT, PP); +f({reserved,R}, I, ST, WT, PP) -> + f(R, I, ST, WT, PP); f({hook,HookExpr,Precedence,Func,Options}, I, _ST, _WT, _PP) -> Chars = Func(HookExpr, I, Precedence, Options), {Chars,indentation(Chars, I)}; f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT, _PP) -> Chars = apply(Mod, Func, [HookExpr,I,Precedence,ModFuncEas|Eas]), {Chars,indentation(Chars, I)}; -f(WordName, _I, _ST, WT, _PP) -> % when is_atom(WordName) +f(WordName, _I, _ST, WT, _PP) when is_atom(WordName) -> word(WordName, WT). -define(IND, 4). @@ -1032,12 +1079,18 @@ fl(CItems, Sep0, I0, After, ST, WT, PP) -> true -> [CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT, PP)] end; + ({reserved,Word}, S) -> + [f([Word,S], I0, ST, WT, PP),{[],0}]; (Item, S) -> [f([Item,S], I0, ST, WT, PP),{[],0}] end, - {Sep,LastSep} = case Sep0 of {_,_} -> Sep0; _ -> {Sep0,Sep0} end, + {Sep,LastSep} = sep(Sep0), fl1(CItems, F, Sep, LastSep, After). +sep([{S,LS}]) -> {[S],[LS]}; +sep({_,_}=Sep) -> Sep; +sep(S) -> {S, S}. + fl1([CItem], F, _Sep, _LastSep, After) -> [F(CItem,After)]; fl1([CItem1,CItem2], F, _Sep, LastSep, After) -> @@ -1063,20 +1116,64 @@ unz1(CharSizes) -> nonzero(CharSizes) -> lists:filter(fun({_,Sz}) -> Sz =/= 0 end, CharSizes). -insert_newlines(CharsSizesL, I, ST) when I >= 0 -> - insert_nl(foldr(fun([{_C1,0},{_C2,0}], A) -> - A; - ([{C1,_Sz1},{_C2,0}], A) -> - [C1|A]; - ([{C1,_Sz1},{C2,Sz2}], A) when Sz2 > 0 -> - [insert_nl([C1,C2], I+?IND, ST)|A] - end, [], CharsSizesL), I, ST). +maybe_newlines([{Chars,Size}], [], _I, _NSepChars, _ST) -> + {Chars,Size}; +maybe_newlines(CharsSizeList, Items, I, NSepChars, ST) when I >= 0 -> + maybe_sep(CharsSizeList, Items, I, NSepChars, nl_indent(I, ST)). + +maybe_sep([{Chars1,Size1}|CharsSizeL], [Item|Items], I0, NSepChars, Sep) -> + I1 = case classify_item(Item) of + atomic -> + I0 + Size1; + _ -> + ?MAXLINE+1 + end, + maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, Size1, [Chars1]). + +maybe_sep1([{Chars,Size}|CharsSizeL], [Item|Items], + I0, I, Sep, NSepChars, Sz0, A) -> + case classify_item(Item) of + atomic when is_integer(Size) -> + Size1 = Size + 1, + I1 = I + Size1, + if + I1 =< ?MAXLINE -> + A1 = if + NSepChars > 0 -> [Chars,$\s|A]; + true -> [Chars|A] + end, + maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, + Sz0 + Size1, A1); + true -> + A1 = [Chars,Sep|A], + maybe_sep1(CharsSizeL, Items, I0, I0 + Size, Sep, + NSepChars, Size1, A1) + end; + _ -> + A1 = [Chars,Sep|A], + maybe_sep1(CharsSizeL, Items, I0, ?MAXLINE+1, Sep, NSepChars, + 0, A1) + end; +maybe_sep1(_CharsSizeL, _Items, _Io, _I, _Sep, _NSepChars, Sz, A) -> + {lists:reverse(A), Sz}. +insert_newlines(CharsSizesL, I, ST) when I >= 0 -> + {CharsL, _} = unz1(handle_step(CharsSizesL, I, ST)), + insert_nl(CharsL, I, ST). + +handle_step(CharsSizesL, I, ST) -> + map(fun([{_C1,0},{_C2,0}]) -> + {[], 0}; + ([{C1,Sz1},{_C2,0}]) -> + {C1, Sz1}; + ([{C1,Sz1},{C2,Sz2}]) when Sz2 > 0 -> + {insert_nl([C1,C2], I+?IND, ST),line_size([Sz1,Sz2])} + end, CharsSizesL). insert_nl(CharsL, I, ST) -> insert_sep(CharsL, nl_indent(I, ST)). -insert_sep([Chars1 | CharsL], Sep) -> +insert_sep([Chars1|CharsL], Sep) -> [Chars1 | [[Sep,Chars] || Chars <- CharsL]]. nl_indent(0, _T) -> @@ -1084,6 +1181,12 @@ nl_indent(0, _T) -> nl_indent(I, T) when I > 0 -> [$\n|spaces(I, T)]. +classify_item({atom, _}) -> atomic; +classify_item({singleton_atom_type, _}) -> atomic; +classify_item(Atom) when is_atom(Atom) -> atomic; +classify_item({leaf, _, _}) -> atomic; +classify_item(_) -> complex. + same_line(I0, SizeL, NSepChars) -> try Size = lists:sum(SizeL) + NSepChars, @@ -1144,6 +1247,9 @@ write_a_value(V, PP) -> write_an_atom(A, PP) -> flat_leaf(write_atom(A, PP)). +write_a_singleton_atom_type(A, PP) -> + flat_leaf(write_singleton_atom_type(A, PP)). + write_a_char(C, PP) -> flat_leaf(write_char(C, PP)). @@ -1178,6 +1284,9 @@ write_value(V, PP) -> write_atom(A, PP) -> (PP#pp.value_fun)(A). +write_singleton_atom_type(A, PP) -> + (PP#pp.singleton_atom_type_fun)(A). + write_string(S, PP) -> (PP#pp.string_fun)(S). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index e5d1910070..3eb1670806 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -47,11 +47,12 @@ hook/1, neg_indent/1, maps_syntax/1, + quoted_atom_types/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1, - otp_13662/1, otp_14285/1, otp_15592/1, otp_15751/1]). + otp_13662/1, otp_14285/1, otp_15592/1, otp_15751/1, otp_15755/1]). %% Internal export. -export([ehook/6]). @@ -74,14 +75,14 @@ groups() -> [{expr, [], [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, - messages, maps_syntax + messages, maps_syntax, quoted_atom_types ]}, {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662, - otp_14285, otp_15592, otp_15751]}]. + otp_14285, otp_15592, otp_15751, otp_15755]}]. init_per_suite(Config) -> Config. @@ -473,10 +474,10 @@ cond1(Config) when is_list(Config) -> [{tuple,5,[{atom,5,x},{atom,5,y}]}]}]}, CChars = flat_expr1(C), "cond\n" - " {foo,bar} ->\n" - " [a,b];\n" + " {foo, bar} ->\n" + " [a, b];\n" " true ->\n" - " {x,y}\n" + " {x, y}\n" "end" = CChars, ok. @@ -711,7 +712,7 @@ otp_6321(Config) when is_list(Config) -> Str = "S = hopp, {hej, S}. ", {done, {ok, Tokens, _EndLine}, ""} = erl_scan:tokens("", Str, _L=1), {ok, Exprs} = erl_parse:parse_exprs(Tokens), - "S = hopp, {hej,S}" = lists:flatten(erl_pp:exprs(Exprs)), + "S = hopp, {hej, S}" = lists:flatten(erl_pp:exprs(Exprs)), ok. %% OTP_6911. More newlines. @@ -912,6 +913,21 @@ maps_syntax(Config) when is_list(Config) -> ok = pp_forms(F), ok. +quoted_atom_types(Config) when is_list(Config) -> + Q = [{quote_singleton_atom_types, true}], + U = [{encoding,unicode}], + L = [{encoding,latin1}], + F = "-type t() :: a | a().", + "-type t() :: 'a' | a().\n" = + lists:flatten(parse_and_pp_forms(F, Q ++ L)), + "-type t() :: 'a' | a().\n" = + lists:flatten(parse_and_pp_forms(F, Q ++ U)), + UF = "-type t() :: '\x{400}' | '\x{400}'().", + "-type t() :: '\\x{400}' | '\\x{400}'().\n" = + lists:flatten(parse_and_pp_forms(UF, Q ++ L)), + "-type t() :: '\x{400}' | '\x{400}'().\n" = + lists:flatten(parse_and_pp_forms(UF, Q ++ U)), + ok. %% OTP_8567. Avoid duplicated 'undefined' in record field types. otp_8567(Config) when is_list(Config) -> @@ -1096,7 +1112,7 @@ otp_11861(Config) when is_list(Config) -> A3 = erl_anno:new(3), "-optional_callbacks([bar/0]).\n" = pf({attribute,A3,optional_callbacks,[{bar,0}]}), - "-optional_callbacks([{bar,1,bad}]).\n" = + "-optional_callbacks([{bar, 1, bad}]).\n" = pf({attribute,A3,optional_callbacks,[{bar,1,bad}]}), ok. @@ -1205,6 +1221,46 @@ otp_15751(_Config) -> end">>), ok. +otp_15755(_Config) -> + "[{a, b}, c, {d, e} | t]" = + flat_parse_and_pp_expr("[{a, b}, c, {d, e} | t]", 0, []), + "[{a, b},\n c, d,\n {d, e},\n 1, 2.0,\n {d, e},\n <<>>, {},\n {d, e},\n" + " [], [],\n {d, e} |\n t]" = + flat_parse_and_pp_expr("[{a,b},c,d,{d,e},1,2.0,{d,e},<<>>," + "{},{d,e},[],[],{d,e}|t]", 0, []), + "[{a, b},\n c, d,\n {d, e},\n 1, 2.0,\n {d, e},\n <<>>, {},\n {d, e},\n" + " [], [], d, e | t]" = + flat_parse_and_pp_expr("[{a,b},c,d,{d,e},1,2.0,{d,e},<<>>," + "{},{d,e},[],[],d,e|t]", 0, []), + + "-type t() :: + a | b | c | a | b | a | b | a | b | a | b | a | b | a | b | + a | b | a | b | a | b.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: a | b | c| a | b | a | b | a | b | a |" + " b | a | b | a | b | a | b | a | b |a | b.", [])), + + "-type t() :: + {dict, 0, 16, 16, 8, 80, 48, + {[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], + []}, + {{[], [], [], [], [], [], [], [], [], [], [], [], [], [], []}}}.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: {dict,0,16,16,8,80,48," + "{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}," + "{{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}.", [])), + + "-type t() :: + {{a}, + 0, 16, + {16}, + 8, 80, 48, a, b, e, f, 'sf s sdf', [], {}, + {[]}}.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: {{a}, 0, 16, {16}, 8, 80, 48, a, b, e, f," + " 'sf s sdf', [], {}, {[]}}.", [])), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> @@ -1336,6 +1392,9 @@ pp_expr(List, Options) when is_list(List) -> not_ok end. +flat_parse_and_pp_expr(String, Indent, Options) -> + lists:flatten(parse_and_pp_expr(String, Indent, Options)). + parse_and_pp_expr(String, Indent, Options) -> StringDot = lists:flatten(String) ++ ".", erl_pp:expr(parse_expr(StringDot), Indent, Options). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 4640b2b228..dd49288417 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -4461,21 +4461,24 @@ add_loop(T, I) -> test_table_counter_concurrency(WhatToTest) -> + IntStatePrevOn = + erts_debug:set_internal_state(available_internal_state, true), ItemsToAdd = 1000000, SizeLoopSize = 1000, T = ets:new(k, [public, ordered_set, {write_concurrency, true}]), + erts_debug:set_internal_state(ets_debug_random_split_join, {T, false}), 0 = ets:info(T, size), P = self(), SpawnedSizeProcs = - [spawn(fun() -> - size_loop(T, SizeLoopSize, 0, WhatToTest), - P ! done - end) + [spawn_link(fun() -> + size_loop(T, SizeLoopSize, 0, WhatToTest), + P ! done + end) || _ <- lists:seq(1, 6)], - spawn(fun() -> - add_loop(T, ItemsToAdd), - P ! done_add - end), + spawn_link(fun() -> + add_loop(T, ItemsToAdd), + P ! done_add + end), [receive done -> ok; done_add -> ok @@ -4487,6 +4490,7 @@ test_table_counter_concurrency(WhatToTest) -> _ -> ok end, + erts_debug:set_internal_state(available_internal_state, IntStatePrevOn), ok. test_table_size_concurrency(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 2354a08f78..8a43f15d2c 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. 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. @@ -2436,7 +2436,7 @@ info(Config) when is_list(Config) -> <<"{'EXIT', {badarg, _}} = (catch qlc:info([X || {X} <- []], {n_elements, 0})), L = lists:seq(1, 1000), - \"[1,2,3,4,5,6,7,8,9,10|'...']\" = qlc:info(L, {n_elements, 10}), + \"[1, 2, 3, 4, 5, 6, 7, 8, 9, 10 | '...']\" = qlc:info(L, {n_elements, 10}), {cons,A1,{integer,A2,1},{atom,A3,'...'}} = qlc:info(L, [{n_elements, 1},{format,abstract_code}]), 1 = erl_anno:line(A1), @@ -2447,8 +2447,8 @@ info(Config) when is_list(Config) -> {atom,_,'...'}}}}, {call,_,_,_}]} = qlc:info(Q, [{n_elements, 3},{format,abstract_code}]), - \"ets:match_spec_run([a,b,c,d,e,f],\n\" - \" ets:match_spec_compile([{'$1',[true],\" + \"ets:match_spec_run([a, b, c, d, e, f],\n\" + \" ets:match_spec_compile([{'$1', [true], \" \"[{{'$1'}}]}]))\" = qlc:info(Q, [{n_elements, infinity}])">>, @@ -6547,7 +6547,7 @@ otp_7114(Config) when is_list(Config) -> otp_7232(Config) when is_list(Config) -> Ts = [<<"L = [fun math:sqrt/1, list_to_pid(\"<0.4.1>\"), erlang:make_ref()], - \"[fun math:sqrt/1,<0.4.1>,#Ref<\" ++ _ = qlc:info(L), + \"[fun math:sqrt/1, <0.4.1>, #Ref<\" ++ _ = qlc:info(L), {call,_, {remote,_,{atom,_,qlc},{atom,_,sort}}, [{cons,_, @@ -6563,7 +6563,7 @@ otp_7232(Config) when is_list(Config) -> \"qlc:sort([55296,56296],[{order,fun'-function/0-fun-2-'/2}])\" = format_info(Q, true), AC = qlc:info(Q, {format, abstract_code}), - \"qlc:sort([55296,56296], [{order,fun '-function/0-fun-2-'/2}])\" = + \"qlc:sort([55296, 56296], [{order, fun '-function/0-fun-2-'/2}])\" = binary_to_list(iolist_to_binary(erl_pp:expr(AC)))">>, %% OTP-7234. erl_parse:abstract() handles bit strings @@ -7088,21 +7088,21 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" SQV ||\n\" - \" SQV <- [x,y]\n\" + \" SQV <- [x, y]\n\" \" ],\n\" - \" [{unique,true}]),\n\" + \" [{unique, true}]),\n\" \" V2 =\n\" \" qlc:q([ \n\" \" SQV ||\n\" - \" SQV <- [a,b]\n\" + \" SQV <- [a, b]\n\" \" ],\n\" - \" [{unique,true}]),\n\" + \" [{unique, true}]),\n\" \" qlc:q([ \n\" - \" {X,Y} ||\n\" + \" {X, Y} ||\n\" \" X <- V1,\n\" \" Y <- V2\n\" \" ],\n\" - \" [{unique,true}])\n\" + \" [{unique, true}])\n\" \"end\", true = B =:= qlc:info(QH, unique_all)">>, @@ -7118,19 +7118,19 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {W,Y} <- ets:table(_)\n\" + \" P0 = {W, Y} <- ets:table(_)\n\" \" ]),\n\" \" V2 =\n\" \" qlc:q([ \n\" - \" [G1|G2] ||\n\" + \" [G1 | G2] ||\n\" \" G2 <- V1,\n\" \" G1 <- ets:table(_),\n\" \" element(2, G1) =:= element(1, G2)\n\" \" ],\n\" - \" [{join,lookup}]),\n\" + \" [{join, lookup}]),\n\" \" qlc:q([ \n\" - \" {X,Z,W} ||\n\" - \" [{X,Z}|{W,Y}] <- V2\n\" + \" {X, Z, W} ||\n\" + \" [{X, Z} | {W, Y}] <- V2\n\" \" ])\n\" \"end\", Info1 = @@ -7155,25 +7155,28 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {X,Z} <- qlc:keysort(1, [{a,1},{b,4},{c,6}], [])\n\" + \" P0 = {X, Z} <-\n\" + \" qlc:keysort(1, [{a, 1}, {b, 4}, {c, 6}], [])\n\" \" ]),\n\" \" V2 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {W,Y} <- qlc:keysort(2, [{2,a},{3,b},{4,c}], [])\n\" + \" P0 = {W, Y} <-\n\" + \" qlc:keysort(2, [{2, a}, {3, b}, {4, c}], [])\n\" + \" ]),\n\" \" V3 =\n\" \" qlc:q([ \n\" - \" [G1|G2] ||\n\" + \" [G1 | G2] ||\n\" \" G1 <- V1,\n\" \" G2 <- V2,\n\" \" element(1, G1) == element(2, G2)\n\" \" ],\n\" - \" [{join,merge},{cache,list}]),\n\" + \" [{join, merge}, {cache, list}]),\n\" \" qlc:q([ \n\" - \" {A,X,Z,W} ||\n\" - \" A <- [a,b,c],\n\" - \" [{X,Z}|{W,Y}] <- V3,\n\" + \" {A, X, Z, W} ||\n\" + \" A <- [a, b, c],\n\" + \" [{X, Z} | {W, Y}] <- V3,\n\" \" X =:= Y\n\" \" ])\n\" \"end\", @@ -7215,14 +7218,21 @@ manpage(Config) when is_list(Config) -> gb_trees:lookup(K, gb_trees:from_orddict([])) of - {value,V} -> - [{K,V}]; + {value, V} -> + [{K, V}]; none -> [] end end, - [{1,a},{1,b},{1,c},{2,a},{2,b},{2,c}]), - ets:match_spec_compile([{{{'$1','$2'},'_'},[],['$1']}]))\", + [{1, a}, + {1, b}, + {1, c}, + {2, a}, + {2, b}, + {2, c}]), + ets:match_spec_compile([{{{'$1', '$2'}, '_'}, + [], + ['$1']}]))\", L = qlc:info(QH)">> ], run(Config, Ts), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 22136d687c..cdb6031b07 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. 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. @@ -2591,7 +2591,7 @@ otp_7184(Config) when is_list(Config) -> otp_7232(Config) when is_list(Config) -> Info = <<"qlc:info(qlc:sort(qlc:q([X || X <- [55296,56296]]), " "{order, fun(A,B)-> A>B end})).">>, - "qlc:sort([55296,56296],\n" + "qlc:sort([55296, 56296],\n" " [{order,\n" " fun(A, B) ->\n" " A > B\n" @@ -2752,7 +2752,7 @@ otp_10302(Config) when is_list(Config) -> h().">>, "ok.\n\"\x{400}\"\nA = \"\x{400}\".\nok.\n" - "1: io:setopts([{encoding,utf8}])\n-> ok.\n" + "1: io:setopts([{encoding, utf8}])\n-> ok.\n" "2: A = [1024] = \"\x{400}\"\n-> \"\x{400}\"\n" "3: b()\n-> ok.\nok.\n" = t({Node,Test4}), diff --git a/lib/syntax_tools/doc/demo.erl b/lib/syntax_tools/doc/demo.erl new file mode 120000 index 0000000000..fe40fb65ec --- /dev/null +++ b/lib/syntax_tools/doc/demo.erl @@ -0,0 +1 @@ +../examples/demo.erl
\ No newline at end of file diff --git a/lib/syntax_tools/doc/overview.edoc b/lib/syntax_tools/doc/overview.edoc index 3111633a99..7be96f1a55 100644 --- a/lib/syntax_tools/doc/overview.edoc +++ b/lib/syntax_tools/doc/overview.edoc @@ -26,7 +26,7 @@ library module {@link prettypr}: this is a powerful and flexible generic pretty printing library, which is also distributed separately. For a short demonstration of parsing and pretty-printing, simply -compile the included module <a href="../examples/demo.erl">`demo.erl'</a>, +compile the included module <a href="demo.erl">`demo.erl'</a>, and execute `demo:run()' from the Erlang shell. It will compile the remaining modules and give you further instructions. diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile index d953287bad..b799c76177 100644 --- a/lib/syntax_tools/doc/src/Makefile +++ b/lib/syntax_tools/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2018. All Rights Reserved. +# Copyright Ericsson AB 2006-2019. 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. @@ -82,6 +82,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +EXAMPLES_DIR = ../../examples +EXAMPLES = $(EXAMPLES_DIR)/demo.erl + SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml @@ -146,5 +149,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DIR) "$(RELSYSDIR)/examples" + $(INSTALL_DATA) $(EXAMPLES) "$(RELSYSDIR)/doc/html" release_spec: diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 28f8346a19..2191ebe2df 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -128,6 +128,21 @@ </section> +<section><title>Tools 2.11.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Minor fixes for <c>make clean</c>.</p> + <p> + Own Id: OTP-15657</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.11.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1905,4 +1920,3 @@ </section> </section> </chapter> - diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 2b7b17afb3..7a0a941ccc 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -32,6 +32,7 @@ MODULES = \ make_SUITE \ tools_SUITE \ xref_SUITE \ + prof_bench_SUITE \ ignore_cores ERL_FILES= $(MODULES:%=%.erl) @@ -41,7 +42,7 @@ INSTALL_PROGS= $(TARGET_FILES) EMAKEFILE=Emakefile -SPEC_FILES= tools.spec +SPEC_FILES= tools.spec tools_bench.spec COVER_FILE = tools.cover # ---------------------------------------------------- diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl index 8756a4e9b3..73270e6ed6 100644 --- a/lib/tools/test/emacs_SUITE.erl +++ b/lib/tools/test/emacs_SUITE.erl @@ -119,7 +119,7 @@ compile_and_load(_Config) -> false -> " " end, emacs([Pedantic, - " -f batch-byte-compile ",filename:join(Dir, File)]), + " -f batch-byte-compile ", dquote(filename:join(Dir, File))]), true end, lists:foreach(Compile, Files), @@ -144,6 +144,10 @@ tests_compiled(_Config) -> ok end. + +dquote(Str) -> + "\"" ++ Str ++ "\"". + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% indent(Config) -> @@ -207,14 +211,14 @@ emacs_version_ok(AcceptVer) -> emacs(EmacsCmds) when is_list(EmacsCmds) -> Cmd = ["emacs ", "--batch --quick ", - "--directory ", emacs_dir(), " ", + "--directory ", dquote(emacs_dir()), " ", "--eval \"(require 'erlang-start)\" " | EmacsCmds], Res0 = os:cmd(Cmd ++ " ; echo $?"), Rows = string:lexemes(Res0, ["\r\n", $\n]), Res = lists:last(Rows), Output = string:join(lists:droplast(Rows), "\n"), - io:format("Cmd ~s:~n => ~s ~ts~n", [Cmd, Res, Output]), + io:format("Cmd ~ts:~n => ~s ~ts~n", [Cmd, Res, Output]), "0" = Res, Output. diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index 33259df58f..f474669836 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -260,13 +260,18 @@ test_format(Options0, Gather, Verify) -> test_abort(Gather) -> %% There's no way for us to tell whether this actually aborted or ran to %% completion, but it might catch a few segfaults. + %% This testcase is mostly useful when run in an debug emulator as it needs + %% the modified reduction count to trigger the odd trap scenarios Runner = self(), Ref = make_ref(), spawn_opt(fun() -> - [Gather({Type, SchedId, 1, 1, Ref}) || - Type <- erlang:system_info(alloc_util_allocators), - SchedId <- lists:seq(0, erlang:system_info(schedulers))], - Runner ! Ref + [begin + Ref2 = make_ref(), + [Gather({Type, SchedId, 1, 1, Ref2}) || + Type <- erlang:system_info(alloc_util_allocators), + SchedId <- lists:seq(0, erlang:system_info(schedulers))] + end || _ <- lists:seq(1,100)], + Runner ! Ref end, [{priority, max}]), receive Ref -> ok diff --git a/lib/tools/test/prof_bench_SUITE.erl b/lib/tools/test/prof_bench_SUITE.erl new file mode 100644 index 0000000000..50d0ba9cd9 --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE.erl @@ -0,0 +1,126 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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(prof_bench_SUITE). + +-include_lib("common_test/include/ct_event.hrl"). + +%% Test server framework exports +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). + +-export([overhead/1]). + +%%%--------------------------------------------------------------------- +%%% Test suites +%%%--------------------------------------------------------------------- + + +suite() -> + [{timetrap,{minutes,10}}]. + +all() -> + [overhead]. + +init_per_suite(Config) -> + case {test_server:is_native(fprof_SUITE) or + (lists:any(fun(M) -> test_server:is_native(M) end, modules())) or + (whereis(cover_server) =/= undefined), + erlang:system_info(wordsize)} + of + {true, _} -> {skip, "Native or cover code"}; + {_, 4} -> {skip, "Can't run on 32-bit as files will be large"}; + {false, 8} -> Config + end. + +end_per_suite(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + file:delete(LogFile), + ok. + +%%%--------------------------------------------------------------------- + +%% ct:run_test([{suite, prof_bench_SUITE}]). +overhead(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), + TC = fun() -> compile:file(SofsCopy, [binary]) end, + _Warmup = timer:tc(TC), + + {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), + ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, NormTime / FProfTime * 100]), + {ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]), + ct:pal("EProf: ~p Norm: ~p Ratio: ~p",[EProfTime, NormTime, NormTime / EProfTime * 100]), + {CProfTime,{ok,sofs_copy,_}} = cprof_apply(timer, tc, [TC]), + ct:pal("CProf: ~p Norm: ~p Ratio: ~p",[CProfTime, NormTime, NormTime / CProfTime * 100]), + {CoverTime,{ok,sofs_copy,_}} = cover_apply(timer, tc, [TC]), + ct:pal("Cover: ~p Norm: ~p Ratio: ~p",[CoverTime, NormTime, NormTime / CoverTime * 100]), + + ct_event:notify(#event{name = benchmark_data, + data = [{name, fprof_overhead}, + {value, NormTime / FProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, eprof_overhead}, + {value, NormTime / EProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cprof_overhead}, + {value, NormTime / CProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cover_overhead}, + {value, NormTime / CoverTime * 100}]}). + +%% overhead(Config) -> +%% LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), +%% SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), +%% TC = fun() -> compile:file(SofsCopy, [binary]) end, +%% _Warmup = timer:tc(TC), + +%% [{ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]) +%% || _ <- lists:seq(1,10)], +%% %% [fprof:apply(timer, tc, [TC], [{file, LogFile}]) || _ <- lists:seq(1,10)], +%% {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), +%% {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + + %% ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, FProfTime / NormTime]). + +cprof_apply(M, F, A) -> + cprof:start(), + Res = apply(M, F, A), + cprof:stop(), + Res. + +cover_apply(M, F, A) -> + cover:start(), + catch cover:local_only(), + Modules = modules(), + [code:unstick_mod(Mod) || Mod <- Modules], + cover:compile_beam(Modules), + [code:stick_mod(Mod) || Mod <- Modules], + Res = apply(M, F, A), + cover:stop(), + Res. + +modules() -> + application:load(compiler), + {ok, CompilerModules} = application:get_key(compiler, modules), + %% Only cover compile a subset of the stdlib modules + StdlibModules = [erl_parse, erl_expand_records, erl_lint, gb_trees, gb_sets, sofs, + beam_lib, dict, epp, erl_anno, erl_bits, + orddict, ordsets, sets, string, unicode, unicode_util], + CompilerModules ++ StdlibModules. diff --git a/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl new file mode 100644 index 0000000000..2a9b19177e --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl @@ -0,0 +1,2809 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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(sofs_copy). + +-export([from_term/1, from_term/2, from_external/2, empty_set/0, + is_type/1, set/1, set/2, from_sets/1, relation/1, relation/2, + a_function/1, a_function/2, family/1, family/2, + to_external/1, type/1, to_sets/1, no_elements/1, + specification/2, union/2, intersection/2, difference/2, + symdiff/2, symmetric_partition/2, product/1, product/2, + constant_function/2, is_equal/2, is_subset/2, is_sofs_set/1, + is_set/1, is_empty_set/1, is_disjoint/2]). + +-export([union/1, intersection/1, canonical_relation/1]). + +-export([relation_to_family/1, domain/1, range/1, field/1, + relative_product/1, relative_product/2, relative_product1/2, + converse/1, image/2, inverse_image/2, strict_relation/1, + weak_relation/1, extension/3, is_a_function/1]). + +-export([composite/2, inverse/1]). + +-export([restriction/2, restriction/3, drestriction/2, drestriction/3, + substitution/2, projection/2, partition/1, partition/2, + partition/3, multiple_relative_product/2, join/4]). + +-export([family_to_relation/1, family_specification/2, + union_of_family/1, intersection_of_family/1, + family_union/1, family_intersection/1, + family_domain/1, family_range/1, family_field/1, + family_union/2, family_intersection/2, family_difference/2, + partition_family/2, family_projection/2]). + +-export([family_to_digraph/1, family_to_digraph/2, + digraph_to_family/1, digraph_to_family/2]). + +%% Shorter names of some functions. +-export([fam2rel/1, rel2fam/1]). + +-import(lists, + [any/2, append/1, flatten/1, foreach/2, + keysort/2, last/1, map/2, mapfoldl/3, member/2, merge/2, + reverse/1, reverse/2, sort/1, umerge/1, umerge/2, usort/1]). + +-compile({inline, [{family_to_relation,1}, {relation_to_family,1}]}). + +-compile({inline, [{rel,2},{a_func,2},{fam,2},{term2set,2}]}). + +-compile({inline, [{external_fun,1},{element_type,1}]}). + +-compile({inline, + [{unify_types,2}, {match_types,2}, + {test_rel,3}, {symdiff,3}, + {subst,3}]}). + +-compile({inline, [{fam_binop,3}]}). + +%% Nope, no is_member, del_member or add_member. +%% +%% See also "Naive Set Theory" by Paul R. Halmos. +%% +%% By convention, erlang:error/1 is called from exported functions. + +-define(TAG, 'Set'). +-define(ORDTAG, 'OrdSet'). + +-record(?TAG, {data = [] :: list(), type = type :: term()}). +-record(?ORDTAG, {orddata = {} :: tuple() | atom(), + ordtype = type :: term()}). + +-define(LIST(S), (S)#?TAG.data). +-define(TYPE(S), (S)#?TAG.type). +-define(SET(L, T), #?TAG{data = L, type = T}). +-define(IS_SET(S), is_record(S, ?TAG)). +-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE). + +%% Ordered sets and atoms: +-define(ORDDATA(S), (S)#?ORDTAG.orddata). +-define(ORDTYPE(S), (S)#?ORDTAG.ordtype). +-define(ORDSET(L, T), #?ORDTAG{orddata = L, ordtype = T}). +-define(IS_ORDSET(S), is_record(S, ?ORDTAG)). +-define(ATOM_TYPE, atom). +-define(IS_ATOM_TYPE(T), is_atom(T)). % true for ?ANYTYPE... + +%% When IS_SET is true: +-define(ANYTYPE, '_'). +-define(BINREL(X, Y), {X, Y}). +-define(IS_RELATION(R), is_tuple(R)). +-define(REL_ARITY(R), tuple_size(R)). +-define(REL_TYPE(I, R), element(I, R)). +-define(SET_OF(X), [X]). +-define(IS_SET_OF(X), is_list(X)). +-define(FAMILY(X, Y), ?BINREL(X, ?SET_OF(Y))). + +-export_type([anyset/0, binary_relation/0, external_set/0, a_function/0, + family/0, relation/0, set_of_sets/0, set_fun/0, spec_fun/0, + type/0]). +-export_type([ordset/0, a_set/0]). + +-type(anyset() :: ordset() | a_set()). +-type(binary_relation() :: relation()). +-type(external_set() :: term()). +-type(a_function() :: relation()). +-type(family() :: a_function()). +-opaque(ordset() :: #?ORDTAG{}). +-type(relation() :: a_set()). +-opaque(a_set() :: #?TAG{}). +-type(set_of_sets() :: a_set()). +-type(set_fun() :: pos_integer() + | {external, fun((external_set()) -> external_set())} + | fun((anyset()) -> anyset())). +-type(spec_fun() :: {external, fun((external_set()) -> boolean())} + | fun((anyset()) -> boolean())). +-type(type() :: term()). + +-type(tuple_of(_T) :: tuple()). + +%% +%% Exported functions +%% + +%%% +%%% Create sets +%%% + +-spec(from_term(Term) -> AnySet when + AnySet :: anyset(), + Term :: term()). +from_term(T) -> + Type = case T of + _ when is_list(T) -> [?ANYTYPE]; + _ -> ?ANYTYPE + end, + try setify(T, Type) + catch _:_ -> erlang:error(badarg) + end. + +-spec(from_term(Term, Type) -> AnySet when + AnySet :: anyset(), + Term :: term(), + Type :: type()). +from_term(L, T) -> + case is_type(T) of + true -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; + false -> + erlang:error(badarg) + end. + +-spec(from_external(ExternalSet, Type) -> AnySet when + ExternalSet :: external_set(), + AnySet :: anyset(), + Type :: type()). +from_external(L, ?SET_OF(Type)) -> + ?SET(L, Type); +from_external(T, Type) -> + ?ORDSET(T, Type). + +-spec(empty_set() -> Set when + Set :: a_set()). +empty_set() -> + ?SET([], ?ANYTYPE). + +-spec(is_type(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_type(Atom) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + true; +is_type(?SET_OF(T)) -> + is_element_type(T); +is_type(T) when tuple_size(T) > 0 -> + is_types(tuple_size(T), T); +is_type(_T) -> + false. + +-spec(set(Terms) -> Set when + Set :: a_set(), + Terms :: [term()]). +set(L) -> + try usort(L) of + SL -> ?SET(SL, ?ATOM_TYPE) + catch _:_ -> erlang:error(badarg) + end. + +-spec(set(Terms, Type) -> Set when + Set :: a_set(), + Terms :: [term()], + Type :: type()). +set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE -> + try usort(L) of + SL -> ?SET(SL, Type) + catch _:_ -> erlang:error(badarg) + end; +set(L, ?SET_OF(_) = T) -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; +set(_, _) -> + erlang:error(badarg). + +-spec(from_sets(ListOfSets) -> Set when + Set :: a_set(), + ListOfSets :: [anyset()]; + (TupleOfSets) -> Ordset when + Ordset :: ordset(), + TupleOfSets :: tuple_of(anyset())). +from_sets(Ss) when is_list(Ss) -> + case set_of_sets(Ss, [], ?ANYTYPE) of + {error, Error} -> + erlang:error(Error); + Set -> + Set + end; +from_sets(Tuple) when is_tuple(Tuple) -> + case ordset_of_sets(tuple_to_list(Tuple), [], []) of + error -> + erlang:error(badarg); + Set -> + Set + end; +from_sets(_) -> + erlang:error(badarg). + +-spec(relation(Tuples) -> Relation when + Relation :: relation(), + Tuples :: [tuple()]). +relation([]) -> + ?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)); +relation(Ts = [T | _]) when is_tuple(T) -> + try rel(Ts, tuple_size(T)) + catch _:_ -> erlang:error(badarg) + end; +relation(_) -> + erlang:error(badarg). + +-spec(relation(Tuples, Type) -> Relation when + N :: integer(), + Type :: N | type(), + Relation :: relation(), + Tuples :: [tuple()]). +relation(Ts, TS) -> + try rel(Ts, TS) + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples) -> Function when + Function :: a_function(), + Tuples :: [tuple()]). +a_function(Ts) -> + try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples, Type) -> Function when + Function :: a_function(), + Tuples :: [tuple()], + Type :: type()). +a_function(Ts, T) -> + try a_func(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples) -> Family when + Family :: family(), + Tuples :: [tuple()]). +family(Ts) -> + try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples, Type) -> Family when + Family :: family(), + Tuples :: [tuple()], + Type :: type()). +family(Ts, T) -> + try fam(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +%%% +%%% Functions on sets. +%%% + +-spec(to_external(AnySet) -> ExternalSet when + ExternalSet :: external_set(), + AnySet :: anyset()). +to_external(S) when ?IS_SET(S) -> + ?LIST(S); +to_external(S) when ?IS_ORDSET(S) -> + ?ORDDATA(S). + +-spec(type(AnySet) -> Type when + AnySet :: anyset(), + Type :: type()). +type(S) when ?IS_SET(S) -> + ?SET_OF(?TYPE(S)); +type(S) when ?IS_ORDSET(S) -> + ?ORDTYPE(S). + +-spec(to_sets(ASet) -> Sets when + ASet :: a_set() | ordset(), + Sets :: tuple_of(AnySet) | [AnySet], + AnySet :: anyset()). +to_sets(S) when ?IS_SET(S) -> + case ?TYPE(S) of + ?SET_OF(Type) -> list_of_sets(?LIST(S), Type, []); + Type -> list_of_ordsets(?LIST(S), Type, []) + end; +to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []); +to_sets(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(no_elements(ASet) -> NoElements when + ASet :: a_set() | ordset(), + NoElements :: non_neg_integer()). +no_elements(S) when ?IS_SET(S) -> + length(?LIST(S)); +no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_size(?ORDDATA(S)); +no_elements(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(specification(Fun, Set1) -> Set2 when + Fun :: spec_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +specification(Fun, S) when ?IS_SET(S) -> + Type = ?TYPE(S), + R = case external_fun(Fun) of + false -> + spec(?LIST(S), Fun, element_type(Type), []); + XFun -> + specification(?LIST(S), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, Type); + Bad -> + erlang:error(Bad) + end. + +-spec(union(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type) + end. + +-spec(intersection(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(difference(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symdiff(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symmetric_partition(Set1, Set2) -> {Set3, Set4, Set5} when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set(), + Set5 :: a_set()). +symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type) + end. + +-spec(product(Set1, Set2) -> BinRel when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +product(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + if + ?TYPE(S1) =:= ?ANYTYPE -> S1; + ?TYPE(S2) =:= ?ANYTYPE -> S2; + true -> + F = fun(E) -> {0, E} end, + T = ?BINREL(?TYPE(S1), ?TYPE(S2)), + ?SET(relprod(map(F, ?LIST(S1)), map(F, ?LIST(S2))), T) + end. + +-spec(product(TupleOfSets) -> Relation when + Relation :: relation(), + TupleOfSets :: tuple_of(a_set())). +product({S1, S2}) -> + product(S1, S2); +product(T) when is_tuple(T) -> + Ss = tuple_to_list(T), + try sets_to_list(Ss) of + [] -> + erlang:error(badarg); + L -> + Type = types(Ss, []), + case member([], L) of + true -> + empty_set(); + false -> + ?SET(reverse(prod(L, [], [])), Type) + end + catch _:_ -> erlang:error(badarg) + end. + +-spec(constant_function(Set, AnySet) -> Function when + AnySet :: anyset(), + Function :: a_function(), + Set :: a_set()). +constant_function(S, E) when ?IS_SET(S) -> + case {?TYPE(S), is_sofs_set(E)} of + {?ANYTYPE, true} -> S; + {Type, true} -> + NType = ?BINREL(Type, type(E)), + ?SET(constant_function(?LIST(S), to_external(E), []), NType); + _ -> erlang:error(badarg) + end; +constant_function(S, _) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(is_equal(AnySet1, AnySet2) -> Bool when + AnySet1 :: anyset(), + AnySet2 :: anyset(), + Bool :: boolean()). +is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> ?LIST(S1) == ?LIST(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) -> + case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of + true -> ?ORDDATA(S1) == ?ORDDATA(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) -> + erlang:error(type_mismatch); +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) -> + erlang:error(type_mismatch). + +-spec(is_subset(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> subset(?LIST(S1), ?LIST(S2)); + false -> erlang:error(type_mismatch) + end. + +-spec(is_sofs_set(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_sofs_set(S) when ?IS_SET(S) -> + true; +is_sofs_set(S) when ?IS_ORDSET(S) -> + true; +is_sofs_set(_S) -> + false. + +-spec(is_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_set(S) when ?IS_SET(S) -> + true; +is_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_empty_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_empty_set(S) when ?IS_SET(S) -> + ?LIST(S) =:= []; +is_empty_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_disjoint(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> + case ?LIST(S1) of + [] -> true; + [A | As] -> disjoint(?LIST(S2), A, As) + end; + false -> erlang:error(type_mismatch) + end. + +%%% +%%% Functions on set-of-sets. +%%% + +-spec(union(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +union(Sets) when ?IS_SET(Sets) -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +-spec(intersection(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +intersection(Sets) when ?IS_SET(Sets) -> + case ?LIST(Sets) of + [] -> erlang:error(badarg); + [L | Ls] -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> + ?SET(lintersection(Ls, L), Type); + _ -> erlang:error(badarg) + end + end. + +-spec(canonical_relation(SetOfSets) -> BinRel when + BinRel :: binary_relation(), + SetOfSets :: set_of_sets()). +canonical_relation(Sets) when ?IS_SET(Sets) -> + ST = ?TYPE(Sets), + case ST of + ?SET_OF(?ANYTYPE) -> empty_set(); + ?SET_OF(Type) -> + ?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST)); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on binary relations only. +%%% + +-spec(rel2fam(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +rel2fam(R) -> + relation_to_family(R). + +-spec(relation_to_family(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +relation_to_family(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + ?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT)); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(domain(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +domain(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(range(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +range(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(field(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +%% In "Introduction to LOGIC", Suppes defines the field of a binary +%% relation to be the union of the domain and the range (or +%% counterdomain). +field(R) -> + union(domain(R), range(R)). + +-spec(relative_product(ListOfBinRels) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel2 :: binary_relation()). +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT) when is_tuple(RT) -> + relative_product(tuple_to_list(RT)); +relative_product(RL) when is_list(RL) -> + case relprod_n(RL, foo, false, false) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product(ListOfBinRels, BinRel1) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(); + (BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + relative_product1(converse(R1), R2); +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT, R) when is_tuple(RT), ?IS_SET(R) -> + relative_product(tuple_to_list(RT), R); +relative_product(RL, R) when is_list(RL), ?IS_SET(R) -> + EmptyR = case ?TYPE(R) of + ?BINREL(_, _) -> ?LIST(R) =:= []; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end, + case relprod_n(RL, R, EmptyR, true) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product1(BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + {DTR1, RTR1} = case ?TYPE(R1) of + ?BINREL(_, _) = R1T -> R1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + {DTR2, RTR2} = case ?TYPE(R2) of + ?BINREL(_, _) = R2T -> R2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(DTR1, DTR2) of + true when DTR1 =:= ?ANYTYPE -> R1; + true when DTR2 =:= ?ANYTYPE -> R2; + true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2)); + false -> erlang:error(type_mismatch) + end. + +-spec(converse(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +converse(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT)); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(DT, ?TYPE(S)) of + true -> + ?SET(usort(restrict(?LIST(S), ?LIST(R))), RT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(inverse_image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(RT, ?TYPE(S)) of + true -> + NL = restrict(?LIST(S), converse(?LIST(R), [])), + ?SET(usort(NL), DT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(strict_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +strict_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + Type = ?BINREL(_, _) -> + ?SET(strict(?LIST(R), []), Type); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(weak_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +weak_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case unify_types(DT, RT) of + [] -> + erlang:error(badarg); + Type -> + ?SET(weak(?LIST(R)), ?BINREL(Type, Type)) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when + AnySet :: anyset(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) -> + case {?TYPE(R), ?TYPE(S), is_sofs_set(E)} of + {T=?BINREL(DT, RT), ST, true} -> + case match_types(DT, ST) and match_types(RT, type(E)) of + false -> + erlang:error(type_mismatch); + true -> + RL = ?LIST(R), + case extc([], ?LIST(S), to_external(E), RL) of + [] -> + R; + L -> + ?SET(merge(RL, reverse(L)), T) + end + end; + {?ANYTYPE, ?ANYTYPE, true} -> + R; + {?ANYTYPE, ST, true} -> + case type(E) of + ?SET_OF(?ANYTYPE) -> + R; + ET -> + ?SET([], ?BINREL(ST, ET)) + end; + {_, _, true} -> + erlang:error(badarg) + end. + +-spec(is_a_function(BinRel) -> Bool when + Bool :: boolean(), + BinRel :: binary_relation()). +is_a_function(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, _) -> + case ?LIST(R) of + [] -> true; + [{V,_} | Es] -> is_a_func(Es, V) + end; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end. + +-spec(restriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +restriction(Relation, Set) -> + restriction(1, Relation, Set). + +-spec(drestriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +drestriction(Relation, Set) -> + drestriction(1, Relation, Set). + +%%% +%%% Functions on functions only. +%%% + +-spec(composite(Function1, Function2) -> Function3 when + Function1 :: a_function(), + Function2 :: a_function(), + Function3 :: a_function()). +composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) -> + ?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of + ?BINREL(_, _) = F1T -> F1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + ?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of + ?BINREL(_, _) = F2T -> F2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(RTF1, DTF2) of + true when DTF1 =:= ?ANYTYPE -> Fn1; + true when DTF2 =:= ?ANYTYPE -> Fn2; + true -> + case comp(?LIST(Fn1), ?LIST(Fn2)) of + SL when is_list(SL) -> + ?SET(sort(SL), ?BINREL(DTF1, RTF2)); + Bad -> + erlang:error(Bad) + end; + false -> erlang:error(type_mismatch) + end. + +-spec(inverse(Function1) -> Function2 when + Function1 :: a_function(), + Function2 :: a_function()). +inverse(Fn) when ?IS_SET(Fn) -> + case ?TYPE(Fn) of + ?BINREL(DT, RT) -> + case inverse1(?LIST(Fn)) of + SL when is_list(SL) -> + ?SET(SL, ?BINREL(RT, DT)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> Fn; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on relations (binary or other). +%%% + +-spec(restriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +%% Equivalent to range(restriction(inverse(substitution(Fun, S1)), S2)). +restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + R; + {true, []} -> + ?SET([], RT); + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(reverse(restrict_n(I, RL, E, Es, [])), RT); + {true, [E | Es]} -> + ?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S2; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + NL = sort(restrict(?LIST(S2), converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + ?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(drestriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, []} -> + R; + {true, _SL} when RL =:= [] -> + R; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(diff_restrict_n(I, RL, E, Es, []), RT); + {true, [E | Es]} -> + ?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S1; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + SL2 = ?LIST(S2), + NL = sort(diff_restrict(SL2, converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + SL2 = ?LIST(S2), + ?SET(sort(Sort, diff_restrict(SL2, R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(projection(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +projection(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _ when I =:= 1 -> + ?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type)); + _ -> + ?SET(projection_n(?LIST(Set), I, []), ?REL_TYPE(I, Type)) + end; +projection(Fun, Set) -> + range(substitution(Fun, Set)). + +-spec(substitution(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +substitution(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _Sort -> + NType = ?REL_TYPE(I, Type), + NSL = substitute_element(?LIST(Set), I, []), + ?SET(NSL, ?BINREL(Type, NType)) + end; +substitution(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + L = ?LIST(Set), + case external_fun(SetFun) of + false when L =/= [] -> + case subst(L, SetFun, element_type(Type)) of + {SL, NewType} -> + ?SET(reverse(SL), ?BINREL(Type, NewType)); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type), + try check_fun(Type, XFun, FunT) of + _Sort -> + SL = substitute(L, XFun, []), + ?SET(SL, ?BINREL(Type, FunT)) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(partition(SetOfSets) -> Partition when + SetOfSets :: set_of_sets(), + Partition :: a_set()). +partition(Sets) -> + F1 = relation_to_family(canonical_relation(Sets)), + F2 = relation_to_family(converse(F1)), + range(F2). + +-spec(partition(SetFun, Set) -> Partition when + SetFun :: set_fun(), + Partition :: a_set(), + Set :: a_set()). +partition(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % I =:= 1 + ?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type)); + true -> + ?SET(partition_n(I, keysort(I, ?LIST(Set))), ?SET_OF(Type)) + end; +partition(Fun, Set) -> + range(partition_family(Fun, Set)). + +-spec(partition(SetFun, Set1, Set2) -> {Set3, Set4} when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set()). +partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + {R, R}; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + {R, R}; + {true, []} -> + {?SET([], RT), R}; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + [L1 | L2] = partition3_n(I, RL, E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {true, [E | Es]} -> + [L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + {S2, S1}; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + R1 = converse(NSL, []), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + {S1, S1}; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(multiple_relative_product(TupleOfBinRels, BinRel1) -> BinRel2 when + TupleOfBinRels :: tuple_of(BinRel), + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) -> + case test_rel(R, tuple_size(T), eq) of + true when ?TYPE(R) =:= ?ANYTYPE -> + empty_set(); + true -> + MProd = mul_relprod(tuple_to_list(T), 1, R), + relative_product(MProd); + false -> + erlang:error(badarg) + end. + +-spec(join(Relation1, I, Relation2, J) -> Relation3 when + Relation1 :: relation(), + Relation2 :: relation(), + Relation3 :: relation(), + I :: pos_integer(), + J :: pos_integer()). +join(R1, I1, R2, I2) + when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) -> + case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of + false -> erlang:error(badarg); + true when ?TYPE(R1) =:= ?ANYTYPE -> R1; + true when ?TYPE(R2) =:= ?ANYTYPE -> R2; + true -> + L1 = ?LIST(raise_element(R1, I1)), + L2 = ?LIST(raise_element(R2, I2)), + T = relprod1(L1, L2), + F = case (I1 =:= 1) and (I2 =:= 1) of + true -> + fun({X,Y}) -> join_element(X, Y) end; + false -> + fun({X,Y}) -> + list_to_tuple(join_element(X, Y, I2)) + end + end, + ?SET(replace(T, F, []), F({?TYPE(R1), ?TYPE(R2)})) + end. + +%% Inlined. +test_rel(R, I, C) -> + case ?TYPE(R) of + Rel when ?IS_RELATION(Rel), C =:= eq, I =:= ?REL_ARITY(Rel) -> true; + Rel when ?IS_RELATION(Rel), C =:= lte, I>=1, I =< ?REL_ARITY(Rel) -> + true; + ?ANYTYPE -> true; + _ -> false + end. + +%%% +%%% Family functions +%%% + +-spec(fam2rel(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +fam2rel(F) -> + family_to_relation(F). + +-spec(family_to_relation(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +family_to_relation(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, RT) -> + ?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_specification(Fun, Family1) -> Family2 when + Fun :: spec_fun(), + Family1 :: family(), + Family2 :: family()). +family_specification(Fun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) = FType -> + R = case external_fun(Fun) of + false -> + fam_spec(?LIST(F), Fun, Type, []); + XFun -> + fam_specification(?LIST(F), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, FType); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(union_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +union_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + ?SET(un_of_fam(?LIST(F), []), Type); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(intersection_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +intersection_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + case int_of_fam(?LIST(F)) of + FU when is_list(FU) -> + ?SET(FU, Type); + Bad -> + erlang:error(Bad) + end; + _ -> erlang:error(badarg) + end. + +-spec(family_union(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_union(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + ?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_intersection(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_intersection(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + case fam_int(?LIST(F), []) of + FU when is_list(FU) -> + ?SET(FU, ?FAMILY(DT, Type)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_domain(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_domain(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(FDT, ?BINREL(DT, _)) -> + ?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_range(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_range(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?BINREL(_, RT)) -> + ?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_field(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_field(F) -> + family_union(family_domain(F), family_range(F)). + +-spec(family_union(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_union(F1, F2) -> + fam_binop(F1, F2, fun fam_union/3). + +-spec(family_intersection(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_intersection(F1, F2) -> + fam_binop(F1, F2, fun fam_intersect/3). + +-spec(family_difference(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_difference(F1, F2) -> + fam_binop(F1, F2, fun fam_difference/3). + +%% Inlined. +fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) -> + case unify_types(?TYPE(F1), ?TYPE(F2)) of + [] -> + erlang:error(type_mismatch); + ?ANYTYPE -> + F1; + Type = ?FAMILY(_, _) -> + ?SET(FF(?LIST(F1), ?LIST(F2), []), Type); + _ -> erlang:error(badarg) + end. + +-spec(partition_family(SetFun, Set) -> Family when + Family :: family(), + SetFun :: set_fun(), + Set :: a_set()). +partition_family(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % when I =:= 1 + ?SET(fam_partition_n(I, ?LIST(Set)), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))); + true -> + ?SET(fam_partition_n(I, keysort(I, ?LIST(Set))), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))) + end; +partition_family(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + SL = ?LIST(Set), + case external_fun(SetFun) of + false when SL =/= [] -> + case subst(SL, SetFun, element_type(Type)) of + {NSL, NewType} -> + P = fam_partition(converse(NSL, []), true), + ?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type))); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + DType = XFun(Type), + try check_fun(Type, XFun, DType) of + Sort -> + Ts = inverse_substitution(?LIST(Set), XFun, Sort), + P = fam_partition(Ts, Sort), + ?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type))) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(family_projection(SetFun, Family1) -> Family2 when + SetFun :: set_fun(), + Family1 :: family(), + Family2 :: family()). +family_projection(SetFun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) when [] =:= ?LIST(F) -> + empty_set(); + ?FAMILY(DT, Type) -> + case external_fun(SetFun) of + false -> + case fam_proj(?LIST(F), SetFun, Type, ?ANYTYPE, []) of + {SL, NewType} -> + ?SET(SL, ?BINREL(DT, NewType)); + Bad -> + erlang:error(Bad) + end; + _ -> + erlang:error(badarg) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +%%% +%%% Digraph functions +%%% + +-spec(family_to_digraph(Family) -> Graph when + Graph :: digraph:graph(), + Family :: family()). +family_to_digraph(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> fam2digraph(F, digraph:new()); + ?ANYTYPE -> digraph:new(); + _Else -> erlang:error(badarg) + end. + +-spec(family_to_digraph(Family, GraphType) -> Graph when + Graph :: digraph:graph(), + Family :: family(), + GraphType :: [digraph:d_type()]). +family_to_digraph(F, Type) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> ok; + ?ANYTYPE -> ok; + _Else -> erlang:error(badarg) + end, + try digraph:new(Type) of + G -> case catch fam2digraph(F, G) of + {error, Reason} -> + true = digraph:delete(G), + erlang:error(Reason); + _ -> + G + end + catch + error:badarg -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph) -> Family when + Graph :: digraph:graph(), + Family :: family()). +digraph_to_family(G) -> + try digraph_family(G) of + L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) + catch _:_ -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph, Type) -> Family when + Graph :: digraph:graph(), + Family :: family(), + Type :: type()). +digraph_to_family(G, T) -> + case {is_type(T), T} of + {true, ?SET_OF(?FAMILY(_,_) = Type)} -> + try digraph_family(G) of + L -> ?SET(L, Type) + catch _:_ -> erlang:error(badarg) + end; + _ -> + erlang:error(badarg) + end. + +%% +%% Local functions +%% + +%% Type = OrderedSetType +%% | SetType +%% | atom() except '_' +%% OrderedSetType = {Type, ..., Type} +%% SetType = [ElementType] % list of exactly one element +%% ElementType = '_' % any type (implies empty set) +%% | Type + +is_types(0, _T) -> + true; +is_types(I, T) -> + case is_type(?REL_TYPE(I, T)) of + true -> is_types(I-1, T); + false -> false + end. + +is_element_type(?ANYTYPE) -> + true; +is_element_type(T) -> + is_type(T). + +set_of_sets([S | Ss], L, T0) when ?IS_SET(S) -> + case unify_types([?TYPE(S)], T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?LIST(S) | L], Type) + end; +set_of_sets([S | Ss], L, T0) when ?IS_ORDSET(S) -> + case unify_types(?ORDTYPE(S), T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?ORDDATA(S) | L], Type) + end; +set_of_sets([], L, T) -> + ?SET(usort(L), T); +set_of_sets(_, _L, _T) -> + {error, badarg}. + +ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) -> + ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]); +ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) -> + ordset_of_sets(Ss, [?ORDDATA(S) | L], [?ORDTYPE(S) | T]); +ordset_of_sets([], L, T) -> + ?ORDSET(list_to_tuple(reverse(L)), list_to_tuple(reverse(T))); +ordset_of_sets(_, _L, _T) -> + error. + +%% Inlined. +rel(Ts, [Type]) -> + case is_type(Type) and atoms_only(Type, 1) of + true -> + rel(Ts, tuple_size(Type), Type); + false -> + rel_type(Ts, [], Type) + end; +rel(Ts, Sz) -> + rel(Ts, Sz, erlang:make_tuple(Sz, ?ATOM_TYPE)). + +atoms_only(Type, I) when ?IS_ATOM_TYPE(?REL_TYPE(I, Type)) -> + atoms_only(Type, I+1); +atoms_only(Type, I) when I > tuple_size(Type), ?IS_RELATION(Type) -> + true; +atoms_only(_Type, _I) -> + false. + +rel(Ts, Sz, Type) when Sz >= 1 -> + SL = usort(Ts), + rel(SL, SL, Sz, Type). + +rel([T | Ts], L, Sz, Type) when tuple_size(T) =:= Sz -> + rel(Ts, L, Sz, Type); +rel([], L, _Sz, Type) -> + ?SET(L, Type). + +rel_type([E | Ts], L, Type) -> + {NType, NE} = make_element(E, Type, Type), + rel_type(Ts, [NE | L], NType); +rel_type([], [], ?ANYTYPE) -> + empty_set(); +rel_type([], SL, Type) when ?IS_RELATION(Type) -> + ?SET(usort(SL), Type). + +%% Inlined. +a_func(Ts, T) -> + case {T, is_type(T)} of + {[?BINREL(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + func(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?BINREL(_,_)) -> true end) + end. + +func(L0, Type) -> + L = usort(L0), + func(L, L, L, Type). + +func([{X,_} | Ts], X0, L, Type) when X /= X0 -> + func(Ts, X, L, Type); +func([{X,_} | _Ts], X0, _L, _Type) when X == X0 -> + bad_function; +func([], _X0, L, Type) -> + ?SET(L, Type). + +%% Inlined. +fam(Ts, T) -> + case {T, is_type(T)} of + {[?FAMILY(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + fam2(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?FAMILY(_,_)) -> true end) + end. + +fam2([], Type) -> + ?SET([], Type); +fam2(Ts, Type) -> + fam2(sort(Ts), Ts, [], Type). + +fam2([{I,L} | T], I0, SL, Type) when I /= I0 -> + fam2(T, I, [{I,usort(L)} | SL], Type); +fam2([{I,L} | T], I0, SL, Type) when I == I0 -> + case {usort(L), SL} of + {NL, [{_I,NL1} | _]} when NL == NL1 -> + fam2(T, I0, SL, Type); + _ -> + bad_function + end; +fam2([], _I0, SL, Type) -> + ?SET(reverse(SL), Type). + +func_type([E | T], SL, Type, F) -> + {NType, NE} = make_element(E, Type, Type), + func_type(T, [NE | SL], NType, F); +func_type([], [], ?ANYTYPE, _F) -> + empty_set(); +func_type([], SL, Type, F) -> + true = F(Type), + NL = usort(SL), + check_function(NL, ?SET(NL, Type)). + +setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + ?SET(usort(L), Atom); +setify(L, ?SET_OF(Type0)) -> + try is_no_lists(Type0) of + N when is_integer(N) -> + rel(L, N, Type0); + Sizes -> + make_oset(L, Sizes, L, Type0) + catch + _:_ -> + {?SET_OF(Type), Set} = create(L, Type0, Type0, []), + ?SET(Set, Type) + end; +setify(E, Type0) -> + {Type, OrdSet} = make_element(E, Type0, Type0), + ?ORDSET(OrdSet, Type). + +is_no_lists(T) when is_tuple(T) -> + Sz = tuple_size(T), + is_no_lists(T, Sz, Sz, []). + +is_no_lists(_T, 0, Sz, []) -> + Sz; +is_no_lists(_T, 0, Sz, L) -> + {Sz, L}; +is_no_lists(T, I, Sz, L) when ?IS_ATOM_TYPE(?REL_TYPE(I, T)) -> + is_no_lists(T, I-1, Sz, L); +is_no_lists(T, I, Sz, L) -> + is_no_lists(T, I-1, Sz, [{I,is_no_lists(?REL_TYPE(I, T))} | L]). + +create([E | Es], T, T0, L) -> + {NT, S} = make_element(E, T, T0), + create(Es, NT, T0, [S | L]); +create([], T, _T0, L) -> + {?SET_OF(T), usort(L)}. + +make_element(C, ?ANYTYPE, _T0) -> + make_element(C); +make_element(C, Atom, ?ANYTYPE) when ?IS_ATOM_TYPE(Atom), + not is_list(C), not is_tuple(C) -> + {Atom, C}; +make_element(C, Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + {Atom, C}; +make_element(T, TT, ?ANYTYPE) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], ?ANYTYPE); +make_element(T, TT, T0) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], tuple_to_list(T0)); +make_element(L, [LT], ?ANYTYPE) when is_list(L) -> + create(L, LT, ?ANYTYPE, []); +make_element(L, [LT], [T0]) when is_list(L) -> + create(L, LT, T0, []). + +make_tuple([E | Es], [T | Ts], NT, L, T0) when T0 =:= ?ANYTYPE -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0); +make_tuple([E | Es], [T | Ts], NT, L, [T0 | T0s]) -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0s); +make_tuple([], [], NT, L, _T0s) when NT =/= [] -> + {list_to_tuple(reverse(NT)), list_to_tuple(reverse(L))}. + +%% Derive type. +make_element(C) when not is_list(C), not is_tuple(C) -> + {?ATOM_TYPE, C}; +make_element(T) when is_tuple(T) -> + make_tuple(tuple_to_list(T), [], []); +make_element(L) when is_list(L) -> + create(L, ?ANYTYPE, ?ANYTYPE, []). + +make_tuple([E | Es], T, L) -> + {ET, ES} = make_element(E), + make_tuple(Es, [ET | T], [ES | L]); +make_tuple([], T, L) when T =/= [] -> + {list_to_tuple(reverse(T)), list_to_tuple(reverse(L))}. + +make_oset([T | Ts], Szs, L, Type) -> + true = test_oset(Szs, T, T), + make_oset(Ts, Szs, L, Type); +make_oset([], _Szs, L, Type) -> + ?SET(usort(L), Type). + +%% Optimization. Avoid re-building (nested) tuples. +test_oset({Sz,Args}, T, T0) when tuple_size(T) =:= Sz -> + test_oset_args(Args, T, T0); +test_oset(Sz, T, _T0) when tuple_size(T) =:= Sz -> + true. + +test_oset_args([{Arg,Szs} | Ss], T, T0) -> + true = test_oset(Szs, ?REL_TYPE(Arg, T), T0), + test_oset_args(Ss, T, T0); +test_oset_args([], _T, _T0) -> + true. + +list_of_sets([S | Ss], Type, L) -> + list_of_sets(Ss, Type, [?SET(S, Type) | L]); +list_of_sets([], _Type, L) -> + reverse(L). + +list_of_ordsets([S | Ss], Type, L) -> + list_of_ordsets(Ss, Type, [?ORDSET(S, Type) | L]); +list_of_ordsets([], _Type, L) -> + reverse(L). + +tuple_of_sets([S | Ss], [?SET_OF(Type) | Types], L) -> + tuple_of_sets(Ss, Types, [?SET(S, Type) | L]); +tuple_of_sets([S | Ss], [Type | Types], L) -> + tuple_of_sets(Ss, Types, [?ORDSET(S, Type) | L]); +tuple_of_sets([], [], L) -> + list_to_tuple(reverse(L)). + +spec([E | Es], Fun, Type, L) -> + case Fun(term2set(E, Type)) of + true -> + spec(Es, Fun, Type, [E | L]); + false -> + spec(Es, Fun, Type, L); + _ -> + badarg + end; +spec([], _Fun, _Type, L) -> + reverse(L). + +specification([E | Es], Fun, L) -> + case Fun(E) of + true -> + specification(Es, Fun, [E | L]); + false -> + specification(Es, Fun, L); + _ -> + badarg + end; +specification([], _Fun, L) -> + reverse(L). + +%% Elements from the first list are kept. +intersection([H1 | T1], [H2 | T2], L) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection([H1 | T1], [H2 | T2], L) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection([H1 | T1], [_H2 | T2], L) -> + intersection2(T1, T2, L, H1); +intersection(_, _, L) -> + reverse(L). + +intersection1([H1 | T1], T2, L, H2) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection1([H1 | T1], T2, L, H2) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection1([H1 | T1], T2, L, _H2) -> + intersection2(T1, T2, L, H1); +intersection1(_, _, L, _) -> + reverse(L). + +intersection2(T1, [H2 | T2], L, H1) when H1 > H2 -> + intersection2(T1, T2, L, H1); +intersection2(T1, [H2 | T2], L, H1) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection2(T1, [H2 | T2], L, _H1) -> + intersection1(T1, T2, L, H2); +intersection2(_, _, L, _) -> + reverse(L). + +difference([H1 | T1], [H2 | T2], L) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +difference([H1 | T1], [H2 | T2], L) when H1 == H2 -> + difference(T1, T2, L); +difference([H1 | T1], [_H2 | T2], L) -> + diff2(T1, T2, L, H1); +difference(L1, _, L) -> + reverse(L, L1). + +diff([H1 | T1], T2, L, H2) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +diff([H1 | T1], T2, L, H2) when H1 == H2 -> + difference(T1, T2, L); +diff([H1 | T1], T2, L, _H2) -> + diff2(T1, T2, L, H1); +diff(_, _, L, _) -> + reverse(L). + +diff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + diff2(T1, T2, L, H1); +diff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + difference(T1, T2, L); +diff2(T1, [H2 | T2], L, H1) -> + diff(T1, T2, [H1 | L], H2); +diff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +symdiff([H1 | T1], T2, L) -> + symdiff2(T1, T2, L, H1); +symdiff(_, T2, L) -> + reverse(L, T2). + +symdiff1([H1 | T1], T2, L, H2) when H1 < H2 -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff1([H1 | T1], T2, L, H2) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff1([H1 | T1], T2, L, H2) -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff1(_, T2, L, H2) -> + reverse(L, [H2 | T2]). + +symdiff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff2(T1, [H2 | T2], L, H1) -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart(S1, [], L1, L12, L2, T) -> + {?SET(reverse(L1, S1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}; +sympart(_, S2, L1, L12, L2, T) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, S2), T)}. + +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart1(_, T2, L1, L12, L2, T, H2) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, [H2 | T2]), T)}. + +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 > H2 -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart2(T1, _, L1, L12, L2, T, H1) -> + {?SET(reverse(L1, [H1 | T1]), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}. + +prod([[E | Es] | Xs], T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], T, L) -> + [list_to_tuple(reverse(T)) | L]. + +prod([E | Es], Xs, T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], _Xs, _E, L) -> + L. + +constant_function([E | Es], X, L) -> + constant_function(Es, X, [{E,X} | L]); +constant_function([], _X, L) -> + reverse(L). + +subset([H1 | T1], [H2 | T2]) when H1 > H2 -> + subset(T1, T2, H1); +subset([H1 | T1], [H2 | T2]) when H1 == H2 -> + subset(T1, T2); +subset(L1, _) -> + L1 =:= []. + +subset(T1, [H2 | T2], H1) when H1 > H2 -> + subset(T1, T2, H1); +subset(T1, [H2 | T2], H1) when H1 == H2 -> + subset(T1, T2); +subset(_, _, _) -> + false. + +disjoint([B | Bs], A, As) when A < B -> + disjoint(As, B, Bs); +disjoint([B | _Bs], A, _As) when A == B -> + false; +disjoint([_B | Bs], A, As) -> + disjoint(Bs, A, As); +disjoint(_Bs, _A, _As) -> + true. + +%% Append sets that come in order, then "merge". +lunion([[_] = S]) -> % optimization + S; +lunion([[] | Ls]) -> + lunion(Ls); +lunion([S | Ss]) -> + umerge(lunion(Ss, last(S), [S], [])); +lunion([]) -> + []. + +lunion([[E] = S | Ss], Last, SL, Ls) when E > Last -> % optimization + lunion(Ss, E, [S | SL], Ls); +lunion([S | Ss], Last, SL, Ls) when hd(S) > Last -> + lunion(Ss, last(S), [S | SL], Ls); +lunion([S | Ss], _Last, SL, Ls) -> + lunion(Ss, last(S), [S], [append(reverse(SL)) | Ls]); +lunion([], _Last, SL, Ls) -> + [append(reverse(SL)) | Ls]. + +%% The empty list is always the first list, if present. +lintersection(_, []) -> + []; +lintersection([S | Ss], S0) -> + lintersection(Ss, intersection(S, S0, [])); +lintersection([], S) -> + S. + +can_rel([S | Ss], L) -> + can_rel(Ss, L, S, S); +can_rel([], L) -> + sort(L). + +can_rel(Ss, L, [E | Es], S) -> + can_rel(Ss, [{E, S} | L], Es, S); +can_rel(Ss, L, _, _S) -> + can_rel(Ss, L). + +rel2family([{X,Y} | S]) -> + rel2fam(S, X, [Y], []); +rel2family([]) -> + []. + +rel2fam([{X,Y} | S], X0, YL, L) when X0 == X -> + rel2fam(S, X0, [Y | YL], L); +rel2fam([{X,Y} | S], X0, [A,B | YL], L) -> % optimization + rel2fam(S, X, [Y], [{X0,reverse(YL,[B,A])} | L]); +rel2fam([{X,Y} | S], X0, YL, L) -> + rel2fam(S, X, [Y], [{X0,YL} | L]); +rel2fam([], X, YL, L) -> + reverse([{X,reverse(YL)} | L]). + +dom([{X,_} | Es]) -> + dom([], X, Es); +dom([] = L) -> + L. + +dom(L, X, [{X1,_} | Es]) when X == X1 -> + dom(L, X, Es); +dom(L, X, [{Y,_} | Es]) -> + dom([X | L], Y, Es); +dom(L, X, []) -> + reverse(L, [X]). + +ran([{_,Y} | Es], L) -> + ran(Es, [Y | L]); +ran([], L) -> + usort(L). + +relprod(A, B) -> + usort(relprod1(A, B)). + +relprod1([{Ay,Ax} | A], B) -> + relprod1(B, Ay, Ax, A, []); +relprod1(_A, _B) -> + []. + +relprod1([{Bx,_By} | B], Ay, Ax, A, L) when Ay > Bx -> + relprod1(B, Ay, Ax, A, L); +relprod1([{Bx,By} | B], Ay, Ax, A, L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod1([{Bx,By} | B], _Ay, _Ax, A, L) -> + relprod2(B, Bx, By, A, L); +relprod1(_B, _Ay, _Ax, _A, L) -> + L. + +relprod2(B, Bx, By, [{Ay, _Ax} | A], L) when Ay < Bx -> + relprod2(B, Bx, By, A, L); +relprod2(B, Bx, By, [{Ay, Ax} | A], L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod2(B, _Bx, _By, [{Ay, Ax} | A], L) -> + relprod1(B, Ay, Ax, A, L); +relprod2(_, _, _, _, L) -> + L. + +relprod(B0, Bx0, By0, A0, L, Ax, [{Bx,By} | B], Ay) when Ay == Bx -> + relprod(B0, Bx0, By0, A0, [{Ax,By} | L], Ax, B, Ay); +relprod(B0, Bx0, By0, A0, L, _Ax, _B, _Ay) -> + relprod2(B0, Bx0, By0, A0, L). + +relprod_n([], _R, _EmptyG, _IsR) -> + {error, badarg}; +relprod_n(RL, R, EmptyR, IsR) -> + case domain_type(RL, ?ANYTYPE) of + Error = {error, _Reason} -> + Error; + DType -> + Empty = any(fun is_empty_set/1, RL) or EmptyR, + RType = range_type(RL, []), + Type = ?BINREL(DType, RType), + Prod = + case Empty of + true when DType =:= ?ANYTYPE; RType =:= ?ANYTYPE -> + empty_set(); + true -> + ?SET([], Type); + false -> + TL = ?LIST((relprod_n(RL))), + Sz = length(RL), + Fun = fun({X,A}) -> {X, flat(Sz, A, [])} end, + ?SET(map(Fun, TL), Type) + end, + case IsR of + true -> relative_product(Prod, R); + false -> Prod + end + end. + +relprod_n([R | Rs]) -> + relprod_n(Rs, R). + +relprod_n([], R) -> + R; +relprod_n([R | Rs], R0) -> + T = raise_element(R0, 1), + R1 = relative_product1(T, R), + NR = projection({external, fun({{X,A},AS}) -> {X,{A,AS}} end}, R1), + relprod_n(Rs, NR). + +flat(1, A, L) -> + list_to_tuple([A | L]); +flat(N, {T,A}, L) -> + flat(N-1, T, [A | L]). + +domain_type([T | Ts], T0) when ?IS_SET(T) -> + case ?TYPE(T) of + ?BINREL(DT, _RT) -> + case unify_types(DT, T0) of + [] -> {error, type_mismatch}; + T1 -> domain_type(Ts, T1) + end; + ?ANYTYPE -> + domain_type(Ts, T0); + _ -> {error, badarg} + end; +domain_type([], T0) -> + T0. + +range_type([T | Ts], L) -> + case ?TYPE(T) of + ?BINREL(_DT, RT) -> + range_type(Ts, [RT | L]); + ?ANYTYPE -> + ?ANYTYPE + end; +range_type([], L) -> + list_to_tuple(reverse(L)). + +converse([{A,B} | X], L) -> + converse(X, [{B,A} | L]); +converse([], L) -> + sort(L). + +strict([{E1,E2} | Es], L) when E1 == E2 -> + strict(Es, L); +strict([E | Es], L) -> + strict(Es, [E | L]); +strict([], L) -> + reverse(L). + +weak(Es) -> + %% Not very efficient... + weak(Es, ran(Es, []), []). + +weak(Es=[{X,_} | _], [Y | Ys], L) when X > Y -> + weak(Es, Ys, [{Y,Y} | L]); +weak(Es=[{X,_} | _], [Y | Ys], L) when X == Y -> + weak(Es, Ys, L); +weak([E={X,Y} | Es], Ys, L) when X > Y -> + weak1(Es, Ys, [E | L], X); +weak([E={X,Y} | Es], Ys, L) when X == Y -> + weak2(Es, Ys, [E | L], X); +weak([E={X,_Y} | Es], Ys, L) -> % when X < _Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak([], [Y | Ys], L) -> + weak([], Ys, [{Y,Y} | L]); +weak([], [], L) -> + reverse(L). + +weak1([E={X,Y} | Es], Ys, L, X0) when X > Y, X == X0 -> + weak1(Es, Ys, [E | L], X); +weak1([E={X,Y} | Es], Ys, L, X0) when X == Y, X == X0 -> + weak2(Es, Ys, [E | L], X); +weak1([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak1(Es, Ys, L, X) -> + weak(Es, Ys, [{X,X} | L]). + +weak2([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < _Y + weak2(Es, Ys, [E | L], X); +weak2(Es, Ys, L, _X) -> + weak(Es, Ys, L). + +extc(L, [D | Ds], C, Ts) -> + extc(L, Ds, C, Ts, D); +extc(L, [], _C, _Ts) -> + L. + +extc(L, Ds, C, [{X,_Y} | Ts], D) when X < D -> + extc(L, Ds, C, Ts, D); +extc(L, Ds, C, [{X,_Y} | Ts], D) when X == D -> + extc(L, Ds, C, Ts); +extc(L, Ds, C, [{X,_Y} | Ts], D) -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc(L, Ds, C, [], D) -> + extc_tail([{D,C} | L], Ds, C). + +extc2(L, [D | Ds], C, Ts, X) when X > D -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc2(L, [D | Ds], C, Ts, X) when X == D -> + extc(L, Ds, C, Ts); +extc2(L, [D | Ds], C, Ts, _X) -> + extc(L, Ds, C, Ts, D); +extc2(L, [], _C, _Ts, _X) -> + L. + +extc_tail(L, [D | Ds], C) -> + extc_tail([{D,C} | L], Ds, C); +extc_tail(L, [], _C) -> + L. + +is_a_func([{E,_} | Es], E0) when E /= E0 -> + is_a_func(Es, E); +is_a_func(L, _E) -> + L =:= []. + +restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + restrict_n(I, Ts, Key, Keys, L); + K when K == Key -> + restrict_n(I, Ts, Key, Keys, [T | L]); + K -> + restrict_n(I, K, Ts, Keys, L, T) + end; +restrict_n(_I, _Ts, _Key, _Keys, L) -> + L. + +restrict_n(I, K, Ts, [Key | Keys], L, E) when K > Key -> + restrict_n(I, K, Ts, Keys, L, E); +restrict_n(I, K, Ts, [Key | Keys], L, E) when K == Key -> + restrict_n(I, Ts, Key, Keys, [E | L]); +restrict_n(I, _K, Ts, [Key | Keys], L, _E) -> + restrict_n(I, Ts, Key, Keys, L); +restrict_n(_I, _K, _Ts, _Keys, L, _E) -> + L. + +restrict([Key | Keys], Tuples) -> + restrict(Tuples, Key, Keys, []); +restrict(_Keys, _Tuples) -> + []. + +restrict([{K,_E} | Ts], Key, Keys, L) when K < Key -> + restrict(Ts, Key, Keys, L); +restrict([{K,E} | Ts], Key, Keys, L) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict([{K,E} | Ts], _Key, Keys, L) -> + restrict(Ts, K, Keys, L, E); +restrict(_Ts, _Key, _Keys, L) -> + L. + +restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + restrict(Ts, K, Keys, L, E); +restrict(Ts, K, [Key | Keys], L, E) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict(Ts, _K, [Key | Keys], L, _E) -> + restrict(Ts, Key, Keys, L); +restrict(_Ts, _K, _Keys, L, _E) -> + L. + +diff_restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); + K when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); + K -> + diff_restrict_n(I, K, Ts, Keys, L, T) + end; +diff_restrict_n(I, _Ts, _Key, _Keys, L) when I =:= 1 -> + reverse(L); +diff_restrict_n(_I, _Ts, _Key, _Keys, L) -> + sort(L). + +diff_restrict_n(I, K, Ts, [Key | Keys], L, T) when K > Key -> + diff_restrict_n(I, K, Ts, Keys, L, T); +diff_restrict_n(I, K, Ts, [Key | Keys], L, _T) when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); +diff_restrict_n(I, _K, Ts, [Key | Keys], L, T) -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); +diff_restrict_n(I, _K, Ts, _Keys, L, T) when I =:= 1 -> + reverse(L, [T | Ts]); +diff_restrict_n(_I, _K, Ts, _Keys, L, T) -> + sort([T | Ts ++ L]). + +diff_restrict([Key | Keys], Tuples) -> + diff_restrict(Tuples, Key, Keys, []); +diff_restrict(_Keys, Tuples) -> + diff_restrict_tail(Tuples, []). + +diff_restrict([{K,E} | Ts], Key, Keys, L) when K < Key -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict([{K,_E} | Ts], Key, Keys, L) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict([{K,E} | Ts], _Key, Keys, L) -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(_Ts, _Key, _Keys, L) -> + L. + +diff_restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(Ts, K, [Key | Keys], L, _E) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict(Ts, _K, [Key | Keys], L, E) -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict(Ts, _K, _Keys, L, E) -> + diff_restrict_tail(Ts, [E | L]). + +diff_restrict_tail([{_K,E} | Ts], L) -> + diff_restrict_tail(Ts, [E | L]); +diff_restrict_tail(_Ts, L) -> + L. + +comp([], B) -> + check_function(B, []); +comp(_A, []) -> + bad_function; +comp(A0, [{Bx,By} | B]) -> + A = converse(A0, []), + check_function(A0, comp1(A, B, [], Bx, By)). + +comp1([{Ay,Ax} | A], B, L, Bx, By) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp1([{Ay,Ax} | A], B, L, Bx, _By) when Ay > Bx -> + comp2(A, B, L, Bx, Ay, Ax); +comp1([{Ay,_Ax} | _A], _B, _L, Bx, _By) when Ay < Bx -> + bad_function; +comp1([], B, L, Bx, _By) -> + check_function(Bx, B, L). + +comp2(A, [{Bx,_By} | B], L, Bx0, Ay, Ax) when Ay > Bx, Bx /= Bx0 -> + comp2(A, B, L, Bx, Ay, Ax); +comp2(A, [{Bx,By} | B], L, _Bx0, Ay, Ax) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp2(_A, _B, _L, _Bx0, _Ay, _Ax) -> + bad_function. + +inverse1([{A,B} | X]) -> + inverse(X, A, [{B,A}]); +inverse1([]) -> + []. + +inverse([{A,B} | X], A0, L) when A0 /= A -> + inverse(X, A, [{B,A} | L]); +inverse([{A,_B} | _X], A0, _L) when A0 == A -> + bad_function; +inverse([], _A0, L) -> + SL = [{V,_} | Es] = sort(L), + case is_a_func(Es, V) of + true -> SL; + false -> bad_function + end. + +%% Inlined. +external_fun({external, Function}) when is_atom(Function) -> + false; +external_fun({external, Fun}) -> + Fun; +external_fun(_) -> + false. + +%% Inlined. +element_type(?SET_OF(Type)) -> Type; +element_type(Type) -> Type. + +subst(Ts, Fun, Type) -> + subst(Ts, Fun, Type, ?ANYTYPE, []). + +subst([T | Ts], Fun, Type, NType, L) -> + case setfun(T, Fun, Type, NType) of + {SD, ST} -> subst(Ts, Fun, Type, ST, [{T, SD} | L]); + Bad -> Bad + end; +subst([], _Fun, _Type, NType, L) -> + {L, NType}. + +projection1([E | Es]) -> + projection1([], element(1, E), Es); +projection1([] = L) -> + L. + +projection1(L, X, [E | Es]) -> + case element(1, E) of + X1 when X == X1 -> projection1(L, X, Es); + X1 -> projection1([X | L], X1, Es) + end; +projection1(L, X, []) -> + reverse(L, [X]). + +projection_n([E | Es], I, L) -> + projection_n(Es, I, [element(I, E) | L]); +projection_n([], _I, L) -> + usort(L). + +substitute_element([T | Ts], I, L) -> + substitute_element(Ts, I, [{T, element(I, T)} | L]); +substitute_element(_, _I, L) -> + reverse(L). + +substitute([T | Ts], Fun, L) -> + substitute(Ts, Fun, [{T, Fun(T)} | L]); +substitute(_, _Fun, L) -> + reverse(L). + +partition_n(I, [E | Ts]) -> + partition_n(I, Ts, element(I, E), [E], []); +partition_n(_I, []) -> + []. + +partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + partition_n(I, Ts, K1, [E], [Es | P]); + {K1, _} -> + partition_n(I, Ts, K1, [E], [reverse(Es) | P]) + end; +partition_n(I, [], _K, Es, P) when I > 1 -> + sort([reverse(Es) | P]); +partition_n(_I, [], _K, [_] = Es, P) -> % optimization + reverse(P, [Es]); +partition_n(_I, [], _K, Es, P) -> + reverse(P, [reverse(Es)]). + +partition3_n(I, [T | Ts], Key, Keys, L1, L2) -> + case element(I, T) of + K when K < Key -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); + K when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); + K -> + partition3_n(I, K, Ts, Keys, L1, L2, T) + end; +partition3_n(I, _Ts, _Key, _Keys, L1, L2) when I =:= 1 -> + [reverse(L1) | reverse(L2)]; +partition3_n(_I, _Ts, _Key, _Keys, L1, L2) -> + [sort(L1) | sort(L2)]. + +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K > Key -> + partition3_n(I, K, Ts, Keys, L1, L2, T); +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); +partition3_n(I, _K, Ts, [Key | Keys], L1, L2, T) -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); +partition3_n(I, _K, Ts, _Keys, L1, L2, T) when I =:= 1 -> + [reverse(L1) | reverse(L2, [T | Ts])]; +partition3_n(_I, _K, Ts, _Keys, L1, L2, T) -> + [sort(L1) | sort([T | Ts ++ L2])]. + +partition3([Key | Keys], Tuples) -> + partition3(Tuples, Key, Keys, [], []); +partition3(_Keys, Tuples) -> + partition3_tail(Tuples, [], []). + +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K < Key -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3([{K,E} | Ts], _Key, Keys, L1, L2) -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(_Ts, _Key, _Keys, L1, L2) -> + [L1 | L2]. + +partition3(Ts, K, [Key | Keys], L1, L2, E) when K > Key -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(Ts, K, [Key | Keys], L1, L2, E) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3(Ts, _K, [Key | Keys], L1, L2, E) -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3(Ts, _K, _Keys, L1, L2, E) -> + partition3_tail(Ts, L1, [E | L2]). + +partition3_tail([{_K,E} | Ts], L1, L2) -> + partition3_tail(Ts, L1, [E | L2]); +partition3_tail(_Ts, L1, L2) -> + [L1 | L2]. + +replace([E | Es], F, L) -> + replace(Es, F, [F(E) | L]); +replace(_, _F, L) -> + sort(L). + +mul_relprod([T | Ts], I, R) when ?IS_SET(T) -> + P = raise_element(R, I), + F = relative_product1(P, T), + [F | mul_relprod(Ts, I+1, R)]; +mul_relprod([], _I, _R) -> + []. + +raise_element(R, I) -> + L = sort(I =/= 1, rearr(?LIST(R), I, [])), + Type = ?TYPE(R), + ?SET(L, ?BINREL(?REL_TYPE(I, Type), Type)). + +rearr([E | Es], I, L) -> + rearr(Es, I, [{element(I, E), E} | L]); +rearr([], _I, L) -> + L. + +join_element(E1, E2) -> + [_ | L2] = tuple_to_list(E2), + list_to_tuple(tuple_to_list(E1) ++ L2). + +join_element(E1, E2, I2) -> + tuple_to_list(E1) ++ join_element2(tuple_to_list(E2), 1, I2). + +join_element2([B | Bs], C, I2) when C =/= I2 -> + [B | join_element2(Bs, C+1, I2)]; +join_element2([_ | Bs], _C, _I2) -> + Bs. + +family2rel([{X,S} | F], L) -> + fam2rel(F, L, X, S); +family2rel([], L) -> + reverse(L). + +fam2rel(F, L, X, [Y | Ys]) -> + fam2rel(F, [{X,Y} | L], X, Ys); +fam2rel(F, L, _X, _) -> + family2rel(F, L). + +fam_spec([{_,S}=E | F], Fun, Type, L) -> + case Fun(?SET(S, Type)) of + true -> + fam_spec(F, Fun, Type, [E | L]); + false -> + fam_spec(F, Fun, Type, L); + _ -> + badarg + end; +fam_spec([], _Fun, _Type, L) -> + reverse(L). + +fam_specification([{_,S}=E | F], Fun, L) -> + case Fun(S) of + true -> + fam_specification(F, Fun, [E | L]); + false -> + fam_specification(F, Fun, L); + _ -> + badarg + end; +fam_specification([], _Fun, L) -> + reverse(L). + +un_of_fam([{_X,S} | F], L) -> + un_of_fam(F, [S | L]); +un_of_fam([], L) -> + lunion(sort(L)). + +int_of_fam([{_,S} | F]) -> + int_of_fam(F, [S]); +int_of_fam([]) -> + badarg. + +int_of_fam([{_,S} | F], L) -> + int_of_fam(F, [S | L]); +int_of_fam([], [L | Ls]) -> + lintersection(Ls, L). + +fam_un([{X,S} | F], L) -> + fam_un(F, [{X, lunion(S)} | L]); +fam_un([], L) -> + reverse(L). + +fam_int([{X, [S | Ss]} | F], L) -> + fam_int(F, [{X, lintersection(Ss, S)} | L]); +fam_int([{_X,[]} | _F], _L) -> + badarg; +fam_int([], L) -> + reverse(L). + +fam_dom([{X,S} | F], L) -> + fam_dom(F, [{X, dom(S)} | L]); +fam_dom([], L) -> + reverse(L). + +fam_ran([{X,S} | F], L) -> + fam_ran(F, [{X, ran(S, [])} | L]); +fam_ran([], L) -> + reverse(L). + +fam_union(F1 = [{A,_AS} | _AL], [B1={B,_BS} | BL], L) when A > B -> + fam_union(F1, BL, [B1 | L]); +fam_union([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_union(AL, BL, [{A, umerge(AS, BS)} | L]); +fam_union([A1 | AL], F2, L) -> + fam_union(AL, F2, [A1 | L]); +fam_union(_, F2, L) -> + reverse(L, F2). + +fam_intersect(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_intersect(F1, BL, L); +fam_intersect([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_intersect(AL, BL, [{A, intersection(AS, BS, [])} | L]); +fam_intersect([_A1 | AL], F2, L) -> + fam_intersect(AL, F2, L); +fam_intersect(_, _, L) -> + reverse(L). + +fam_difference(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_difference(F1, BL, L); +fam_difference([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_difference(AL, BL, [{A, difference(AS, BS, [])} | L]); +fam_difference([A1 | AL], F2, L) -> + fam_difference(AL, F2, [A1 | L]); +fam_difference(F1, _, L) -> + reverse(L, F1). + +check_function([{X,_} | XL], R) -> + check_function(X, XL, R); +check_function([], R) -> + R. + +check_function(X0, [{X,_} | XL], R) when X0 /= X -> + check_function(X, XL, R); +check_function(X0, [{X,_} | _XL], _R) when X0 == X -> + bad_function; +check_function(_X0, [], R) -> + R. + +fam_partition_n(I, [E | Ts]) -> + fam_partition_n(I, Ts, element(I, E), [E], []); +fam_partition_n(_I, []) -> + []. + +fam_partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + fam_partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + fam_partition_n(I, Ts, K1, [E], [{K,Es} | P]); + {K1, _} -> + fam_partition_n(I, Ts, K1, [E], [{K,reverse(Es)} | P]) + end; +fam_partition_n(_I, [], K, [_] = Es, P) -> % optimization + reverse(P, [{K,Es}]); +fam_partition_n(_I, [], K, Es, P) -> + reverse(P, [{K,reverse(Es)}]). + +fam_partition([{K,Vs} | Ts], Sort) -> + fam_partition(Ts, K, [Vs], [], Sort); +fam_partition([], _Sort) -> + []. + +fam_partition([{K1,V} | Ts], K, Vs, P, S) when K1 == K -> + fam_partition(Ts, K, [V | Vs], P, S); +fam_partition([{K1,V} | Ts], K, [_] = Vs, P, S) -> % optimization + fam_partition(Ts, K1, [V], [{K, Vs} | P], S); +fam_partition([{K1,V} | Ts], K, Vs, P, S) -> + fam_partition(Ts, K1, [V], [{K, sort(S, Vs)} | P], S); +fam_partition([], K, [_] = Vs, P, _S) -> % optimization + [{K, Vs} | P]; +fam_partition([], K, Vs, P, S) -> + [{K, sort(S, Vs)} | P]. + +fam_proj([{X,S} | F], Fun, Type, NType, L) -> + case setfun(S, Fun, Type, NType) of + {SD, ST} -> fam_proj(F, Fun, Type, ST, [{X, SD} | L]); + Bad -> Bad + end; +fam_proj([], _Fun, _Type, NType, L) -> + {reverse(L), NType}. + +setfun(T, Fun, Type, NType) -> + case Fun(term2set(T, Type)) of + NS when ?IS_SET(NS) -> + case unify_types(NType, ?SET_OF(?TYPE(NS))) of + [] -> type_mismatch; + NT -> {?LIST(NS), NT} + end; + NS when ?IS_ORDSET(NS) -> + case unify_types(NType, NT = ?ORDTYPE(NS)) of + [] -> type_mismatch; + NT -> {?ORDDATA(NS), NT} + end; + _ -> + badarg + end. + +%% Inlined. +term2set(L, Type) when is_list(L) -> + ?SET(L, Type); +term2set(T, Type) -> + ?ORDSET(T, Type). + +fam2digraph(F, G) -> + Fun = fun({From, ToL}) -> + digraph:add_vertex(G, From), + Fun2 = fun(To) -> + digraph:add_vertex(G, To), + case digraph:add_edge(G, From, To) of + {error, {bad_edge, _}} -> + throw({error, cyclic}); + _ -> + true + end + end, + foreach(Fun2, ToL) + end, + foreach(Fun, to_external(F)), + G. + +digraph_family(G) -> + Vs = sort(digraph:vertices(G)), + digraph_fam(Vs, Vs, G, []). + +digraph_fam([V | Vs], V0, G, L) when V /= V0 -> + Ns = sort(digraph:out_neighbours(G, V)), + digraph_fam(Vs, V, G, [{V,Ns} | L]); +digraph_fam([], _V0, _G, L) -> + reverse(L). + +%% -> boolean() +check_fun(T, F, FunT) -> + true = is_type(FunT), + {NT, _MaxI} = number_tuples(T, 1), + L = flatten(tuple2list(F(NT))), + has_hole(L, 1). + +number_tuples(T, N) when is_tuple(T) -> + {L, NN} = mapfoldl(fun number_tuples/2, N, tuple_to_list(T)), + {list_to_tuple(L), NN}; +number_tuples(_, N) -> + {N, N+1}. + +tuple2list(T) when is_tuple(T) -> + map(fun tuple2list/1, tuple_to_list(T)); +tuple2list(C) -> + [C]. + +has_hole([I | Is], I0) when I =< I0 -> has_hole(Is, erlang:max(I+1, I0)); +has_hole(Is, _I) -> Is =/= []. + +%% Optimization. Same as check_fun/3, but for integers. +check_for_sort(T, _I) when T =:= ?ANYTYPE -> + empty; +check_for_sort(T, I) when ?IS_RELATION(T), I =< ?REL_ARITY(T), I >= 1 -> + I > 1; +check_for_sort(_T, _I) -> + error. + +inverse_substitution(L, Fun, Sort) -> + %% One easily sees that the inverse of the tuples created by + %% applying Fun need to be sorted iff the tuples created by Fun + %% need to be sorted. + sort(Sort, fun_rearr(L, Fun, [])). + +fun_rearr([E | Es], Fun, L) -> + fun_rearr(Es, Fun, [{Fun(E), E} | L]); +fun_rearr([], _Fun, L) -> + L. + +sets_to_list(Ss) -> + map(fun(S) when ?IS_SET(S) -> ?LIST(S) end, Ss). + +types([], L) -> + list_to_tuple(reverse(L)); +types([S | _Ss], _L) when ?TYPE(S) =:= ?ANYTYPE -> + ?ANYTYPE; +types([S | Ss], L) -> + types(Ss, [?TYPE(S) | L]). + +%% Inlined. +unify_types(T, T) -> T; +unify_types(Type1, Type2) -> + catch unify_types1(Type1, Type2). + +unify_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + Atom; +unify_types1(?ANYTYPE, Type) -> + Type; +unify_types1(Type, ?ANYTYPE) -> + Type; +unify_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + [unify_types1(Type1, Type2)]; +unify_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + unify_typesl(tuple_size(T1), T1, T2, []); +unify_types1(_T1, _T2) -> + throw([]). + +unify_typesl(0, _T1, _T2, L) -> + list_to_tuple(L); +unify_typesl(N, T1, T2, L) -> + T = unify_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)), + unify_typesl(N-1, T1, T2, [T | L]). + +%% inlined. +match_types(T, T) -> true; +match_types(Type1, Type2) -> match_types1(Type1, Type2). + +match_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + true; +match_types1(?ANYTYPE, _) -> + true; +match_types1(_, ?ANYTYPE) -> + true; +match_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + match_types1(Type1, Type2); +match_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + match_typesl(tuple_size(T1), T1, T2); +match_types1(_T1, _T2) -> + false. + +match_typesl(0, _T1, _T2) -> + true; +match_typesl(N, T1, T2) -> + case match_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)) of + true -> match_typesl(N-1, T1, T2); + false -> false + end. + +sort(true, L) -> + sort(L); +sort(false, L) -> + reverse(L). diff --git a/lib/tools/test/tools_bench.spec b/lib/tools/test/tools_bench.spec new file mode 100644 index 0000000000..ef08fd68a8 --- /dev/null +++ b/lib/tools/test/tools_bench.spec @@ -0,0 +1 @@ +{suites,"../tools_test",[prof_bench_SUITE]}. |